[MLton-devel] cvs commit: fixed-integer regression test

Stephen Weeks sweeks@users.sourceforge.net
Wed, 25 Jun 2003 14:22:53 -0700


sweeks      03/06/25 14:22:53

  Modified:    basis-library/integer integer.fun
               include  c-chunk.h
               runtime/basis/Int quot.c rem.c
  Added:       regression fixed-integer.ok fixed-integer.sml
  Log:
  Added a regression test for fixed size integers.
  
  Fixed a bug in Int{8,16}.fromInt -- they didn't properly raise
  overflow.
  
  fixed-integer.sml now passes with -native false.  There are still
  problems with -native true.

Revision  Changes    Path
1.2       +9 -2      mlton/basis-library/integer/integer.fun

Index: integer.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/integer/integer.fun,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- integer.fun	24 Jun 2003 18:36:47 -0000	1.1
+++ integer.fun	25 Jun 2003 21:22:53 -0000	1.2
@@ -12,6 +12,15 @@
 
 open I
 
+val detectOverflow = Primitive.detectOverflow
+
+fun fromInt (i: Int.int): int =
+   if not detectOverflow
+      orelse (Primitive.Int.<= (toInt minInt', i)
+	      andalso Primitive.Int.<= (i, toInt maxInt'))
+      then I.fromInt i
+   else raise Overflow
+
 val precision: Int.int option = SOME precision'
 
 val maxInt: int option = SOME maxInt'
@@ -20,8 +29,6 @@
 (* These are overriden in patch.sml after int-inf.sml has been defined. *)
 val toLarge: int -> LargeInt.int = fn _ => raise Fail "toLarge"
 val fromLarge: LargeInt.int -> int = fn _ => raise Fail "fromLarge"
-
-val detectOverflow = Primitive.detectOverflow
 
 val zero: int = fromInt 0
 val one: int = fromInt 1



1.7       +4 -0      mlton/include/c-chunk.h

Index: c-chunk.h
===================================================================
RCS file: /cvsroot/mlton/mlton/include/c-chunk.h,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- c-chunk.h	23 Jun 2003 04:58:54 -0000	1.6
+++ c-chunk.h	25 Jun 2003 21:22:53 -0000	1.7
@@ -617,6 +617,10 @@
 	static inline t f##_to##t (f x) {	\
 		return (t)x;			\
 	}
+coerce (Int8, Int32)
+coerce (Int32, Int8)
+coerce (Int16, Int32)
+coerce (Int32, Int16)
 coerce (Int32, Real64)
 coerce (Int32, Word8)
 coerce (Int32, Word32)



1.1                  mlton/regression/fixed-integer.ok

Index: fixed-integer.ok
===================================================================
Testing Int8
Testing Int16
Testing Int32



1.1                  mlton/regression/fixed-integer.sml

Index: fixed-integer.sml
===================================================================
(* This code tests every value in a module matching the INTEGER signature
 * by comparing its behaviour with LargeInt.
 *
 * It assumes that the module is for fixed integers, i.e. isSome precision.
 *)

functor Test (I: INTEGER) =
   struct
      fun foreach (l, f) = List.app f l

      val m = concat ["Int", Int.toString (valOf I.precision)]
	 
      val _ = print (concat ["Testing ", m, "\n"])
	 
      val nums =
	 [valOf I.maxInt,
	  I.- (valOf I.maxInt, I.fromInt 1)]
	 @ (List.map I.fromInt [100, 10, 5, 2, 1, 0, ~1, ~2, 5, 10, 100])
	 @ [I.+ (I.fromInt 1, valOf I.minInt),
	    valOf I.minInt]

      fun err msg = print (concat [m, ": ", concat msg, "\n"])

      datatype z = datatype StringCvt.radix
      val _ =
	 foreach
	 (nums, fn i =>
	  foreach
	  ([("toString", I.toString, LargeInt.toString),
	    ("fmt BIN", I.fmt BIN, LargeInt.fmt BIN),
	    ("fmt OCT", I.fmt BIN, LargeInt.fmt BIN),
	    ("fmt DEC", I.fmt BIN, LargeInt.fmt BIN),
	    ("fmt HEX", I.fmt BIN, LargeInt.fmt BIN)],
	   fn (name, f, f') =>
	   let
	      val s = f i
	      val s' = f' (I.toLarge i)
	   in
	      if s = s'
		 then ()
	      else err [name, " ", s, " <> ", name, " ", s']
	   end))

      val _ =
	 foreach
	 (nums, fn i =>
	  if SOME i = (SOME (I.fromLarge (I.toLarge i)) handle Overflow => NONE)
	     then ()
	  else err ["{from,to}Large ", I.toString i, "\n"])

      structure Answer =
	 struct
	    datatype t =
	       Div
	     | Int of I.int
	     | Overflow

	    val toString =
	       fn Div => "Div"
		| Int i => I.toString i
		| Overflow => "Overflow"

	    fun run (f: unit -> I.int): t =
	       Int (f ())
	       handle General.Div => Div
		    | General.Overflow => Overflow

	    val equals: t * t -> bool = op =
	 end

      val _ =
	 foreach
	 ([("abs", I.abs, LargeInt.abs),
	   ("~", I.~, LargeInt.~),
	   ("fromString o toString",
	    valOf o I.fromString o I.toString,
	    valOf o LargeInt.fromString o LargeInt.toString)],
	  fn (name, f, f') =>
	  foreach
	  (nums, fn i =>
	   let
	      val a = Answer.run (fn () => f i)
	      val a' = Answer.run (fn () => I.fromLarge (f' (I.toLarge i)))
	   in
	      if Answer.equals (a, a')
		 then ()
	      else err [name, " ", I.toString i,
			" = ", Answer.toString a,
			" <> ", Answer.toString a']
	   end))

      val _ =
	 foreach
	 (nums, fn i =>
	  foreach
	  ([("BIN", BIN), ("OCT", OCT), ("DEC", DEC), ("HEX", HEX)],
	   fn (rName, r) =>
	   let
	      val i' = valOf (StringCvt.scanString (I.scan r) (I.fmt r i))
	   in
	      if i = i'
		 then ()
	      else err ["scan ", rName, " ", I.toString i, " = ", I.toString i']
	   end))

      val _ =
	 foreach
	 ([("sign", I.sign, LargeInt.sign),
	   ("toInt", I.toInt, LargeInt.toInt)],
	  fn (name, f, f') =>
	  foreach
	  (nums, fn i =>
	   let
	      val a = Answer.run (fn () => I.fromInt (f i))
	      val a' = Answer.run (fn () => I.fromInt (f' (I.toLarge i)))
	   in
	      if Answer.equals (a, a')
		 then ()
	      else err [name, " ", I.toString i,
			" = ", Answer.toString a,
			" <> ", Answer.toString a']
	   end))
	 
      val _ =
	 foreach
	 ([("+", I.+, LargeInt.+),
	   ("-", I.-, LargeInt.-),
	   ("*", I.*, LargeInt.* ),
	   ("div", I.div, LargeInt.div),
	   ("max", I.max, LargeInt.max),
	   ("min", I.min, LargeInt.min),
	   ("mod", I.mod, LargeInt.mod),
	   ("quot", I.quot, LargeInt.quot),
	   ("rem", I.rem, LargeInt.rem)],
	  fn (name,
	      f: I.int * I.int -> I.int,
	      f': LargeInt.int * LargeInt.int -> LargeInt.int) =>
	  foreach
	  (nums, fn i: I.int =>
	   foreach
	   (nums, fn j: I.int =>
	    let
	       val a = Answer.run (fn () => f (i, j))
	       val a' = Answer.run (fn () =>
				    I.fromLarge (f' (I.toLarge i, I.toLarge j)))
	    in
	       if Answer.equals (a, a')
		  then ()
	       else err [I.toString i, " ", name, " ", I.toString j,
			 " = ", Answer.toString a, " <> ", Answer.toString a']
	    end)))

      val _ =
	 foreach
	 ([(">", I.>, LargeInt.>),
	   (">=", I.>=, LargeInt.>=),
	   ("<", I.<, LargeInt.<),
	   ("<=", I.<=, LargeInt.<=),
	   ("sameSign", I.sameSign, LargeInt.sameSign)],
	  fn (name, f, f') =>
	  foreach
	  (nums, fn i: I.int =>
	   foreach
	   (nums, fn j: I.int =>
	    let
	       val b = f (i, j)
	       val b' = f' (I.toLarge i, I.toLarge j)
	    in
	       if b = b'
		  then ()
	       else err [I.toString i, " ", name, " ", I.toString j,
			 " = ", Bool.toString b, " <> ", Bool.toString b']
	    end)))

      structure Order =
	 struct
	    datatype t = datatype order

	    val equals: t * t -> bool = op =

	    val toString =
	       fn EQUAL => "EQUAL"
		| GREATER => "GREATER"
		| LESS => "LESS"
	 end
      
      val _ =
	 foreach
	 (nums, fn i =>
	  foreach
	  (nums, fn j =>
	   let
	      val ord = I.compare (i, j)
	      val ord' = LargeInt.compare (I.toLarge i, I.toLarge j)
	   in
	      if Order.equals (ord, ord')
		 then ()
	      else err ["compare (", I.toString i, ", ",
			I.toString j, ") = ",
			Order.toString ord,
			" <> ",
			Order.toString ord']
	   end))
		 
   end

structure S = Test (Int8)
structure S = Test (Int16)
structure S = Test (Int32)



1.6       +13 -4     mlton/runtime/basis/Int/quot.c

Index: quot.c
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/basis/Int/quot.c,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- quot.c	23 Jun 2003 04:59:01 -0000	1.5
+++ quot.c	25 Jun 2003 21:22:53 -0000	1.6
@@ -26,10 +26,19 @@
  * implements / and %.
  */
 
+#if ! (defined (__i386__) || defined (__sparc__))
+#error check that C / correctly implements quot from the basis library
+#endif
+
+Int8 Int8_quot (Int8 n, Int8 d) {
+	return n / d;
+}
+
+Int16 Int16_quot (Int16 n, Int16 d) {
+	return n / d;
+}
+
 Int32 Int32_quot (Int32 n, Int32 d) {
-#if (defined (__i386__) || defined (__sparc__))
 	return n / d;
-#else
-#error check that C / correctly implements Int32.quot from the basis library
-#endif
 }
+



1.5       +12 -4     mlton/runtime/basis/Int/rem.c

Index: rem.c
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/basis/Int/rem.c,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- rem.c	23 Jun 2003 04:59:01 -0000	1.4
+++ rem.c	25 Jun 2003 21:22:53 -0000	1.5
@@ -2,10 +2,18 @@
 
 /* See the comment in quot.c. */
 
+#if ! (defined (__i386__) || defined (__sparc__))
+#error check that C % correctly implements rem from the basis library
+#endif
+
+Int8 Int8_rem (Int8 n, Int8 d) {
+	return n % d;
+}
+
+Int16 Int16_rem (Int16 n, Int16 d) {
+	return n % d;
+}
+
 Int32 Int32_rem (Int32 n, Int32 d) {
-#if (defined (__i386__) || defined (__sparc__))
 	return n % d;
-#else
-#error check that C % correctly implements Int32.rem from the basis library
-#endif
 }





-------------------------------------------------------
This SF.Net email is sponsored by: INetU
Attention Web Developers & Consultants: Become An INetU Hosting Partner.
Refer Dedicated Servers. We Manage Them. You Get 10% Monthly Commission!
INetU Dedicated Managed Hosting http://www.inetu.net/partner/index.php
_______________________________________________
MLton-devel mailing list
MLton-devel@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/mlton-devel