[MLton-commit] r5935

[Vesa Karvonen]

Added some test.  (Heh...)

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

A   mltonlib/trunk/com/ssh/generic/unstable/test/some.sml
U   mltonlib/trunk/com/ssh/generic/unstable/test.mlb

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

Added: mltonlib/trunk/com/ssh/generic/unstable/test/some.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/test/some.sml	2007-08-23 09:46:45 UTC (rev 5934)
+++ mltonlib/trunk/com/ssh/generic/unstable/test/some.sml	2007-08-23 12:28:48 UTC (rev 5935)
@@ -0,0 +1,28 @@
+(* Copyright (C) 2007 SSH Communications Security, Helsinki, Finland
+ *
+ * This code is released under the MLton license, a BSD-style license.
+ * See the LICENSE file or http://mlton.org/License for details.
+ *)
+
+val () = let
+   open Generic UnitTest
+
+   fun listEither pair sumIn sumOut a =
+       (Tie.fix Y)
+          (fn aListLeft =>
+              iso (data (op +` (pair (C0' "nil",
+                                      C1' "::" (tuple2 (a, aListLeft))))))
+                  (sumIn o (fn [] => INL () | op :: ? => INR ?),
+                   (fn INL () => [] | INR ? => op :: ?) o sumOut))
+
+   fun listL ? = listEither id        id       id       ?
+   fun listR ? = listEither Pair.swap Sum.swap Sum.swap ?
+in
+   unitTests
+      (title "Generic.Some")
+
+      (* Test that generation terminates both ways. *)
+      (test (fn () => verifyTrue (some (listL int) = some (listR int))))
+
+      $
+end


Property changes on: mltonlib/trunk/com/ssh/generic/unstable/test/some.sml
___________________________________________________________________
Name: svn:eol-style
   + native

Modified: mltonlib/trunk/com/ssh/generic/unstable/test.mlb
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/test.mlb	2007-08-23 09:46:45 UTC (rev 5934)
+++ mltonlib/trunk/com/ssh/generic/unstable/test.mlb	2007-08-23 12:28:48 UTC (rev 5935)
@@ -19,6 +19,7 @@
       in
          test/pickle.sml
          test/pretty.sml
+         test/some.sml
       end
    end
 in