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

[yamaken at freedesktop.org]

Author: yamaken
Date: 2006-01-22 15:49:56 -0800 (Sun, 22 Jan 2006)
New Revision: 2983

Modified:
   branches/r5rs/sigscheme/src/read.c
   branches/r5rs/sigscheme/test/test-char.scm
Log:
* sigscheme/src/read.c
  - (scm_special_char_table): Remove unneeded "Space" entry
  - (read_char): Fix case-sensitivity of named chars


Modified: branches/r5rs/sigscheme/src/read.c
===================================================================
--- branches/r5rs/sigscheme/src/read.c	2006-01-22 23:34:55 UTC (rev 2982)
+++ branches/r5rs/sigscheme/src/read.c	2006-01-22 23:49:56 UTC (rev 2983)
@@ -82,10 +82,6 @@
     {'\"',   "\\\"",  "\""},         /* 34, R5RS */
     {'\\',   "\\\\",  "\\"},         /* 92, R5RS */
     {' ',    " ",     "space"},      /* 32, R5RS */
-#if 0
-    /* to avoid portability problem, we should not support #\Space and so on */
-    {' ',    " ",     "Space"},
-#endif
 #if SCM_USE_SRFI75
     {'|',    "\\|",   "|"},
 #endif
@@ -528,7 +524,12 @@
 #endif
     /* named chars */
     for (info = scm_special_char_table; info->esc_seq; info++) {
-        if (strcmp(buf, info->lex_rep) == 0)
+        /*
+         * R5RS: 6.3.4 Characters
+         * Case is significant in #\<character>, but not in #\<character name>.
+         */
+        /* FIXME: make strcasecmp(3) portable */
+        if (strcasecmp(buf, info->lex_rep) == 0)
             return MAKE_CHAR(info->code);
     }
     ERR("invalid character literal: #\\%s", buf);

Modified: branches/r5rs/sigscheme/test/test-char.scm
===================================================================
--- branches/r5rs/sigscheme/test/test-char.scm	2006-01-22 23:34:55 UTC (rev 2982)
+++ branches/r5rs/sigscheme/test/test-char.scm	2006-01-22 23:49:56 UTC (rev 2983)
@@ -35,6 +35,8 @@
 
 (load "./test/unittest.scm")
 
+(define tn test-name)
+
 (define i->chlit
   (lambda (i)
     (obj->literal (integer->char i))))
@@ -97,8 +99,22 @@
 (assert-true ") char"        (char? #\)))
 (assert-true "\\ char"       (char? #\\))
 
+(tn "R5RS named chars case-insensitivity")
+(assert-equal? (tn) #\newline (integer->char 10))
+(assert-equal? (tn) #\Newline (integer->char 10))
+(assert-equal? (tn) #\NEWLINE (integer->char 10))
+(assert-equal? (tn) #\NeWliNE (integer->char 10))
+(assert-equal? (tn) #\space   (integer->char 32))
+(assert-equal? (tn) #\Space   (integer->char 32))
+(assert-equal? (tn) #\SPACE   (integer->char 32))
+(assert-equal? (tn) #\SpACe   (integer->char 32))
+
+;;
 ;; R6RS(SRFI-75) named chars
+;;
+
 ;; NOTE: #\x0e -style character is defined in R6RS(SRFI-75)
+
 (assert-equal? "R6RS named chars" #\nul       #\x00)  ;; 0
 (assert-equal? "R6RS named chars" #\alarm     #\x07)  ;; 7
 (assert-equal? "R6RS named chars" #\backspace #\x08)  ;; 8