Commit | Line | Data |
---|---|---|
7f918cf1 CE |
1 | fun run (f: unit -> unit) = |
2 | case Posix.Process.fork () of | |
3 | SOME pid => | |
4 | let | |
5 | open Posix.Process | |
6 | val (pid', status) = waitpid (W_CHILD pid, []) | |
7 | in if pid = pid' andalso status = W_EXITED | |
8 | then () | |
9 | else raise Fail "child failed" | |
10 | end | |
11 | | NONE => let open OS.Process | |
12 | in exit ((f (); success) handle _ => failure) | |
13 | end | |
14 | ||
15 | fun succeed () = | |
16 | let open OS.Process | |
17 | in exit success | |
18 | end | |
19 | ||
20 | open MLton.World | |
21 | ||
22 | val (w, out) = MLton.TextIO.mkstemp "/tmp/world" | |
23 | val _ = TextIO.closeOut out | |
24 | ||
25 | exception Foo | |
26 | ||
27 | fun f n = | |
28 | if n = 0 | |
29 | then (case save w of | |
30 | Original => 0 | |
31 | | Clone => raise Foo) | |
32 | else f (n - 1) + 1 | |
33 | ||
34 | val _ = (f 13; ()) handle Foo => (print "caught foo\n"; succeed ()) | |
35 | ||
36 | val _ = run (fn () => load w) | |
37 | ||
38 | val _ = OS.FileSys.remove w |