From: Chris Hanson <org/chris-hanson/cph>
Date: Sat, 11 Feb 2017 04:40:57 +0000 (-0800)
Subject: Fix parser case-folding to use ustring-foldcase.
X-Git-Tag: mit-scheme-pucked-9.2.12~220^2~150
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=4bb8bee2c13fb8c1675979c706e50a54de88d95f;p=mit-scheme.git

Fix parser case-folding to use ustring-foldcase.
---

diff --git a/src/runtime/parse.scm b/src/runtime/parse.scm
index 595d2c495..c7a3c5585 100644
--- a/src/runtime/parse.scm
+++ b/src/runtime/parse.scm
@@ -520,10 +520,6 @@ USA.
 
 (define (parse-atom-1 port db prefix quoting?)
   (let ((port* (open-output-string))
-	(%canon
-	 (if (db-fold-case? db)
-	     char-downcase
-	     (lambda (char) char)))
 	(atom-delimiters (db-atom-delimiters db))
 	(constituents (db-constituents db)))
     (define (%read)
@@ -554,9 +550,14 @@ USA.
 			(char (%peek)))
       (if (or (eof-object? char)
 	      (char-set-member? atom-delimiters char))
-	  (if quoting?
-	      (values (get-output-string port*) quoted? previous-char)
-	      (get-output-string port*))
+	  (let ((atom
+		 (let ((s (get-output-string port*)))
+		   (if (db-fold-case? db)
+		       (ustring-foldcase s)
+		       s))))
+	    (if quoting?
+		(values atom quoted? previous-char)
+		atom))
 	  (begin
 	    (if (not (char-set-member? constituents char))
 		(error:illegal-char char))
@@ -584,7 +585,7 @@ USA.
 			 (read-unquoted #t #f (%peek)))
 		       (error:illegal-char char)))
 		  (else
-		   (write-char (%canon char) port*)
+		   (write-char char port*)
 		   (read-unquoted quoted? char (%peek)))))))))
 
 (define (handler:list port db ctx char)