|
From: Vesa K. <ve...@ml...> - 2007-01-12 04:35:03
|
Initial commit of a lib of misc utils to be refactored. ---------------------------------------------------------------------- A mltonlib/trunk/com/ssh/misc-util/unstable/show-test.sml ---------------------------------------------------------------------- Added: mltonlib/trunk/com/ssh/misc-util/unstable/show-test.sml =================================================================== --- mltonlib/trunk/com/ssh/misc-util/unstable/show-test.sml 2007-01-12 12:34:02 UTC (rev 5051) +++ mltonlib/trunk/com/ssh/misc-util/unstable/show-test.sml 2007-01-12 12:34:47 UTC (rev 5052) @@ -0,0 +1,101 @@ +(* 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. + *) + +(* + * Unit tests for the {Show} module. + *) + +val () = let + open Type UnitTest + + fun tst n t s v = + testEq + string + (fn () => + {expect = s, + actual = show n t v}) +in + unitTests + (title "Show") + + (tst NONE unit "()" ()) + + (tst NONE word "0wx15" 0wx15) + + (tst (SOME 6) (list int) + "[1,\n 2,\n 3]" + [1, 2, 3]) + + (tst (SOME 2) (vector bool) + "#[true,\n\ + \ false]" + (Vector.fromList [true, false])) + + (tst (SOME 15) (tuple3 (option unit, string, exn)) + "(NONE,\n\ + \ \"a\",\n\ + \ Empty)" + (NONE, "a", Empty)) + + (tst NONE (array unit) "#()" (Array.array (0, ()))) + + (tst NONE real "~3.141" ~3.141) + + (tst (SOME 22) + ((order |` unit) &` order &` (unit |` order)) + "&\n\ + \ (& (INL LESS, EQUAL),\n\ + \ INR GREATER)" + (INL LESS & EQUAL & INR GREATER)) + + let + fun chk s e = tst (SOME 11) string e s + in + fn ? => + (pass ?) + (chk "does not fit" "\"does not fit\"") + (chk "does\nnot\nfit" "\"does\\n\\\n\\not\\n\\\n\\fit\"") + (chk "does fit" "\"does fit\"") + (chk "does\nfit" "\"does\\nfit\"") + end + + let + exception Unknown + in + tst NONE exn "#Unknown" Unknown + end + + (tst (SOME 9) + (iso (record (R' "1" int *` + R' "+" (uop int) *` + R' "c" char)) + (fn {1 = a, + = b, c = c} => a & b & c, + fn a & b & c => {1 = a, + = b, c = c})) + "{1 = 2,\n\ + \ + = #fn,\n\ + \ c =\n\ + \ #\"d\"}" + {1 = 2, + = id, c = #"d"}) + + let + datatype s = S of s option ref Sq.t + val x as S (l, r) = S (ref NONE, ref NONE) + val () = (l := SOME x ; r := SOME x) + in + tst (SOME 50) + (Tie.fix Y (fn s => + iso (data (C1' "S" (sq (refc (option s))))) + (fn S ? => ?, S))) + "S\n\ + \ (#0 as ref\n\ + \ (SOME (S (#0, #1 as ref (SOME (S (#0, #1)))))),\n\ + \ #0 as ref\n\ + \ (SOME (S (#1 as ref (SOME (S (#1, #0))), #0))))" + x + end + + $ +end Property changes on: mltonlib/trunk/com/ssh/misc-util/unstable/show-test.sml ___________________________________________________________________ Name: svn:eol-style + native |