Commit | Line | Data |
---|---|---|
7f918cf1 CE |
1 | functor Test (W: WORD) = |
2 | struct | |
3 | ||
4 | structure LW = LargeWord | |
5 | ||
6 | val zero = W.fromInt 0 | |
7 | val one = W.fromInt 1 | |
8 | val two = W.fromInt 2 | |
9 | val max = W.~ one | |
10 | ||
11 | val words = | |
12 | [max, | |
13 | W.- (max, one), | |
14 | W.div (max, two), | |
15 | W.fromInt 0xF, | |
16 | two, | |
17 | one, | |
18 | zero] | |
19 | ||
20 | fun foreach (l, f) = List.app f l | |
21 | ||
22 | fun for (f: W.word -> unit) = foreach (words, f) | |
23 | ||
24 | structure Answer = | |
25 | struct | |
26 | datatype t = | |
27 | Div | |
28 | | Overflow | |
29 | | Word of W.word | |
30 | ||
31 | val toString = | |
32 | fn Div => "Div" | |
33 | | Overflow => "Overflow" | |
34 | | Word w => W.toString w | |
35 | ||
36 | fun run (f: unit -> W.word): t = | |
37 | Word (f ()) | |
38 | handle General.Div => Div | |
39 | | General.Overflow => Overflow | |
40 | ||
41 | val equals: t * t -> bool = op = | |
42 | end | |
43 | ||
44 | val m = concat ["Word", Int.toString W.wordSize] | |
45 | ||
46 | val _ = print (concat ["Testing ", m, "\n"]) | |
47 | ||
48 | fun err msg = print (concat [m, ": ", concat msg, "\n"]) | |
49 | ||
50 | val _ = for (fn w => | |
51 | print (concat [W.toString w, "\n", | |
52 | "\t", W.fmt StringCvt.BIN w, "\n", | |
53 | "\t", W.fmt StringCvt.OCT w, "\n", | |
54 | "\t", W.fmt StringCvt.DEC w, "\n", | |
55 | "\t", W.fmt StringCvt.HEX w, "\n"])) | |
56 | ||
57 | val _ = | |
58 | foreach | |
59 | ([("+", W.+, LW.+), | |
60 | ("-", W.-, LW.-), | |
61 | ("*", W.*, LW.* ), | |
62 | ("andb", W.andb, LW.andb), | |
63 | ("div", W.div, LW.div), | |
64 | ("max", W.max, LW.max), | |
65 | ("min", W.min, LW.min), | |
66 | ("mod", W.mod, LW.mod), | |
67 | ("orb", W.orb, LW.orb), | |
68 | ("xorb", W.xorb, LW.xorb)], | |
69 | fn (name, f, f') => | |
70 | for | |
71 | (fn w => | |
72 | for | |
73 | (fn w' => | |
74 | let | |
75 | val a = Answer.run (fn () => f (w, w')) | |
76 | val a' = Answer.run (fn () => | |
77 | W.fromLarge (f' (W.toLarge w, W.toLarge w'))) | |
78 | ||
79 | in | |
80 | if Answer.equals (a, a') | |
81 | then () | |
82 | else err [W.toString w, " ", name, " ", W.toString w', | |
83 | " = ", Answer.toString a, " <> ", Answer.toString a'] | |
84 | end))) | |
85 | ||
86 | val _ = | |
87 | for (fn w => | |
88 | if w = valOf (W.fromString (W.toString w)) | |
89 | then () | |
90 | else err ["{from,to}String"]) | |
91 | ||
92 | val _ = | |
93 | foreach | |
94 | ([("<<", W.<<, LW.<<), | |
95 | (">>", W.>>, LW.>>)], | |
96 | fn (name, f, f') => | |
97 | for | |
98 | (fn w => | |
99 | foreach | |
100 | ([0w0, 0w1, 0w2, 0w4, 0w8, 0w15, 0w30, 0wxFF], | |
101 | fn w' => | |
102 | let | |
103 | val a = f (w, w') | |
104 | val a' = W.fromLarge (f' (W.toLarge w, w')) | |
105 | in | |
106 | if a = a' | |
107 | then () | |
108 | else err [W.toString w, " ", name, " ", Word.toString w', | |
109 | " = ", W.toString a, " <> ", W.toString a'] | |
110 | end))) | |
111 | ||
112 | val _ = | |
113 | foreach | |
114 | ([("~>>", W.~>>, LW.~>>)], | |
115 | fn (name, f, f') => | |
116 | for | |
117 | (fn w => | |
118 | foreach | |
119 | ([0w0, 0w1, 0w2, 0w4, 0w8, 0w15, 0w30, 0wxFF], | |
120 | fn w' => | |
121 | let | |
122 | val a = f (w, w') | |
123 | val a' = W.fromLarge (f' (W.toLargeX w, w')) | |
124 | in | |
125 | if a = a' | |
126 | then () | |
127 | else err [W.toString w, " ", name, " ", Word.toString w', | |
128 | " = ", W.toString a, " <> ", W.toString a'] | |
129 | end))) | |
130 | ||
131 | val _ = | |
132 | foreach | |
133 | ([("<", W.<, LW.<), | |
134 | ("<=", W.<=, LW.<=), | |
135 | (">", W.>, LW.>), | |
136 | (">=", W.>=, LW.>=)], | |
137 | fn (name, f, f') => | |
138 | for | |
139 | (fn w => | |
140 | for | |
141 | (fn w' => | |
142 | let | |
143 | val b = f (w, w') | |
144 | val b' = f' (W.toLarge w, W.toLarge w') | |
145 | in | |
146 | if b = b' | |
147 | then () | |
148 | else err [W.toString w, " ", name, " ", W.toString w', | |
149 | " = ", Bool.toString b, " <> ", Bool.toString b'] | |
150 | end))) | |
151 | ||
152 | val _ = | |
153 | foreach | |
154 | ([("compare", W.compare, LW.compare)], | |
155 | fn (name, f, f') => | |
156 | for | |
157 | (fn w => | |
158 | for | |
159 | (fn w' => | |
160 | let | |
161 | val or = f (w, w') | |
162 | val or' = f' (W.toLarge w, W.toLarge w') | |
163 | in | |
164 | if or = or' | |
165 | then () | |
166 | else err [W.toString w, " ", name, " ", W.toString w'] | |
167 | end))) | |
168 | ||
169 | val _ = | |
170 | for | |
171 | (fn w => | |
172 | if w = W.fromLargeInt (W.toLargeInt w) | |
173 | andalso w = W.fromLargeInt (W.toLargeIntX w) | |
174 | andalso (case SOME (W.toInt w) handle Overflow => NONE of | |
175 | NONE => true | |
176 | | SOME i => w = W.fromInt i) | |
177 | andalso (case SOME (W.toIntX w) handle Overflow => NONE of | |
178 | NONE => true | |
179 | | SOME i => w = W.fromInt i) | |
180 | then () | |
181 | else err ["{from,to}Large"]) | |
182 | ||
183 | val _ = | |
184 | for (fn w => | |
185 | let | |
186 | val a = W.notb w | |
187 | val a' = W.fromLarge (LW.notb (W.toLarge w)) | |
188 | in | |
189 | if a = a' | |
190 | then () | |
191 | else err ["notb ", W.toString w, " = ", W.toString a, " <> ", | |
192 | W.toString a'] | |
193 | end) | |
194 | ||
195 | val _ = | |
196 | for (fn w => | |
197 | if W.~ w = W.- (zero, w) | |
198 | then () | |
199 | else err ["~"]) | |
200 | ||
201 | end | |
202 | ||
203 | structure Z = Test (Word2) | |
204 | structure Z = Test (Word3) | |
205 | structure Z = Test (Word4) | |
206 | structure Z = Test (Word7) | |
207 | structure Z = Test (Word8) | |
208 | structure Z = Test (Word9) | |
209 | structure Z = Test (Word13) | |
210 | structure Z = Test (Word16) | |
211 | structure Z = Test (Word17) | |
212 | structure Z = Test (Word20) | |
213 | structure Z = Test (Word25) | |
214 | structure Z = Test (Word30) | |
215 | structure Z = Test (Word31) | |
216 | structure Z = Test (Word32) | |
217 | structure Z = Test (Word64) |