[MLton-commit] r5733

Vesa Karvonen vesak at mlton.org
Fri Jul 6 23:24:12 PDT 2007


Added lib with default generics and an example.
----------------------------------------------------------------------

U   mltonlib/trunk/com/ssh/unit-test/unstable/Check.sh
U   mltonlib/trunk/com/ssh/unit-test/unstable/detail/ml/smlnj/unsealed.cm
A   mltonlib/trunk/com/ssh/unit-test/unstable/detail/sorted-list.cm
A   mltonlib/trunk/com/ssh/unit-test/unstable/detail/sorted-list.mlb
A   mltonlib/trunk/com/ssh/unit-test/unstable/detail/unit-test.sml
A   mltonlib/trunk/com/ssh/unit-test/unstable/example/
A   mltonlib/trunk/com/ssh/unit-test/unstable/example/qc-test-example.sml
A   mltonlib/trunk/com/ssh/unit-test/unstable/example.cm
A   mltonlib/trunk/com/ssh/unit-test/unstable/example.mlb
A   mltonlib/trunk/com/ssh/unit-test/unstable/lib-with-default.cm
A   mltonlib/trunk/com/ssh/unit-test/unstable/lib-with-default.mlb
U   mltonlib/trunk/com/ssh/unit-test/unstable/lib.mlb
U   mltonlib/trunk/com/ssh/unit-test/unstable/public/unit-test.sig

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

Modified: mltonlib/trunk/com/ssh/unit-test/unstable/Check.sh
===================================================================
--- mltonlib/trunk/com/ssh/unit-test/unstable/Check.sh	2007-07-06 22:44:15 UTC (rev 5732)
+++ mltonlib/trunk/com/ssh/unit-test/unstable/Check.sh	2007-07-07 06:24:10 UTC (rev 5733)
@@ -5,7 +5,7 @@
 # This code is released under the MLton license, a BSD-style license.
 # See the LICENSE file or http://mlton.org/License for details.
 
-name=lib
+name=lib-with-default
 
 set -e
 set -x

Modified: mltonlib/trunk/com/ssh/unit-test/unstable/detail/ml/smlnj/unsealed.cm
===================================================================
--- mltonlib/trunk/com/ssh/unit-test/unstable/detail/ml/smlnj/unsealed.cm	2007-07-06 22:44:15 UTC (rev 5732)
+++ mltonlib/trunk/com/ssh/unit-test/unstable/detail/ml/smlnj/unsealed.cm	2007-07-07 06:24:10 UTC (rev 5733)
@@ -14,4 +14,4 @@
    ../../fru.sml
    ../../maybe.sml
    ../../mk-unit-test.fun
-   ../../sorted-list.sml
+   ../../sorted-list.cm

Added: mltonlib/trunk/com/ssh/unit-test/unstable/detail/sorted-list.cm
===================================================================
--- mltonlib/trunk/com/ssh/unit-test/unstable/detail/sorted-list.cm	2007-07-06 22:44:15 UTC (rev 5732)
+++ mltonlib/trunk/com/ssh/unit-test/unstable/detail/sorted-list.cm	2007-07-07 06:24:10 UTC (rev 5733)
@@ -0,0 +1,11 @@
+(* 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.
+ *)
+
+library
+   source(-)
+is
+   ../../../extended-basis/unstable/basis.cm
+   sorted-list.sml

Added: mltonlib/trunk/com/ssh/unit-test/unstable/detail/sorted-list.mlb
===================================================================
--- mltonlib/trunk/com/ssh/unit-test/unstable/detail/sorted-list.mlb	2007-07-06 22:44:15 UTC (rev 5732)
+++ mltonlib/trunk/com/ssh/unit-test/unstable/detail/sorted-list.mlb	2007-07-07 06:24:10 UTC (rev 5733)
@@ -0,0 +1,17 @@
+(* 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.
+ *)
+
+local
+   $(MLTON_LIB)/com/ssh/extended-basis/unstable/basis.mlb
+in
+   ann
+      "forceUsed"
+      "sequenceNonUnit warn"
+      "warnUnused true"
+   in
+      sorted-list.sml
+   end
+end


Property changes on: mltonlib/trunk/com/ssh/unit-test/unstable/detail/sorted-list.mlb
___________________________________________________________________
Name: svn:eol-style
   + native

Added: mltonlib/trunk/com/ssh/unit-test/unstable/detail/unit-test.sml
===================================================================
--- mltonlib/trunk/com/ssh/unit-test/unstable/detail/unit-test.sml	2007-07-06 22:44:15 UTC (rev 5732)
+++ mltonlib/trunk/com/ssh/unit-test/unstable/detail/unit-test.sml	2007-07-07 06:24:10 UTC (rev 5733)
@@ -0,0 +1,7 @@
+(* 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.
+ *)
+
+structure UnitTest = MkUnitTest (Generic)


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

