regression/world4.sml

   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 (w1, out) = MLton.TextIO.mkstemp "/tmp/world"
  23 val _ = TextIO.closeOut out
  24 val (w2, out) = MLton.TextIO.mkstemp "/tmp/world"
  25 val _ = TextIO.closeOut out
  26
  27 val _ = print "before saves\n"
  28
  29 val original = ref true
  30
  31 val _ = (case save w1 of
  32             Clone => original := false
  33           | Original => ())
  34
  35 val _ = print "between saves\n"
  36
  37 val _ = (case save w2 of
  38             Clone => original := false
  39           | Original => ())
  40
  41 val _ = print "after saves\n"
  42
  43 val _ = if !original
  44            then (run (fn () => load w1)
  45                  ; run (fn () => load w2)
  46                  ; OS.FileSys.remove w1
  47                  ; OS.FileSys.remove w2)
  48         else ()