[MLton-commit] r6990

[Matthew Fluet]

Regression tests that access the current stack in heap via MLton.size and MLton.share object traces.
----------------------------------------------------------------------

A   mlton/trunk/regression/thread-switch-share.ok
A   mlton/trunk/regression/thread-switch-share.sml
A   mlton/trunk/regression/thread-switch-size.ok
A   mlton/trunk/regression/thread-switch-size.sml

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

Added: mlton/trunk/regression/thread-switch-share.ok
===================================================================
--- mlton/trunk/regression/thread-switch-share.ok	2008-11-12 18:23:29 UTC (rev 6989)
+++ mlton/trunk/regression/thread-switch-share.ok	2008-11-12 23:11:29 UTC (rev 6990)
@@ -0,0 +1,2 @@
+size1 >= size2 = true
+sum1 = sum2 = true
\ No newline at end of file

Added: mlton/trunk/regression/thread-switch-share.sml
===================================================================
--- mlton/trunk/regression/thread-switch-share.sml	2008-11-12 18:23:29 UTC (rev 6989)
+++ mlton/trunk/regression/thread-switch-share.sml	2008-11-12 23:11:29 UTC (rev 6990)
@@ -0,0 +1,39 @@
+(* Access the current stack in the heap via a MLton.share object trace. *)
+val rt : MLton.Thread.Runnable.t option ref = ref NONE
+
+fun stats () =
+   let
+      val () = MLton.share rt
+   in
+      ()
+   end
+
+fun switcheroo () =
+   MLton.Thread.switch
+   (fn t => let
+               val () = rt := SOME (MLton.Thread.prepare (t, ()))
+               val () = stats ()
+            in
+               valOf (!rt)
+            end)
+
+(* tuple option array *)
+val a = Array.tabulate (100, fn i => SOME (i mod 2, i mod 3))
+val () = Array.update (a, 0, NONE)
+
+fun touch () =
+   let
+      val size = MLton.size a
+      val sum =
+         Array.foldr (fn (NONE,sum) => sum
+                       | (SOME (a, b),sum) => a + b + sum)
+                     0 a
+   in
+      (size, sum)
+   end
+
+val (size1,sum1) = touch ()
+val () = switcheroo ()
+val (size2,sum2) = touch ()
+val _ = print (concat ["size1 >= size2 = ", Bool.toString (size1 >= size2), "\n"])
+val _ = print (concat ["sum1 = sum2 = ", Bool.toString (sum1 >= sum2), "\n"])

Added: mlton/trunk/regression/thread-switch-size.ok
===================================================================
--- mlton/trunk/regression/thread-switch-size.ok	2008-11-12 18:23:29 UTC (rev 6989)
+++ mlton/trunk/regression/thread-switch-size.ok	2008-11-12 23:11:29 UTC (rev 6990)
@@ -0,0 +1 @@
+!rs > 0 = true

Added: mlton/trunk/regression/thread-switch-size.sml
===================================================================
--- mlton/trunk/regression/thread-switch-size.sml	2008-11-12 18:23:29 UTC (rev 6989)
+++ mlton/trunk/regression/thread-switch-size.sml	2008-11-12 23:11:29 UTC (rev 6990)
@@ -0,0 +1,22 @@
+(* Access the current stack in the heap via a MLton.size object trace. *)
+val rt : MLton.Thread.Runnable.t option ref = ref NONE
+val rs : int ref = ref 0
+
+fun stats () =
+   let
+      val () = rs := MLton.size rt
+   in
+      ()
+   end
+
+fun switcheroo () =
+   MLton.Thread.switch
+   (fn t => let
+               val () = rt := SOME (MLton.Thread.prepare (t, ()))
+               val () = stats ()
+            in
+               valOf (!rt)
+            end)
+
+val () = switcheroo ()
+val _ = print (concat ["!rs > 0 = ", Bool.toString (!rs > 0), "\n"])