diff options
| author | Andy Wingo <wingo@pobox.com> | 2021-03-07 19:59:01 +0100 |
|---|---|---|
| committer | Andy Wingo <wingo@pobox.com> | 2021-03-07 20:17:58 +0100 |
| commit | cad6094cbc15e78bce2384a5af754bc841ca9127 (patch) | |
| tree | 51590200c2c1501328eabca00a1bc40557791b35 | |
| parent | 1114122fbb13e843276a479f0966087e9d52e1f7 (diff) | |
| download | guile-cad6094cbc15e78bce2384a5af754bc841ca9127.tar.gz | |
Fix reading #!!#
* module/ice-9/read.scm (%read): Fix reading #!!#.
* test-suite/tests/reader.test ("reading"): Add some test cases.
| -rw-r--r-- | module/ice-9/read.scm | 18 | ||||
| -rw-r--r-- | test-suite/tests/reader.test | 17 |
2 files changed, 26 insertions, 9 deletions
diff --git a/module/ice-9/read.scm b/module/ice-9/read.scm index 17215d8b1..a8dbd92f9 100644 --- a/module/ice-9/read.scm +++ b/module/ice-9/read.scm @@ -731,16 +731,18 @@ (read-neoteric ch))))) (define (read-directive) - (let ((ch (next))) + (define (directive-char? ch) + (and (char? ch) + (or (eqv? ch #\-) + (char-alphabetic? ch) + (char-numeric? ch)))) + (let ((ch (peek))) (cond - ((eof-object? ch) - (error "unexpected end of input after #!")) + ((directive-char? ch) + (next) + (string->symbol (take-while ch directive-char?))) (else - (string->symbol - (take-while ch (lambda (ch) - (or (eqv? ch #\-) - (char-alphabetic? ch) - (char-numeric? ch))))))))) + #f)))) (define (skip-scsh-comment) (let lp ((ch (next))) diff --git a/test-suite/tests/reader.test b/test-suite/tests/reader.test index 535ff1c8f..fad531b39 100644 --- a/test-suite/tests/reader.test +++ b/test-suite/tests/reader.test @@ -184,7 +184,22 @@ (read-string "'(foo bar]")) (pass-if-exception "paren mismatch (4)" exception:mismatched-paren - (read-string "'[foo bar)"))) + (read-string "'[foo bar)")) + + (pass-if-equal '(#f 1) (read-string "(#f1)")) + (pass-if-equal '(#f a) (read-string "(#fa)")) + (pass-if-equal '(#f a) (read-string "(#Fa)")) + (pass-if-equal '(#t 1) (read-string "(#t1)")) + (pass-if-equal '(#t r) (read-string "(#tr)")) + (pass-if-equal '(#t r) (read-string "(#Tr)")) + (pass-if-equal '(#t) (read-string "(#TrUe)")) + (pass-if-equal '(#t) (read-string "(#TRUE)")) + (pass-if-equal '(#t) (read-string "(#true)")) + (pass-if-equal '(#f) (read-string "(#false)")) + (pass-if-equal '(#f) (read-string "(#FALSE)")) + (pass-if-equal '(#f) (read-string "(#FaLsE)")) + + (pass-if (eof-object? (read-string "#!!#")))) |