Copied: mltonlib/trunk/com/ssh/unit-test/unstable/example/qc-test-example.sml (from rev 5723, mltonlib/trunk/com/ssh/misc-util/unstable/qc-test-example.sml)
===================================================================
--- mltonlib/trunk/com/ssh/misc-util/unstable/qc-test-example.sml	2007-07-04 09:22:44 UTC (rev 5723)
+++ mltonlib/trunk/com/ssh/unit-test/unstable/example/qc-test-example.sml	2007-07-07 06:24:10 UTC (rev 5733)
@@ -0,0 +1,160 @@
+(* 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.
+ *)
+
+(*
+ * This file contains simple examples of specifying QuickCheck -style
+ * randomized tests using the UnitTest framework.  The example laws
+ * are from the QuickCheck paper by Koen Claessen and John Hughes.
+ *)
+
+(*
+ * Note that a top-level module declaration is only required due to
+ * the limitations of SML/NJ's CM and is not necessary with MLTon.
+ * Specifically, the line
+ *
+ *> structure QCTestExample : sig end = struct
+ *
+ * could be replaced by a simple
+ *
+ *> let
+ *
+ * and the line
+ *
+ *> val () = unitTests
+ *
+ * by
+ *
+ *> in unitTests
+ *
+ * Also note that opening the {TopLevel} module and duplication of
+ * fixity declarations is only required due to the limitations of
+ * SML/NJ's CM.
+ *)
+
+structure QCTestExample : sig end = struct
+   (* <-- SML/NJ workaround *)
+   open TopLevel
+   infix & &`
+   infixr |<
+   (* SML/NJ workaround --> *)
+
+   open Generic UnitTest
+
+   local
+      open SortedList
+      (* The functions in the SortedList module are parameterized on both
+       * a duplicate cardinality (either #1 or #n duplicates are allowed
+       * and produced) and an ordering (a compare function).
+       *)
+   in
+      val insert     = insert     #n Int.compare
+      val isSorted   = isSorted   #n Int.compare
+      val stableSort = stableSort #n Int.compare
+   end
+
+   val sortedList = let
+      val l = list int
+   in
+      withGen (RandomGen.Monad.map stableSort (arbitrary l)) l
+   end
+
+   (* Note that one can (of course) make local auxiliary definitions, like
+    * here, to help with testing.
+    *)
+
+   val () = unitTests
+      (title "Reverse")
+
+      (chk (all int
+                (fn x =>
+                    that (rev [x] = [x]))))
+
+      (* Read the above as:
+       *
+       *   "check for all integers x that the reverse of the singleton
+       *    list x equals the singleton list x"
+       *
+       * (Of course, in reality, the property is only checked for a small
+       * finite number of random integers at a time.)
+       *
+       * In contrast to QuickCheck/Haskell, one must explicitly lift
+       * boolean values to properties using {that}.
+       *)
+
+      (chk (all (sq (list int))
+                (fn (xs, ys) =>
+                    that (rev (xs @ ys) = rev ys @ rev xs))))
+
+      (chk (all (list int)
+                (fn xs =>
+                    that (rev (rev xs) = xs))))
+
+      (title "Functions")
+
+      let
+         infix ===
+         fun (f === g) x = that (f x = g x)
+         (* An approximation of extensional equality for functions. *)
+      in
+         chk (all (uop int &` uop int &` uop int)
+                  (fn f & g & h =>
+                      all int
+                          (f o (g o h) === (f o g) o h)))
+
+         (* Note that one can (of course) also write local auxiliary
+          * definitions inside let -expressions.
+          *)
+      end
+
+      (title "Conditional laws")
+
+      (chk (all (sq int)
+                (fn (x, y) =>
+                    if x <= y then
+                       that (Int.max (x, y) = y)
+                    else
+                       skip)))
+
+      (* Read the above as:
+       *
+       *   "check for all integer pairs (x, y) that
+       *    if x <= y then max (x, y) = y"
+       *
+       * In contrast to QuickCheck/Haskell, conditional properties are
+       * specified using conditionals and {skip} rather than using an
+       * implication operator.
+       *)
+
+      (title "Monitoring test data")
+
+      (chk (all (int &` list int)
+                (fn x & xs =>
+                    if isSorted xs then
+                       (trivial (null xs))
+                          (that (isSorted (insert x xs)))
+                    else
+                       skip)))
+
+      (chk (all (int &` list int)
+                (fn x & xs =>
+                    if isSorted xs then
+                       (collect int (length xs))
+                          (that (isSorted (insert x xs)))
+                    else
+                       skip)))
+
+      (chk (all (int &` sortedList)
+                (fn x & xs =>
+                    that o isSorted |< insert x xs)))
+
+      (* Above we use a custom test data generator for sorted (or ordered)
+       * lists.  In contrast to QuickCheck/Haskell, the custom data
+       * generator needs to be injected into a type-index (recall the use
+       * of {withGen} in the implementation of sortedList above).
+       *)
+
+      $
+end

