mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00
Code Activity

Fix reading #!!#

Browse source 
* module/ice-9/read.scm (%read): Fix reading #!!#.
* test-suite/tests/reader.test ("reading"): Add some test cases.
This commit is contained in:
Andy Wingo 2021-03-07 19:59:01 +01:00
parent 1114122fbb
commit cad6094cbc
2 changed files with 26 additions and 9 deletions
Download patch file Download diff file Expand all files Collapse all files

18
module/ice-9/read.scm
View file

@ -731,16 +731,18 @@
(read-neoteric ch))))) (read-neoteric ch)))))
(define (read-directive) (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 (cond
((eof-object? ch) ((directive-char? ch)
(error "unexpected end of input after #!")) (next)
(string->symbol (take-while ch directive-char?)))
(else (else
(string->symbol #f))))
(take-while ch (lambda (ch)
(or (eqv? ch #\-)
(char-alphabetic? ch)
(char-numeric? ch)))))))))
(define (skip-scsh-comment) (define (skip-scsh-comment)
(let lp ((ch (next))) (let lp ((ch (next)))

17
test-suite/tests/reader.test
View file

@ -184,7 +184,22 @@
(read-string "'(foo bar]")) (read-string "'(foo bar]"))
(pass-if-exception "paren mismatch (4)" exception:mismatched-paren (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 "#!!#"))))