[uim-commit] r2224 - in branches/r5rs/sigscheme: . test

[kzk at freedesktop.org]

Author: kzk
Date: 2005-11-22 04:12:55 -0800 (Tue, 22 Nov 2005)
New Revision: 2224

Modified:
   branches/r5rs/sigscheme/operations.c
   branches/r5rs/sigscheme/sigscheme.h
   branches/r5rs/sigscheme/test/test-num.scm
Log:
* support radix of "string->number"

* sigscheme/operations.c
  - (ScmOp_string2number): change function args and change function
    type to support radix.

* sigscheme/sigscheme.h
  - (ScmOp_string2number): change argument

* sigscheme/test/test-num.scm
  - add testcases for "string->number"


Modified: branches/r5rs/sigscheme/operations.c
===================================================================
--- branches/r5rs/sigscheme/operations.c	2005-11-22 11:21:40 UTC (rev 2223)
+++ branches/r5rs/sigscheme/operations.c	2005-11-22 12:12:55 UTC (rev 2224)
@@ -537,24 +537,36 @@
   return Scm_NewStringCopying(p);
 }
 
-/* TODO : support radix */
-ScmObj ScmOp_string2number(ScmObj string)
+ScmObj ScmOp_string2number(ScmObj str, ScmObj args)
 {
-    char  *str = NULL;
-    char  *p   = NULL;
-    size_t len = 0;
-    DECLARE_FUNCTION("string->number", ProcedureFixed1);
+    ScmObj radix = SCM_FALSE;
+    int r = 10;
+    int num = 0;
+    char *first_nondigit = NULL;
+    DECLARE_FUNCTION("string->number", ProcedureVariadic1);
 
-    ASSERT_STRINGP(string);
+    ASSERT_STRINGP(str);
 
-    str = SCM_STRING_STR(string);
-    len = strlen(str);
-    for (p = str; p < str + len; p++) {
-        if (isdigit(*p) == 0)
-            return SCM_FALSE;
+    /* r = radix */
+    if (!NO_MORE_ARG(args)) {
+        radix = POP_ARG(args);
+        ASSERT_NO_MORE_ARG(args);
+
+        ASSERT_INTP(radix);
+        r = SCM_INT_VALUE(radix);
+#if SCM_STRICT_R5RS
+      if (!(r == 2 || r == 8 || r == 10 || r == 16))
+#else
+      if (!(2 <= r && r <= 16))
+#endif
+          ERR_OBJ("invalid or unsupported radix", radix);
     }
 
-    return Scm_NewInt((int)atoi(SCM_STRING_STR(string)));
+    num = (int)strtol(SCM_STRING_STR(str), &first_nondigit, r);
+    if (*first_nondigit)
+        ERR("ill-formatted number: %s", SCM_STRING_STR(str));
+
+    return Scm_NewInt(num);
 }
 
 /*===================================

Modified: branches/r5rs/sigscheme/sigscheme.h
===================================================================
--- branches/r5rs/sigscheme/sigscheme.h	2005-11-22 11:21:40 UTC (rev 2223)
+++ branches/r5rs/sigscheme/sigscheme.h	2005-11-22 12:12:55 UTC (rev 2224)
@@ -473,7 +473,7 @@
 ScmObj ScmOp_modulo(ScmObj scm_n1, ScmObj scm_n2);
 ScmObj ScmOp_remainder(ScmObj scm_n1, ScmObj scm_n2);
 ScmObj ScmOp_number2string (ScmObj num, ScmObj args);
-ScmObj ScmOp_string2number(ScmObj string);
+ScmObj ScmOp_string2number(ScmObj str, ScmObj args);
 ScmObj ScmOp_not(ScmObj obj);
 ScmObj ScmOp_booleanp(ScmObj obj);
 ScmObj ScmOp_car(ScmObj obj);

Modified: branches/r5rs/sigscheme/test/test-num.scm
===================================================================
--- branches/r5rs/sigscheme/test/test-num.scm	2005-11-22 11:21:40 UTC (rev 2223)
+++ branches/r5rs/sigscheme/test/test-num.scm	2005-11-22 12:12:55 UTC (rev 2224)
@@ -151,9 +151,21 @@
 (assert-equal? "number->string test3" "100" (number->string 100))
 
 ; check string->number
-(assert-equal? "string->number test1" 1   (string->number "1"))
-(assert-equal? "string->number test2" 10  (string->number "10"))
-(assert-equal? "string->number test2" 100 (string->number "100"))
+(assert-equal? "string->number test1"  1   (string->number "1"))
+(assert-equal? "string->number test2"  10  (string->number "10"))
+(assert-equal? "string->number test3"  100 (string->number "100"))
+(assert-equal? "string->number test4"  1   (string->number "1"   2))
+(assert-equal? "string->number test5"  2   (string->number "10"  2))
+(assert-equal? "string->number test6"  4   (string->number "100" 2))
+(assert-equal? "string->number test7"  1   (string->number "1"   8))
+(assert-equal? "string->number test8"  8   (string->number "10"  8))
+(assert-equal? "string->number test9"  64  (string->number "100" 8))
+(assert-equal? "string->number test10" 1   (string->number "1"   10))
+(assert-equal? "string->number test11" 10  (string->number "10"  10))
+(assert-equal? "string->number test12" 100 (string->number "100" 10))
+(assert-equal? "string->number test13" 1   (string->number "1"   16))
+(assert-equal? "string->number test14" 16  (string->number "10"  16))
+(assert-equal? "string->number test15" 256 (string->number "100" 16))
 
 ; numbers in various radices
 (assert-true "binary number test1" (= #b1111 15))