[uim-commit] r3040 - in branches/r5rs/sigscheme: src test

[yamaken at freedesktop.org]

Author: yamaken
Date: 2006-01-30 00:26:55 -0800 (Mon, 30 Jan 2006)
New Revision: 3040

Modified:
   branches/r5rs/sigscheme/src/number.c
   branches/r5rs/sigscheme/src/read.c
   branches/r5rs/sigscheme/test/test-num.scm
Log:
* sigscheme/src/number.c
  - (scm_p_number2string): Fix broken -INT_MIN capability
* sigscheme/src/read.c
  - (INT_LITERAL_LEN_MAX): Ditto
* sigscheme/test/test-num.scm
  - Add tests for number->string. both 32bit and 64bit tests are
    passed on storage-fatty


Modified: branches/r5rs/sigscheme/src/number.c
===================================================================
--- branches/r5rs/sigscheme/src/number.c	2006-01-30 07:38:50 UTC (rev 3039)
+++ branches/r5rs/sigscheme/src/number.c	2006-01-30 08:26:55 UTC (rev 3040)
@@ -439,11 +439,12 @@
 ScmObj
 scm_p_number2string(ScmObj num, ScmObj args)
 {
-  char buf[sizeof(scm_int_t) * CHAR_BIT + sizeof("")];
+  char buf[sizeof("-") + SCM_INT_BITS];
   char *p;
   const char *end;
-  scm_int_t n, digit;
-  int r;
+  scm_int_t n;
+  /* 'un' must be unsinged to be capable of -INT_MIN */
+  scm_uint_t un, digit, r;
   scm_bool neg;
   DECLARE_FUNCTION("number->string", procedure_variadic_1);
 
@@ -451,16 +452,16 @@
 
   n = SCM_INT_VALUE(num);
   neg = (n < 0);
-  n = (neg) ? -n : n;
-  r = prepare_radix(SCM_MANGLE(name), args);
+  un = (neg) ? -n : n;
+  r = (scm_uint_t)prepare_radix(SCM_MANGLE(name), args);
 
   end = p = &buf[sizeof(buf) - 1];
   *p = '\0';
 
   do {
-      digit = n % r;
+      digit = un % r;
       *--p = (digit <= 9) ? '0' + digit : 'A' + digit - 10;
-  } while (n /= r);
+  } while (un /= r);
   if (neg)
     *--p = '-';
 

Modified: branches/r5rs/sigscheme/src/read.c
===================================================================
--- branches/r5rs/sigscheme/src/read.c	2006-01-30 07:38:50 UTC (rev 3039)
+++ branches/r5rs/sigscheme/src/read.c	2006-01-30 08:26:55 UTC (rev 3040)
@@ -67,7 +67,7 @@
 #define CHAR_LITERAL_LEN_MAX (sizeof("backspace") - sizeof(""))
 
 /* #b-010101... */
-#define INT_LITERAL_LEN_MAX SCM_INT_BITS
+#define INT_LITERAL_LEN_MAX (sizeof((char)'-') + SCM_INT_BITS)
 
 #define WHITESPACE_CHARS " \t\n\r\v\f"
 #define DELIMITER_CHARS  "()\";" WHITESPACE_CHARS

Modified: branches/r5rs/sigscheme/test/test-num.scm
===================================================================
--- branches/r5rs/sigscheme/test/test-num.scm	2006-01-30 07:38:50 UTC (rev 3039)
+++ branches/r5rs/sigscheme/test/test-num.scm	2006-01-30 08:26:55 UTC (rev 3040)
@@ -32,6 +32,8 @@
 
 (load "./test/unittest.scm")
 
+(use srfi-23)
+
 (define tn test-name)
 
 ; check =
@@ -237,7 +239,44 @@
 (assert-equal? (tn) "1"        (number->string 1    2))
 (assert-equal? (tn) "1010"     (number->string 10   2))
 (assert-equal? (tn) "1100100"  (number->string 100  2))
+(if (and (symbol-bound? 'greatest-fixnum)
+         (symbol-bound? 'least-fixnum))
+    (let ((greatest (number->string (greatest-fixnum))))
+      (cond
+       ((string=? greatest "2147483647")
+        (tn "number->string 32bit fixnum")
+        (assert-equal? (tn)
+                       "-2147483648"
+                       (number->string (least-fixnum)))
+        (assert-equal? (tn)
+                       "1111111111111111111111111111111"
+                       (number->string (greatest-fixnum) 2))
+        (assert-equal? (tn)
+                       "-10000000000000000000000000000000"
+                       (number->string (least-fixnum) 2))
+        (assert-equal? (tn)
+                       "-1111111111111111111111111111111"
+                       (number->string (+ (least-fixnum) 1) 2)))
 
+       ((string=? greatest "9223372036854775807")
+        (tn "number->string 64bit fixnum")
+        (assert-equal? (tn)
+                       "-9223372036854775808"
+                       (number->string (least-fixnum)))
+        (assert-equal? (tn)
+                       "111111111111111111111111111111111111111111111111111111111111111"
+                       (number->string (greatest-fixnum) 2))
+        (assert-equal? (tn)
+                       "-1000000000000000000000000000000000000000000000000000000000000000"
+                       (number->string (least-fixnum) 2))
+        (assert-equal? (tn)
+                       "-111111111111111111111111111111111111111111111111111111111111111"
+                       (number->string (+ (least-fixnum) 1) 2)))
+
+       (else
+        (error "unknown int bitwidth")))))
+
+
 ; check string->number
 (assert-equal? "string->number test1"  1   (string->number "1"))
 (assert-equal? "string->number test2"  10  (string->number "10"))