| 1 | (* Auxiliary functions for test cases *) |
| 2 | |
| 3 | infix 1 seq |
| 4 | fun e1 seq e2 = e2; |
| 5 | fun check b = if b then "OK" else "WRONG"; |
| 6 | fun check' f = (if f () then "OK" else "WRONG") handle _ => "EXN"; |
| 7 | |
| 8 | fun range (from, to) p = |
| 9 | let open Int |
| 10 | in |
| 11 | (from > to) orelse (p from) andalso (range (from+1, to) p) |
| 12 | end; |
| 13 | |
| 14 | fun checkrange bounds = check o range bounds; |
| 15 | |
| 16 | fun tst0 s s' = print (s ^ " \t" ^ s' ^ "\n"); |
| 17 | fun tst s b = tst0 s (check b); |
| 18 | fun tst' s f = tst0 s (check' f); |
| 19 | |
| 20 | fun tstrange s bounds = (tst s) o range bounds |
| 21 | |
| 22 | |
| 23 | (* General -- incomplete 1996-04-19, 1996-09-30, 1997-03-12 *) |
| 24 | |
| 25 | |
| 26 | val _ = print "\nFile general.sml: Testing structure General...\n" |
| 27 | |
| 28 | exception NoExceptionRaised |
| 29 | |
| 30 | fun getExn (f : unit -> 'a) = |
| 31 | (f (); NoExceptionRaised) handle e => e |
| 32 | |
| 33 | fun prExn(exnStr, exn) = |
| 34 | (print "Should be `"; print exnStr; print "':\n "; |
| 35 | print (exnName exn); print "\n "; |
| 36 | print (exnMessage exn); print "\n"); |
| 37 | |
| 38 | exception E1; |
| 39 | exception E2 = E1; |
| 40 | |
| 41 | val _ = List.map prExn |
| 42 | [("E1 or E2", E2), |
| 43 | ("Bind", getExn(fn _ => let val true = false in () end)), |
| 44 | ("Match", getExn(fn _ => (fn true => ()) false)), |
| 45 | ("Subscript", getExn(fn _ => Vector.sub(vector [], ~1))), |
| 46 | ("Overflow", getExn(fn _ => Array.array(Array.maxLen+1, ()))), |
| 47 | (* ("Overflow", getExn(fn _ => Math.exp 1E99)), |
| 48 | ("Domain", getExn(fn _ => Math.ln ~1.0)), |
| 49 | *) ("Div", getExn(fn _ => 1 div 0)), |
| 50 | ("Chr", getExn(fn _ => Char.chr 9999999)), |
| 51 | ("Fail", Fail "demo"), |
| 52 | ("Option", getExn(fn _ => valOf NONE)), |
| 53 | ("Empty", getExn(fn _ => List.hd [])) |
| 54 | (* ("SysErr", getExn (fn _ => FileSys.modTime "exists.not")), *) |
| 55 | (* ("Io", getExn (fn _ => TextIO.openOut "."))*) |
| 56 | ]; |