Added: mltonlib/trunk/com/ssh/unit-test/unstable/example.cm
===================================================================
--- mltonlib/trunk/com/ssh/unit-test/unstable/example.cm	2007-07-06 22:44:15 UTC (rev 5732)
+++ mltonlib/trunk/com/ssh/unit-test/unstable/example.cm	2007-07-07 06:24:10 UTC (rev 5733)
@@ -0,0 +1,13 @@
+(* 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.
+ *)
+
+group is
+   ../../extended-basis/unstable/basis.cm
+   ../../generic/unstable/lib-with-default.cm
+   ../../random/unstable/lib.cm
+   detail/sorted-list.cm
+   example/qc-test-example.sml
+   lib-with-default.cm

Added: mltonlib/trunk/com/ssh/unit-test/unstable/example.mlb
===================================================================
--- mltonlib/trunk/com/ssh/unit-test/unstable/example.mlb	2007-07-06 22:44:15 UTC (rev 5732)
+++ mltonlib/trunk/com/ssh/unit-test/unstable/example.mlb	2007-07-07 06:24:10 UTC (rev 5733)
@@ -0,0 +1,18 @@
+(* 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.
+ *)
+
+local
+   lib-with-default.mlb (* This should preferably be the first *)
+
+   $(MLTON_LIB)/com/ssh/extended-basis/unstable/basis.mlb
+   $(MLTON_LIB)/com/ssh/generic/unstable/lib-with-default.mlb
+   $(MLTON_LIB)/com/ssh/random/unstable/lib.mlb
+
+   detail/sorted-list.sml
+
+   example/qc-test-example.sml
+in
+end


Property changes on: mltonlib/trunk/com/ssh/unit-test/unstable/example.mlb
___________________________________________________________________
Name: svn:eol-style
   + native

Added: mltonlib/trunk/com/ssh/unit-test/unstable/lib-with-default.cm
===================================================================
--- mltonlib/trunk/com/ssh/unit-test/unstable/lib-with-default.cm	2007-07-06 22:44:15 UTC (rev 5732)
+++ mltonlib/trunk/com/ssh/unit-test/unstable/lib-with-default.cm	2007-07-07 06:24:10 UTC (rev 5733)
@@ -0,0 +1,13 @@
+(* 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.
+ *)
+
+library
+   library(lib.cm)
+   source(detail/unit-test.sml)
+is
+   ../../generic/unstable/lib-with-default.cm
+   detail/unit-test.sml
+   lib.cm

Added: mltonlib/trunk/com/ssh/unit-test/unstable/lib-with-default.mlb
===================================================================
--- mltonlib/trunk/com/ssh/unit-test/unstable/lib-with-default.mlb	2007-07-06 22:44:15 UTC (rev 5732)
+++ mltonlib/trunk/com/ssh/unit-test/unstable/lib-with-default.mlb	2007-07-07 06:24:10 UTC (rev 5733)
@@ -0,0 +1,12 @@
+(* 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.
+ *)
+
+local
+   $(MLTON_LIB)/com/ssh/generic/unstable/lib-with-default.mlb
+in
+   lib.mlb
+   detail/unit-test.sml
+end


Property changes on: mltonlib/trunk/com/ssh/unit-test/unstable/lib-with-default.mlb
___________________________________________________________________
Name: svn:eol-style
   + native

Modified: mltonlib/trunk/com/ssh/unit-test/unstable/lib.mlb
===================================================================
--- mltonlib/trunk/com/ssh/unit-test/unstable/lib.mlb	2007-07-06 22:44:15 UTC (rev 5732)
+++ mltonlib/trunk/com/ssh/unit-test/unstable/lib.mlb	2007-07-07 06:24:10 UTC (rev 5733)
@@ -9,6 +9,8 @@
    $(MLTON_LIB)/com/ssh/generic/unstable/lib.mlb
    $(MLTON_LIB)/com/ssh/prettier/unstable/lib.mlb
    $(MLTON_LIB)/com/ssh/random/unstable/lib.mlb
+
+   detail/sorted-list.mlb
 in
    ann
       "forceUsed"
@@ -27,7 +29,6 @@
             in
                detail/fru.sml
                detail/maybe.sml
-               detail/sorted-list.sml
             end
          in
             detail/mk-unit-test.fun

Modified: mltonlib/trunk/com/ssh/unit-test/unstable/public/unit-test.sig
===================================================================
--- mltonlib/trunk/com/ssh/unit-test/unstable/public/unit-test.sig	2007-07-06 22:44:15 UTC (rev 5732)
+++ mltonlib/trunk/com/ssh/unit-test/unstable/public/unit-test.sig	2007-07-07 06:24:10 UTC (rev 5733)
@@ -51,7 +51,7 @@
    val testRaises : Exn.t -> 'a Thunk.t -> 'b s
    (**
     * Tests that the thunk raises an exception equal to the given one.
-    * The exception constructor must be registered with {Type.regExn}.
+    * The exception constructor must be registered with {regExn}.
     *)
 
    (** == RANDOM TESTING INTERFACE == *)




More information about the MLton-commit mailing list