[MLton-commit] r6369
Vesa Karvonen
vesak at mlton.org
Thu Jan 31 14:30:59 PST 2008
Use the REP signature to specify the rep of generics. Also some minor
simplifications in the MkUnitTest functor.
----------------------------------------------------------------------
U mltonlib/trunk/com/ssh/unit-test/unstable/detail/mk-unit-test.fun
U mltonlib/trunk/com/ssh/unit-test/unstable/public/export.sml
U mltonlib/trunk/com/ssh/unit-test/unstable/public/unit-test.sig
----------------------------------------------------------------------
Modified: mltonlib/trunk/com/ssh/unit-test/unstable/detail/mk-unit-test.fun
===================================================================
--- mltonlib/trunk/com/ssh/unit-test/unstable/detail/mk-unit-test.fun 2008-01-31 22:28:01 UTC (rev 6368)
+++ mltonlib/trunk/com/ssh/unit-test/unstable/detail/mk-unit-test.fun 2008-01-31 22:30:59 UTC (rev 6369)
@@ -6,9 +6,9 @@
functor MkUnitTest (Arg : MK_UNIT_TEST_DOM) :>
UNIT_TEST
- where type ('a, 'x) Rep.t = ('a, 'x) Arg.Open.Rep.t
- where type ('a, 'x) Rep.s = ('a, 'x) Arg.Open.Rep.s
- where type ('a, 'k, 'x) Rep.p = ('a, 'k, 'x) Arg.Open.Rep.p =
+ where type ('a, 'x) Open.Rep.t = ('a, 'x) Arg.Open.Rep.t
+ where type ('a, 'x) Open.Rep.s = ('a, 'x) Arg.Open.Rep.s
+ where type ('a, 'k, 'x) Open.Rep.p = ('a, 'k, 'x) Arg.Open.Rep.p =
struct
(* <-- SML/NJ workaround *)
open TopLevel
@@ -18,8 +18,6 @@
open Cvt Arg Prettier
- structure Rep = Open.Rep
-
val format = let open Fmt in default & realFmt := StringCvt.GEN (SOME 16) end
fun pretty t = fmt t format
@@ -129,16 +127,13 @@
| SKIP
local
- open RandomGen.RNG
+ open RandomGen.RNG Maybe
+ val W = Word.fromString
val rng =
- ref (make (Seed.fromWord let
- open Maybe
- val W = Word.fromString
- in
- getOpt (get (Monad.sum [S"-s"@`W, L"--seed"@`W,
- mk RandomDev.seed ()]),
- 0w0)
- end))
+ ref o make o Seed.fromWord |<
+ getOpt (get (Monad.sum [S"-s"@`W, L"--seed"@`W,
+ mk RandomDev.seed ()]),
+ 0w0)
in
fun nextRNG () = !rng before Ref.modify next rng
end
@@ -192,24 +187,21 @@
fun skip () = raise Skip
- fun table t = let
- val n = length t
- in
- punctuate comma o
- map (fn (n, m) => str (concat [D n, "% ", m])) o
- List.sort (Int.compare o Pair.swap o Pair.map (Sq.mk Pair.fst)) o
- map (Pair.map (fn l => Int.quot (100 * length l, n), hd) o Sq.mk) o
- List.divideByEq op = |< List.map (render NONE) t
- end
+ fun table t =
+ case length t
+ of n =>
+ (punctuate comma o
+ map (fn (n, m) => str (concat [D n, "% ", m])) o
+ List.sort (Int.compare o Pair.swap o Pair.map (Sq.mk Pair.fst)) o
+ map (Pair.map (fn l => Int.quot (100 * length l, n), hd) o Sq.mk) o
+ List.divideByEq op = |< List.map (render NONE) t)
type table = Prettier.t List.t Ref.t
- fun withFreq tblEf = let
- val tbl = ref []
- in
- tblEf tbl : Unit.t
- ; println (indent 2 (nest 2 (sep (str "Statistics:" :: table (!tbl)))) <^>
- dot)
- end
+ fun withFreq tblEf =
+ case ref []
+ of tbl => (tblEf tbl : Unit.t
+ ; println (indent 2 (nest 2 (sep (str "Statistics:" ::
+ table (!tbl)))) <^> dot))
fun collect t tbl x =
List.push tbl (pretty t x)
end
Modified: mltonlib/trunk/com/ssh/unit-test/unstable/public/export.sml
===================================================================
--- mltonlib/trunk/com/ssh/unit-test/unstable/public/export.sml 2008-01-31 22:28:01 UTC (rev 6368)
+++ mltonlib/trunk/com/ssh/unit-test/unstable/public/export.sml 2008-01-31 22:30:59 UTC (rev 6369)
@@ -12,9 +12,9 @@
functor MkUnitTest (Arg : MK_UNIT_TEST_DOM) :
UNIT_TEST
- where type ('a, 'x) Rep.t = ('a, 'x) Arg.Open.Rep.t
- where type ('a, 'x) Rep.s = ('a, 'x) Arg.Open.Rep.s
- where type ('a, 'k, 'x) Rep.p = ('a, 'k, 'x) Arg.Open.Rep.p =
+ where type ('a, 'x) Open.Rep.t = ('a, 'x) Arg.Open.Rep.t
+ where type ('a, 'x) Open.Rep.s = ('a, 'x) Arg.Open.Rep.s
+ where type ('a, 'k, 'x) Open.Rep.p = ('a, 'k, 'x) Arg.Open.Rep.p =
MkUnitTest (Arg)
(**
* Creates a unit test module.
Modified: mltonlib/trunk/com/ssh/unit-test/unstable/public/unit-test.sig
===================================================================
--- mltonlib/trunk/com/ssh/unit-test/unstable/public/unit-test.sig 2008-01-31 22:28:01 UTC (rev 6368)
+++ mltonlib/trunk/com/ssh/unit-test/unstable/public/unit-test.sig 2008-01-31 22:30:59 UTC (rev 6369)
@@ -8,8 +8,8 @@
* Signature for a simple unit testing framework.
*)
signature UNIT_TEST = sig
- structure Rep : OPEN_REP
- (** Substructure specifying the representation of generics. *)
+ include REP
+ (** Includes the representation of generics. *)
type t'
type t = (t', t', Unit.t) Fold.t
@@ -34,7 +34,8 @@
* should indicate failure by raising an exception.
*)
- val testEq : ('a, 'x) Rep.t -> {actual : 'a, expect : 'a} Thunk.t -> 'b s
+ val testEq :
+ ('a, 'x) Open.Rep.t -> {actual : 'a, expect : 'a} Thunk.t -> 'b s
(** Tests that the expected and actual values are equal. *)
val testRaises' : Exn.t Effect.t -> 'a Thunk.t -> 'b s
@@ -46,10 +47,10 @@
(** == Random Testing == *)
- val testAll : ('a, 'x) Rep.t -> 'a Effect.t -> 'b s
+ val testAll : ('a, 'x) Open.Rep.t -> 'a Effect.t -> 'b s
(** {testAll ty body} is equivalent to {test (fn () => all ty body)}. *)
- val all : ('a, 'x) Rep.t -> 'a Effect.t Effect.t
+ val all : ('a, 'x) Open.Rep.t -> 'a Effect.t Effect.t
(**
* Procedurally, tries to fault the given test effect by calling it
* with randomly generated data.
@@ -89,7 +90,7 @@
val withFreq : table Effect.t Effect.t
(** Prints a table of frequencies after the test has finished succesfully. *)
- val collect : ('a, 'x) Rep.t -> table -> 'a Effect.t
+ val collect : ('a, 'x) Open.Rep.t -> table -> 'a Effect.t
(** Adds a data point to the table. *)
(** == Assertions == *)
@@ -107,7 +108,7 @@
val thatNot : Bool.t Effect.t
(** Verifies that the given value is {false}. *)
- val thatEq : ('a, 'x) Rep.t -> {actual : 'a, expect : 'a} Effect.t
+ val thatEq : ('a, 'x) Open.Rep.t -> {actual : 'a, expect : 'a} Effect.t
(** Verifies that the expected and actual values are equal. *)
val thatRaises' : Exn.t Effect.t -> 'a Thunk.t Effect.t
More information about the MLton-commit
mailing list