[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