regression/test-create.sml

   1 fun statusToString status =
   2    case status of
   3       Posix.Process.W_EXITED => "W_EXITED"
   4     | Posix.Process.W_EXITSTATUS w => concat ["W_EXITSTATUS ", Word8.toString w]
   5     | Posix.Process.W_SIGNALED s =>
   6          concat ["W_SIGNALED ", SysWord.toString (Posix.Signal.toWord s)]
   7     | Posix.Process.W_STOPPED s =>
   8          concat ["W_STOPPED ", SysWord.toString (Posix.Signal.toWord s)]
   9
  10 val cmd = CommandLine.name ()
  11
  12 fun stdout () =
  13    TextIO.output (TextIO.stdOut, "Hello world! [stdout]\n")
  14 fun exit () = Posix.Process.exit 0wx7
  15 fun diverge () = diverge ()
  16
  17 fun test () =
  18    let
  19       fun create arg =
  20          let
  21             val _ = TextIO.flushOut (TextIO.stdOut)
  22             val _ = TextIO.flushOut (TextIO.stdErr)
  23          in
  24             MLton.Process.create
  25             {path = cmd,
  26              args = [arg],
  27              env = NONE,
  28              stdin = MLton.Process.Param.self,
  29              stdout = MLton.Process.Param.self,
  30              stderr = MLton.Process.Param.self}
  31          end
  32       fun reap pid =
  33          MLton.Process.reap pid
  34       fun kill (pid, signal) =
  35          MLton.Process.kill (pid, signal)
  36       fun doTest (arg, withPid) =
  37          let
  38             val _ = print (concat ["testing ", arg, "...\n"])
  39             val pid = create arg
  40             val () = withPid pid
  41             val status = reap pid
  42             val _ = print (concat ["exit_status: ", statusToString status, "\n"])
  43          in
  44             ()
  45          end
  46       fun doSimpleTest arg = doTest (arg, fn _ => ())
  47    in
  48       print "create test:\n"
  49       ; doSimpleTest "stdout"
  50       ; doSimpleTest "exit"
  51       ; doTest ("diverge", fn pid => kill (pid, Posix.Signal.kill))
  52    end
  53
  54 val _ =
  55    case CommandLine.arguments () of
  56       [] => test ()
  57     | ["stdout"] => stdout ()
  58     | ["exit"] => exit ()
  59     | ["diverge"] => diverge ()
  60     | _ => raise Match