[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