[MLton-commit] r7163

[Matthew Fluet]

A more rigorous MLton.Process.spawn test.
----------------------------------------------------------------------

A   mlton/trunk/regression/test-spawn.ok
A   mlton/trunk/regression/test-spawn.sml

----------------------------------------------------------------------

Added: mlton/trunk/regression/test-spawn.ok
===================================================================
--- mlton/trunk/regression/test-spawn.ok	2009-06-17 20:55:09 UTC (rev 7162)
+++ mlton/trunk/regression/test-spawn.ok	2009-06-17 21:49:35 UTC (rev 7163)
@@ -0,0 +1,8 @@
+spawn test:
+testing stdout...
+Hello world! [stdout]
+exit_status: W_EXITED
+testing exit...
+exit_status: W_EXITSTATUS 7
+testing diverge...
+exit_status: W_SIGNALED 9

Added: mlton/trunk/regression/test-spawn.sml
===================================================================
--- mlton/trunk/regression/test-spawn.sml	2009-06-17 20:55:09 UTC (rev 7162)
+++ mlton/trunk/regression/test-spawn.sml	2009-06-17 21:49:35 UTC (rev 7163)
@@ -0,0 +1,64 @@
+fun statusToString status =
+   case status of
+      Posix.Process.W_EXITED => "W_EXITED"
+    | Posix.Process.W_EXITSTATUS w => concat ["W_EXITSTATUS ", Word8.toString w]
+    | Posix.Process.W_SIGNALED s => 
+         concat ["W_SIGNALED ", SysWord.toString (Posix.Signal.toWord s)]
+    | Posix.Process.W_STOPPED s => 
+         concat ["W_STOPPED ", SysWord.toString (Posix.Signal.toWord s)]
+
+val cmd = CommandLine.name ()
+
+fun stdout () =
+   TextIO.output (TextIO.stdOut, "Hello world! [stdout]\n")
+fun exit () = Posix.Process.exit 0wx7
+fun diverge () = diverge ()
+
+fun test () =
+   let
+      fun spawn arg =
+         let
+            val _ = TextIO.flushOut (TextIO.stdOut)
+            val _ = TextIO.flushOut (TextIO.stdErr)
+         in
+            MLton.Process.spawn
+            {path = cmd, args = [cmd, arg]}
+         end
+      fun waitpid pid =
+         let
+            val (pid', status) =
+               Posix.Process.waitpid (Posix.Process.W_CHILD pid, [])
+            val () =
+               if pid <> pid'
+                  then raise Fail "reap: pid <> pid'"
+               else ()
+         in
+            status
+         end
+      fun kill (pid, signal) =
+         Posix.Process.kill (Posix.Process.K_PROC pid, signal)
+      fun doTest (arg, withPid) =
+         let
+            val _ = print (concat ["testing ", arg, "...\n"])
+            val pid = spawn arg
+            val () = withPid pid
+            val status = waitpid pid
+            val _ = print (concat ["exit_status: ", statusToString status, "\n"])
+         in
+            ()
+         end
+      fun doSimpleTest arg = doTest (arg, fn _ => ())
+   in
+      print "spawn test:\n"
+      ; doSimpleTest "stdout"
+      ; doSimpleTest "exit"
+      ; doTest ("diverge", fn pid => kill (pid, Posix.Signal.kill))
+   end
+
+val _ =
+   case CommandLine.arguments () of
+      [] => test ()
+    | ["stdout"] => stdout ()
+    | ["exit"] => exit ()
+    | ["diverge"] => diverge ()
+    | _ => raise Match