[MLton-commit] r5734

Vesa Karvonen vesak at mlton.org
Sat Jul 7 02:55:55 PDT 2007


Introduced an ad hoc script for running examples.
----------------------------------------------------------------------

A   mltonlib/trunk/com/ssh/unit-test/unstable/Example.sh
A   mltonlib/trunk/com/ssh/unit-test/unstable/example/assoc-test.sml
D   mltonlib/trunk/com/ssh/unit-test/unstable/example/qc-test-example.sml
A   mltonlib/trunk/com/ssh/unit-test/unstable/example/qc-test.sml
U   mltonlib/trunk/com/ssh/unit-test/unstable/example.cm
U   mltonlib/trunk/com/ssh/unit-test/unstable/example.mlb

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

Added: mltonlib/trunk/com/ssh/unit-test/unstable/Example.sh
===================================================================
--- mltonlib/trunk/com/ssh/unit-test/unstable/Example.sh	2007-07-07 06:24:10 UTC (rev 5733)
+++ mltonlib/trunk/com/ssh/unit-test/unstable/Example.sh	2007-07-07 09:55:54 UTC (rev 5734)
@@ -0,0 +1,32 @@
+#!/bin/bash
+
+# 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.
+
+set -e
+
+echo "Run example tests with SML/NJ..."
+if sml -h > /dev/null ; then 
+    eb=../../extended-basis/unstable
+
+    if echo ''                                                   \
+        | sml -m example.cm                                      \
+              $eb/public/export/{open-top-level.sml,infixes.sml} \
+              example/*.sml ; then echo "Unexpected!" ; fi
+fi
+
+echo "Compile example tests with MLton and run them..."
+if mlton  > /dev/null ; then
+    mkdir -p generated
+
+    echo "SML_COMPILER mlton
+MLTON_LIB $(cd ../../../.. && pwd)" > generated/mlb-path-map
+
+    mlton -mlb-path-map generated/mlb-path-map \
+          -output generated/example            \
+          example.mlb
+
+    if generated/example ; then echo "Unexpected!" ; fi
+fi


Property changes on: mltonlib/trunk/com/ssh/unit-test/unstable/Example.sh
___________________________________________________________________
Name: svn:executable
   + *
Name: svn:eol-style
   + native

Copied: mltonlib/trunk/com/ssh/unit-test/unstable/example/assoc-test.sml (from rev 5723, mltonlib/trunk/com/ssh/misc-util/unstable/assoc-test.sml)
===================================================================
--- mltonlib/trunk/com/ssh/misc-util/unstable/assoc-test.sml	2007-07-04 09:22:44 UTC (rev 5723)
+++ mltonlib/trunk/com/ssh/unit-test/unstable/example/assoc-test.sml	2007-07-07 09:55:54 UTC (rev 5734)
@@ -0,0 +1,30 @@
+(* 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 a simple example of a QuickCheck -style
+ * randomized test using the UnitTest framework.
+ *)
+
+val () = let
+   open Generic UnitTest
+
+   fun assoc op + t =
+       all (t &` t &` t)
+           (fn x & y & z =>
+               that (eq t ((x + y) + z, x + (y + z))))
+in
+   unitTests
+      (title "Assoc")
+
+      (chk (assoc op + word))
+      (* This law holds. *)
+
+      (chk (assoc op + real))
+      (* This law does not hold. *)
+
+      $
+end

Deleted: mltonlib/trunk/com/ssh/unit-test/unstable/example/qc-test-example.sml
===================================================================
--- mltonlib/trunk/com/ssh/unit-test/unstable/example/qc-test-example.sml	2007-07-07 06:24:10 UTC (rev 5733)
+++ mltonlib/trunk/com/ssh/unit-test/unstable/example/qc-test-example.sml	2007-07-07 09:55:54 UTC (rev 5734)
@@ -1,160 +0,0 @@
-(* 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

Copied: mltonlib/trunk/com/ssh/unit-test/unstable/example/qc-test.sml (from rev 5733, mltonlib/trunk/com/ssh/unit-test/unstable/example/qc-test-example.sml)
===================================================================
--- mltonlib/trunk/com/ssh/unit-test/unstable/example/qc-test-example.sml	2007-07-07 06:24:10 UTC (rev 5733)
+++ mltonlib/trunk/com/ssh/unit-test/unstable/example/qc-test.sml	2007-07-07 09:55:54 UTC (rev 5734)
@@ -0,0 +1,130 @@
+(* 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.
+ *)
+
+val () = let
+   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.
+    *)
+in
+   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

Modified: mltonlib/trunk/com/ssh/unit-test/unstable/example.cm
===================================================================
--- mltonlib/trunk/com/ssh/unit-test/unstable/example.cm	2007-07-07 06:24:10 UTC (rev 5733)
+++ mltonlib/trunk/com/ssh/unit-test/unstable/example.cm	2007-07-07 09:55:54 UTC (rev 5734)
@@ -4,10 +4,15 @@
  * See the LICENSE file or http://mlton.org/License for details.
  *)
 
-group is
+group
+   library(../../extended-basis/unstable/basis.cm)
+   library(../../generic/unstable/lib-with-default.cm)
+   library(../../random/unstable/lib.cm)
+   library(detail/sorted-list.cm)
+   library(lib-with-default.cm)
+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

Modified: mltonlib/trunk/com/ssh/unit-test/unstable/example.mlb
===================================================================
--- mltonlib/trunk/com/ssh/unit-test/unstable/example.mlb	2007-07-07 06:24:10 UTC (rev 5733)
+++ mltonlib/trunk/com/ssh/unit-test/unstable/example.mlb	2007-07-07 09:55:54 UTC (rev 5734)
@@ -13,6 +13,7 @@
 
    detail/sorted-list.sml
 
-   example/qc-test-example.sml
+   example/assoc-test.sml
+   example/qc-test.sml
 in
 end




More information about the MLton-commit mailing list