1
exercism fetch ocaml forth

test.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
(* Test/exercise version: "1.3.0" *)

open Core
open OUnit2
open Forth

let print_int_list_option (xs: int list option) = match xs with
| None -> "None"
| Some xs -> "Some [" ^ String.concat ~sep:";" (List.map ~f:Int.to_string xs) ^ "]"
let ae exp got _test_ctxt = assert_equal ~printer:print_int_list_option exp got

let parsing_and_numbers_tests = [
   "numbers just get pushed onto the stack" >::
     ae (Some [1; 2; 3; 4; 5]) (evaluate ["1 2 3 4 5"]);
]


let addition_tests = [
   "can add two numbers" >::
     ae (Some [3]) (evaluate ["1 2 +"]);
   "errors if there is nothing on the stack" >::
     ae None (evaluate ["+"]);
   "errors if there is only one value on the stack" >::
     ae None (evaluate ["1 +"]);
]


let subtraction_tests = [
   "can subtract two numbers" >::
     ae (Some [-1]) (evaluate ["3 4 -"]);
   "errors if there is nothing on the stack" >::
     ae None (evaluate ["-"]);
   "errors if there is only one value on the stack" >::
     ae None (evaluate ["1 -"]);
]


let multiplication_tests = [
   "can multiply two numbers" >::
     ae (Some [8]) (evaluate ["2 4 *"]);
   "errors if there is nothing on the stack" >::
     ae None (evaluate ["*"]);
   "errors if there is only one value on the stack" >::
     ae None (evaluate ["1 *"]);
]


let division_tests = [
   "can divide two numbers" >::
     ae (Some [4]) (evaluate ["12 3 /"]);
   "performs integer division" >::
     ae (Some [2]) (evaluate ["8 3 /"]);
   "errors if dividing by zero" >::
     ae None (evaluate ["4 0 /"]);
   "errors if there is nothing on the stack" >::
     ae None (evaluate ["/"]);
   "errors if there is only one value on the stack" >::
     ae None (evaluate ["1 /"]);
]


let combined_arithmetic_tests = [
   "addition and subtraction" >::
     ae (Some [-1]) (evaluate ["1 2 + 4 -"]);
   "multiplication and division" >::
     ae (Some [2]) (evaluate ["2 4 * 3 /"]);
]


let dup_tests = [
   "copies the top value on the stack" >::
     ae (Some [1; 1]) (evaluate ["1 DUP"]);
   "is case-insensitive" >::
     ae (Some [1; 2; 2]) (evaluate ["1 2 Dup"]);
   "errors if there is nothing on the stack" >::
     ae None (evaluate ["dup"]);
]


let drop_tests = [
   "removes the top value on the stack if it is the only one" >::
     ae (Some []) (evaluate ["1 drop"]);
   "removes the top value on the stack if it is not the only one" >::
     ae (Some [1]) (evaluate ["1 2 drop"]);
   "errors if there is nothing on the stack" >::
     ae None (evaluate ["drop"]);
]


let swap_tests = [
   "swaps the top two values on the stack if they are the only ones" >::
     ae (Some [2; 1]) (evaluate ["1 2 swap"]);
   "swaps the top two values on the stack if they are not the only ones" >::
     ae (Some [1; 3; 2]) (evaluate ["1 2 3 swap"]);
   "errors if there is nothing on the stack" >::
     ae None (evaluate ["swap"]);
   "errors if there is only one value on the stack" >::
     ae None (evaluate ["1 swap"]);
]


let over_tests = [
   "copies the second element if there are only two" >::
     ae (Some [1; 2; 1]) (evaluate ["1 2 over"]);
   "copies the second element if there are more than two" >::
     ae (Some [1; 2; 3; 2]) (evaluate ["1 2 3 over"]);
   "errors if there is nothing on the stack" >::
     ae None (evaluate ["over"]);
   "errors if there is only one value on the stack" >::
     ae None (evaluate ["1 over"]);
]


let user_defined_words_tests = [
   "can consist of built-in words" >::
     ae (Some [1; 1; 1]) (evaluate [": dup-twice dup dup ;"; "1 dup-twice"]);
   "execute in the right order" >::
     ae (Some [1; 2; 3]) (evaluate [": countup 1 2 3 ;"; "countup"]);
   "can override other user-defined words" >::
     ae (Some [1; 1; 1]) (evaluate [": foo dup ;"; ": foo dup dup ;"; "1 foo"]);
   "can override built-in words" >::
     ae (Some [1; 1]) (evaluate [": swap dup ;"; "1 swap"]);
   "can override built-in operators" >::
     ae (Some [12]) (evaluate [": + * ;"; "3 4 +"]);
   "cannot redefine numbers" >::
     ae None (evaluate [": 1 2 ;"]);
   "errors if executing a non-existent word" >::
     ae None (evaluate ["foo"]);
]

let () =
  run_test_tt_main (
    "forth tests" >:::
      List.concat [
        parsing_and_numbers_tests; 
        addition_tests; 
        subtraction_tests; 
        multiplication_tests; 
        division_tests;
        combined_arithmetic_tests; 
        dup_tests; 
        drop_tests;
        swap_tests; 
        over_tests; 
        user_defined_words_tests
        ]
  )