~ chicken-core (chicken-5) bfe377b0f900e74a692613f2f56270576fea7a83

commit bfe377b0f900e74a692613f2f56270576fea7a83
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Mon Oct 25 02:17:50 2010 -0400
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Mon Oct 25 02:17:50 2010 -0400

    blob read-syntax fixes

diff --git a/library.scm b/library.scm
index 7008e5a4..d2f0c6f9 100644
--- a/library.scm
+++ b/library.scm
@@ -2809,11 +2809,14 @@ EOF
 	    ((char=? #\} c)
 	     (let ((str (##sys#reverse-list->string
 			 (if h
-			     (cons (integer->char h) lst)
+			     (cons (integer->char (fxshr h 4)) lst)
 			     lst))))
 	       (##core#inline "C_string_to_bytevector" str)
 	       str))
-	    ((char-whitespace? c) (loop lst h))
+	    ((char-whitespace? c) 
+	     (if h
+		 (loop (cons (integer->char (fxshr h 4)) lst) #f)
+		 (loop lst h)))
 	    (h (loop (cons (integer->char (fxior h (hex c))) lst) #f))
 	    (else (loop lst (fxshl (hex c) 4)))))))
 	      
diff --git a/tests/library-tests.scm b/tests/library-tests.scm
index 58d13e00..69e21ec4 100644
--- a/tests/library-tests.scm
+++ b/tests/library-tests.scm
@@ -137,3 +137,12 @@
 (assert (= 100 (p)))
 (set! (p) 1000)
 (assert (= 1000 (p)))
+
+
+;;; blob-literal syntax
+
+(assert (equal? '#${a} '#${0a}))
+(assert (equal? '#${ab cd} '#${abcd}))
+(assert (equal? '#${ab c} '#${ab0c}))
+(assert (equal? '#${abc} '#${ab0c}))
+(assert (equal? '#${a b c} '#${0a0b0c}))