summaryrefslogtreecommitdiff
path: root/test/Moretest/tcallback.ml
diff options
context:
space:
mode:
Diffstat (limited to 'test/Moretest/tcallback.ml')
-rw-r--r--test/Moretest/tcallback.ml69
1 files changed, 0 insertions, 69 deletions
diff --git a/test/Moretest/tcallback.ml b/test/Moretest/tcallback.ml
deleted file mode 100644
index 025c7a46cf..0000000000
--- a/test/Moretest/tcallback.ml
+++ /dev/null
@@ -1,69 +0,0 @@
-external mycallback1 : ('a -> 'b) -> 'a -> 'b = "mycallback1"
-external mycallback2 : ('a -> 'b -> 'c) -> 'a -> 'b -> 'c = "mycallback2"
-external mycallback3 : ('a -> 'b -> 'c -> 'd) -> 'a -> 'b -> 'c -> 'd = "mycallback3"
-external mycallback4 : ('a -> 'b -> 'c -> 'd -> 'e) -> 'a -> 'b -> 'c -> 'd -> 'e = "mycallback4"
-
-let rec tak (x, y, z as tuple) =
- if x > y then tak(tak (x-1, y, z), tak (y-1, z, x), tak (z-1, x, y))
- else z
-
-let tak2 x (y, z) = tak (x, y, z)
-
-let tak3 x y z = tak (x, y, z)
-
-let tak4 x y z u = tak (x, y, z + u)
-
-let raise_exit () = (raise Exit : unit)
-
-let trapexit () =
- begin try
- mycallback1 raise_exit ()
- with Exit ->
- ()
- end;
- tak (18, 12, 6)
-
-external mypushroot : 'a -> ('b -> 'c) -> 'b -> 'a = "mypushroot"
-external mycamlparam : 'a -> ('b -> 'c) -> 'b -> 'a = "mycamlparam"
-
-let tripwire f =
- let s = String.make 5 'a' in
- f s trapexit ()
-
-(* Test callbacks performed to handle signals *)
-
-let sighandler signo =
-(*
- print_string "Got signal, triggering garbage collection...";
- print_newline();
-*)
- (* Thoroughly wipe the minor heap *)
- tak (18, 12, 6);
- ()
-
-external unix_getpid : unit -> int = "unix_getpid" "noalloc"
-external unix_kill : int -> int -> unit = "unix_kill" "noalloc"
-
-let callbacksig () =
- let pid = unix_getpid() in
- (* Allocate a block in the minor heap *)
- let s = String.make 5 'b' in
- (* Send a signal to self. We want s to remain in a register and
- not be spilled on the stack, hence we declare unix_kill
- "noalloc". *)
- unix_kill pid Sys.sigusr1;
- (* Allocate some more so that the signal will be tested *)
- let u = (s, s) in
- fst u
-
-let _ =
- print_int(mycallback1 tak (18, 12, 6)); print_newline();
- print_int(mycallback2 tak2 18 (12, 6)); print_newline();
- print_int(mycallback3 tak3 18 12 6); print_newline();
- print_int(mycallback4 tak4 18 12 3 3); print_newline();
- print_int(trapexit ()); print_newline();
- print_string(tripwire mypushroot); print_newline();
- print_string(tripwire mycamlparam); print_newline();
- Sys.signal Sys.sigusr1 (Sys.Signal_handle sighandler);
- print_string(callbacksig ()); print_newline()
-