[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