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

[yamaken at freedesktop.org]

Author: yamaken
Date: 2005-12-16 15:30:12 -0800 (Fri, 16 Dec 2005)
New Revision: 2616

Modified:
   branches/r5rs/sigscheme/read.c
   branches/r5rs/sigscheme/test/test-syntax.scm
Log:
* sigscheme/read.c
  - (read_number_or_symbol): Support non-R5RS '-sym form symbol for
    uim when !SCM_STRICT_R5RS
* sigscheme/test/test-syntax.scm
  - Add tests for the form


Modified: branches/r5rs/sigscheme/read.c
===================================================================
--- branches/r5rs/sigscheme/read.c	2005-12-16 22:38:42 UTC (rev 2615)
+++ branches/r5rs/sigscheme/read.c	2005-12-16 23:30:12 UTC (rev 2616)
@@ -645,8 +645,17 @@
             len = read_token(port, &err, buf, sizeof(buf), DELIMITER_CHARS);
             if (err == TOKEN_BUF_EXCEEDED)
                 ERR("invalid number literal");
-            if (!buf[1])
+
+            
+            if (!buf[1]                         /* '+' or '-' */
+#if !SCM_STRICT_R5RS
+                || c == '-' && isalpha(buf[1])  /* '-sym' */
+#endif
+                )
+            {
                 return scm_intern(buf);
+            }
+
             return parse_number(port, buf, sizeof(buf), 'd');
         }
 

Modified: branches/r5rs/sigscheme/test/test-syntax.scm
===================================================================
--- branches/r5rs/sigscheme/test/test-syntax.scm	2005-12-16 22:38:42 UTC (rev 2615)
+++ branches/r5rs/sigscheme/test/test-syntax.scm	2005-12-16 23:30:12 UTC (rev 2616)
@@ -53,6 +53,10 @@
 (assert-parse-error "invalid identifier" "+a")
 (assert-parse-error "invalid identifier" "++")
 (assert-parse-error "invalid identifier" "--")
+(assert-parse-error "invalid identifier" "-=")
+(assert-parse-error "invalid identifier" "-$")
+(assert-parse-error "invalid identifier" "-.")
+(assert-parse-error "invalid identifier" "-@")
 (assert-parse-error "invalid identifier" "@")
 (assert-parse-error "invalid identifier" "1a")
 
@@ -109,6 +113,9 @@
 (assert-true "identifier" (symbol? (string-read "a-")))
 (assert-true "identifier" (symbol? (string-read "a@")))
 (assert-true "identifier" (symbol? (string-read "a1")))
+(if (and (provided? "sigscheme")
+         (not (provided? "strict-r5rs")))
+    (assert-true "identifier" (symbol? (string-read "-a"))))
 
 (assert-true "integer" (integer? (string-read "1")))
 (assert-true "integer" (integer? (string-read "1")))