regression/library/check.sml

   1 val () = print "check starting up\n"
   2 val () = OS.Process.atExit
   3          (fn () => (_import "m5_close" public : unit -> unit; ()
   4                    ; print "check exits\n"))
   5
   6 (* Prepare lib5 *)
   7 val () = _import "m5_open" public : int * string vector -> unit;
   8          (1, Vector.fromList ["libm5"])
   9
  10 type p = MLton.Pointer.t
  11 type 'a s = (unit -> 'a) * ('a -> unit)
  12 val (_, setSI) = _symbol "checksmlSymPrivate" alloc private : p s;
  13 val (_, setSB) = _symbol "checksmlSymPublic"  alloc public  : p s;
  14 val (_, setCI) = _symbol "checkcSymPrivate" private : p s;
  15 val (_, setCB) = _symbol "checkcSymPublic"  public  : p s;
  16
  17 type i = (unit -> p)
  18 type e = i -> unit
  19 val () = _export "checksmlFnPrivate" private : e;
  20          (fn () => _address "checksmlSymPrivate" private : p;)
  21 val () = _export "checksmlFnPublic" public : e;
  22          (fn () => _address "checksmlSymPublic" public : p;)
  23 val getCI = _import "checkcFnPrivate" private : i;
  24 val getCB = _import "checkcFnPublic" public : i;
  25
  26 (* Store our idea of what the function pointers are in symbols *)
  27 val () = setSI (_address "checksmlFnPrivate" private : p;)
  28 val () = setSB (_address "checksmlFnPublic"  public  : p;)
  29 val () = setCI (_address "checkcFnPrivate"   private : p;)
  30 val () = setCB (_address "checkcFnPublic"    public  : p;)
  31
  32 (* Have C confirm that it sees the same function pointers we do.
  33  * C will check the values of the variables against it's own pointers.
  34  * C also checks SML functions return his idea of pointers to our exports.
  35  *)
  36 val () = _import "checkconfirmC" private : unit -> unit; ()
  37
  38 (* Confirm that C functions return pointers to address as we expect. *)
  39 fun check (s, b) = if b then () else print (s ^ " pointers don't match!\n")
  40 val () = check ("checkcFnPrivate", getCI () = _address "checkcSymPrivate" private : p;)
  41 val () = check ("checkcFnPublic",  getCB () = _address "checkcSymPublic"  public  : p;)
  42
  43 (* Test symbols in libm3 *)
  44 val (SB, _) = _symbol "libm3smlSymPublic" external : p s;
  45 val (CB, _) = _symbol "libm3cSymPublic"   external : p s;
  46 val getSB = _import "libm3smlFnPublic" external : i;
  47 val getCB = _import "libm3cFnPublic"   external : i;
  48
  49 (* Check function pointers *)
  50 val () = check ("libm3smlFnPublic", SB () = _address "libm3smlFnPublic" external : p;)
  51 val () = check ("libm3cFnPublic",   CB () = _address "libm3cFnPublic"   external : p;)
  52 (* Check symbol pointers *)
  53 val () = check ("libm3smlSymPublic", getSB () = _address "libm3smlSymPublic" external : p;)
  54 val () = check ("libm3cSymPublic",   getCB () = _address "libm3cSymPublic"   external : p;)
  55
  56 (* Test symbols in libm4 *)
  57 val (SB, _) = _symbol "libm4smlSymPublic" external : p s;
  58 val (CB, _) = _symbol "libm4cSymPublic"   external : p s;
  59 val getSB = _import "libm4smlFnPublic" external : i;
  60 val getCB = _import "libm4cFnPublic"   external : i;
  61
  62 (* Check function pointers *)
  63 val () = check ("libm4smlFnPublic", SB () = _address "libm4smlFnPublic" external : p;)
  64 val () = check ("libm4cFnPublic",   CB () = _address "libm4cFnPublic"   external : p;)
  65 (* Check symbol pointers *)
  66 val () = check ("libm4smlSymPublic", getSB () = _address "libm4smlSymPublic" external : p;)
  67 val () = check ("libm4cSymPublic",   getCB () = _address "libm4cSymPublic"   external : p;)
  68
  69 (* Test symbols in libm5 *)
  70 val (SB, _) = _symbol "libm5smlSymPublic" public : p s;
  71 val (CB, _) = _symbol "libm5cSymPublic"   public : p s;
  72 val getSB = _import "libm5smlFnPublic" public : i;
  73 val getCB = _import "libm5cFnPublic"   public : i;
  74
  75 (* Check function pointers *)
  76 val () = check ("libm5smlFnPublic", SB () = _address "libm5smlFnPublic" public : p;)
  77 val () = check ("libm5cFnPublic",   CB () = _address "libm5cFnPublic"   public : p;)
  78 (* Check symbol pointers *)
  79 val () = check ("libm5smlSymPublic", getSB () = _address "libm5smlSymPublic" public : p;)
  80 val () = check ("libm5cSymPublic",   getCB () = _address "libm5cSymPublic"   public : p;)
  81
  82 val () = print "check pointer test complete.\n"