[MLton-commit] r6376

[Vesa Karvonen]

Added an ad hoc test with the intention of helping to notice changes to
the pickle format.

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

U   mltonlib/trunk/com/ssh/generic/unstable/test/pickle.sml

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

Modified: mltonlib/trunk/com/ssh/generic/unstable/test/pickle.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/test/pickle.sml	2008-02-04 15:00:03 UTC (rev 6375)
+++ mltonlib/trunk/com/ssh/generic/unstable/test/pickle.sml	2008-02-04 15:50:13 UTC (rev 6376)
@@ -132,5 +132,67 @@
                                                        name = "whenever"})}
            end))
 
+          (title "Pickle.Format")
+
+          (test (fn () => let
+              (* The main purpose of this highly ad hoc test is to help
+               * notice when the pickle format changes. *)
+              datatype t =
+                 NIL
+               | CON of {bool : Bool.t Vector.t,
+                         char : Char.t Ref.t,
+                         ints : Int.t * FixedInt.t * LargeInt.t,
+                         reals : Real.t * LargeReal.t,
+                         string : String.t,
+                         words : Word.t * Word8.t * Word32.t * LargeWord.t,
+                         unit : Unit.t Option.t Array.t,
+                         exn : Exn.t,
+                         rest : t} List.t
+              val t : t Rep.t = Tie.fix Y (fn t =>
+                  data
+                  (isoSum
+                   (C0'"NIL"
+                 +` C1'"CON"
+                       (list
+                        (record
+                         (isoProduct
+                          (R'"bool" (vector bool)
+                        *` R'"char" (refc char)
+                        *` R'"ints" (tuple3 (int, fixedInt, largeInt))
+                        *` R'"reals" (tuple2 (real, largeReal))
+                        *` R'"string" string
+                        *` R'"words" (tuple4 (word, word8, word32, largeWord))
+                        *` R'"unit" (array (option unit))
+                        *` R'"exn" exn
+                        *` R'"rest" t)
+                          (fn {bool=a, char=b, ints=c, reals=d, string=e, words=f,
+                               unit=g, exn=h, rest=i} =>
+                              a & b & c & d & e & f & g & h & i,
+                           fn a & b & c & d & e & f & g & h & i =>
+                              {bool=a, char=b, ints=c, reals=d, string=e, words=f,
+                               unit=g, exn=h, rest=i})))))
+                   (fn NIL => INL () | CON ? => INR ?,
+                    fn INL () => NIL | INR ? => CON ?)))
+              val t = Pickle.withTypeHash t
+              val x =
+                  CON [{bool = Vector.fromList [true, false],
+                        char = ref #"z",
+                        ints = (1110101, ~102234, 303345223),
+                        reals = (1.1111, ~2.2222),
+                        string = "string",
+                        words = (0wx1FBC2, 0wx2E, 0wxDEADBEEF, 0wx51255D4C),
+                        unit = Array.fromList [NONE, SOME ()],
+                        exn = Fail "message",
+                        rest = NIL}]
+           in
+              thatEq string {expect = "\^A<\249=\^A\^@\^A\^@\^B\^A\^@\^@z\^@\^C\
+                                      \U\240\^P\^C\166p\254\^DG\174\^T\^R\^@@\
+                                      \\158^)\203\^P\199\241?@\158^)\203\^P\199\
+                                      \\^A\192\^@\^Fstring\^@\^C\194\251\^A.\
+                                      \\239\190\173\222\^DL]%Q\^@\^B\^@\^A\^@\
+                                      \\^DFail\^@\amessage\^@",
+                             actual = pickle t x}
+           end))
+
           $
 end