~ chicken-core (chicken-5) c1dc721cd9bf867e483a82b0ed83e6a1e6f11f50
commit c1dc721cd9bf867e483a82b0ed83e6a1e6f11f50
Author: felix <felix@call-with-current-continuation.org>
AuthorDate: Sat Feb 19 01:36:16 2011 +0100
Commit: felix <felix@call-with-current-continuation.org>
CommitDate: Sat Feb 19 01:36:16 2011 +0100
read-macro-handers now can return zero values (thanks to zbigniew)
diff --git a/library.scm b/library.scm
index 31c8b375..80669311 100644
--- a/library.scm
+++ b/library.scm
@@ -2691,12 +2691,14 @@ EOF
'(#\[ #\] #\{ #\} #\|))))
(r-spaces)
- (let* ([c (##sys#peek-char-0 port)]
- [srst (##sys#slot crt 1)]
- [h (and srst (##sys#slot srst (char->integer c)) ) ] )
+ (let* ((c (##sys#peek-char-0 port))
+ (srst (##sys#slot crt 1))
+ (h (and srst (##sys#slot srst (char->integer c)) ) ) )
(if h
;then handled by read-table entry
- (h c port)
+ (##sys#call-with-values
+ (lambda () (h c port))
+ (lambda xs (if (null? xs) (readrec) (car xs))))
;otherwise chicken extended r5rs syntax
(case c
((#\')
@@ -2720,15 +2722,23 @@ EOF
(spdrst (##sys#slot crt 3))
(h (and spdrst (##sys#slot spdrst (char->integer dchar)) ) ) )
;#<num> handled by parameterized # read-table entry?
- (cond (h (h dchar port n))
+ (cond (h (##sys#call-with-values
+ (lambda () (h dchar port n))
+ (lambda xs (if (null? xs) (readrec) (car xs)))))
;#<num>?
- ((or (eq? dchar #\)) (char-whitespace? dchar)) (##sys#sharp-number-hook port n))
- (else (##sys#read-error port "invalid parameterized read syntax" dchar n) ) ) )
+ ((or (eq? dchar #\)) (char-whitespace? dchar))
+ (##sys#sharp-number-hook port n))
+ (else (##sys#read-error
+ port
+ "invalid parameterized read syntax"
+ dchar n) ) ) )
(let* ((sdrst (##sys#slot crt 2))
(h (and sdrst (##sys#slot sdrst (char->integer dchar)) ) ) )
(if h
;then handled by # read-table entry
- (h dchar port)
+ (##sys#call-with-values
+ (lambda () (h dchar port))
+ (lambda xs (if (null? xs) (readrec) (car xs))))
;otherwise chicken extended r5rs syntax
(case (char-downcase dchar)
((#\x) (##sys#read-char-0 port) (r-number-with-exactness 16))
@@ -2795,7 +2805,9 @@ EOF
(##sys#read-error
port
"invalid `#!' token" tok) ) ) ] ) ) ) ) ) )
- (else (##sys#user-read-hook dchar port)) ) ) ) ) ) )
+ (else
+ (##sys#call-with-values (lambda () (##sys#user-read-hook dchar port))
+ (lambda xs (if (null? xs) (readrec) (car xs)))) ) ) ) ) ) ) )
((#\() (r-list #\( #\)))
((#\)) (##sys#read-char-0 port) (container c))
((#\") (##sys#read-char-0 port) (r-string #\"))
diff --git a/tests/reader-tests.scm b/tests/reader-tests.scm
new file mode 100644
index 00000000..6d3e4f76
--- /dev/null
+++ b/tests/reader-tests.scm
@@ -0,0 +1,21 @@
+;;;; reader-tests.scm
+
+
+(set-sharp-read-syntax! #\& (lambda (p) (read p) (values)))
+(set-sharp-read-syntax! #\^ (lambda (p) (read p)))
+(set-read-syntax! #\! (lambda (p) (read-line p) (values)))
+
+(define output
+ (with-output-to-string
+ (lambda ()
+ (print "hi") ! this is fortran
+ (print "foo") #&(print "amp-comment") (print "baz")
+ #^(print "bye"))))
+
+!! output:
+!! hi
+!! foo
+!! baz
+!! bye
+
+(assert (string=? output "hi\nfoo\nbaz\nbye\n"))
diff --git a/tests/runtests.sh b/tests/runtests.sh
index 7b670a88..1b76427d 100644
--- a/tests/runtests.sh
+++ b/tests/runtests.sh
@@ -95,6 +95,9 @@ $interpret -s records-and-setters-test.scm
$compile records-and-setters-test.scm
./a.out
+echo "======================================== reader tests ..."
+$interpret -s reader-tests.scm
+
echo "======================================== dynamic-wind tests ..."
$interpret -s dwindtst.scm >dwindtst.out
diff -bu dwindtst.expected dwindtst.out
Trap