regression/general.sml

   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      ];