1(* mosml/src/mosmllib/test/callback/testcallback.sml -- test Callback.
2
3   The SML side of things -- sestoft@dina.kvl.dk 1999-08-09 *)
4
5app load ["Int", "Dynlib", "Callback", "Mosml"];
6
7use "../auxil.sml";
8
9open Callback;
10
11(* Obtain a handle pointing to the library defining the C functions,
12   and make the C side register a number of C functions: *)
13
14val dlh = Dynlib.dlopen { lib = "./libcside.so",
15			  flag = Dynlib.RTLD_LAZY,
16			  global = false }
17
18val _ = Dynlib.app1 (Dynlib.dlsym dlh "initialize_callbacktest") ();
19
20
21(* TESTING THE REGISTRATION AND USE OF C VALUES *)
22
23(* Define SML functions that call the registered C functions *)
24
25(* Passing and returning base types: unit, int, char, real, string, bool: *)
26
27val fu : unit   -> unit   = app1 (getcptr "regcfu");
28val fi : int    -> int    = app1 (getcptr "regcfi");
29val fc : char   -> char   = app1 (getcptr "regcfc");
30val fr : real   -> real   = app1 (getcptr "regcfr");
31val fs : string -> string = app1 (getcptr "regcfs");
32val fb : bool   -> bool   = app1 (getcptr "regcfb");
33
34(* Passing several curried arguments: *)
35
36val fcur : int -> char -> real -> string -> bool -> int =
37    app5 (getcptr "regcfcur");
38
39(* Passing a tuple: *)
40
41val ftup : int * char * real -> int =
42    app1 (getcptr "regcftup");
43
44(* Passing a record: *)
45
46val frec : { surname : string, givenname : string, age : int } -> bool =
47    app1 (getcptr "regcfrec");
48
49(* Passing a constructed value belonging to a datatype: *)
50
51datatype t =
52    Lf
53  | Br of int * t * t
54  | Brs of t list
55
56val fdat : t -> int =
57    app1 (getcptr "regcfdat");
58
59(* Passing an ML function (a closure): *)
60
61val ffun : (int -> real) -> int -> string =
62    app2 (getcptr "regcffun");
63
64(* Returning a tuple *)
65
66val frtup : int -> int * bool =
67    app1 (getcptr "regcfrtup");
68
69(* Returning a record *)
70
71val frrec : int -> { half : int, odd : bool } =
72    app1 (getcptr "regcfrrec");
73
74(* Illustration of heap allocation trickiness *)
75
76val fconcat : string -> string -> string =
77    app2 (getcptr "regcfconcat");
78
79(* Exercising the C functions: *)
80
81val test1 = () = fu ();
82
83val test2 = 5667 = fi 5666;
84
85val test3 = #"T" = fc #"t";
86
87val test4 = 56.0 = fr 28.0;
88
89val test5 = "TEST NUMBER +1" = fs "Test number +1";
90
91val test6 = fb false;
92
93val test7 = 85 = fcur 5 #"A" 10.0 "blah" true;
94
95val test8 = 80 = ftup(5, #"A", 10.0);
96
97val test9 = not (frec {surname = "Jensen", givenname = "Karin", age = 28 });
98
99local
100    val tree = Brs[Lf,
101		   Br(12, Br(10, Lf, Lf), Br(20, Lf, Lf)),
102		   Brs[Br(15, Lf, Lf)]]
103in
104    val test10 = 57 = fdat tree
105end
106
107val test11 = ("Just right" = ffun (fn x => real x + 7.0) 100000);
108
109val test12 = (8, true) = frtup 17;
110
111val test13 = {half = 8, odd = true} = frrec 17;
112
113val test14 = "abcdef" = fconcat "abc" "def";
114
115
116(* TESTING THE REGISTRATION AND USE OF ML VALUES *)
117
118val test15 = app1 (getcptr "getting_notreg") () : bool;
119
120val test16 = (register "unregistered" (fn x => x);
121	      unregister "unregistered";
122	      app1 (getcptr "getting_unreg") ()) : bool;
123
124val test17 = (app1 (getcptr "using_notreg") (); false)
125             handle Fail _ => true | _ => false : bool;
126
127val test18 = (register "temp1" (fn x => x);
128	      app1 (getcptr "using_unreg") ()) : bool;
129
130fun mkfun extra =
131    let fun f (r : real) = r + extra
132    in f end
133
134(* On a 266 MHz Pentium II notebook this does 1.25 million callbacks/sec: *)
135
136val test19 =
137    let val a = 2.5
138	val b = 1000000
139	val c = 10.0
140	val _ = (register "extrafun" (mkfun a); register "steps" b)
141	val res = Mosml.time (app1 (getcptr "call function")) c : real
142	val expected = a * real b + c
143    in abs(expected - res) < 0.0001 end
144
145(* On a 266 MHz Pentium II notebook this does 1.5 million callbacks/sec: *)
146
147val test20 =
148    let val a = 1
149	val b = 1000000
150	val c = 17
151	val _ = app unregister ["extrafun", "steps"]
152	val _ = (register "extrafun" (fn x => x+a); register "steps" b)
153	val res = Mosml.time (app1 (getcptr "call function")) c : int
154	val expected = a * b + c
155    in expected = res end
156
157val _ = quit();
158