1 ;;;; reader.test --- Reader test. -*- coding: iso-8859-1; mode: scheme -*-
3 ;;;; Copyright (C) 1999, 2001, 2002, 2003, 2007, 2008, 2009, 2010, 2011,
4 ;;;; 2013 Free Software Foundation, Inc.
5 ;;;; Jim Blandy <jimb@red-bean.com>
7 ;;;; This library is free software; you can redistribute it and/or
8 ;;;; modify it under the terms of the GNU Lesser General Public
9 ;;;; License as published by the Free Software Foundation; either
10 ;;;; version 3 of the License, or (at your option) any later version.
12 ;;;; This library is distributed in the hope that it will be useful,
13 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
15 ;;;; Lesser General Public License for more details.
17 ;;;; You should have received a copy of the GNU Lesser General Public
18 ;;;; License along with this library; if not, write to the Free Software
19 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
21 (define-module (test-suite reader)
22 :use-module (srfi srfi-1)
23 :use-module (test-suite lib))
27 (cons 'read-error "end of file$"))
28 (define exception:unexpected-rparen
29 (cons 'read-error "unexpected \")\"$"))
30 (define exception:unexpected-rsqbracket
31 (cons 'read-error "unexpected \"]\"$"))
32 (define exception:unterminated-block-comment
33 (cons 'read-error "unterminated `#. \\.\\.\\. .#' comment$"))
34 (define exception:unknown-character-name
35 (cons 'read-error "unknown character name .*$"))
36 (define exception:unknown-sharp-object
37 (cons 'read-error "Unknown # object: .*$"))
38 (define exception:eof-in-string
39 (cons 'read-error "end of file in string constant$"))
40 (define exception:eof-in-symbol
41 (cons 'read-error "end of file while reading symbol$"))
42 (define exception:illegal-escape
43 (cons 'read-error "illegal character in escape sequence: .*$"))
44 (define exception:missing-expression
45 (cons 'read-error "no expression after #;"))
46 (define exception:mismatched-paren
47 (cons 'read-error "mismatched close paren"))
50 (define (read-string s)
51 (with-input-from-string s (lambda () (read))))
53 (define (with-read-options opts thunk)
54 (let ((saved-options (read-options)))
60 (read-options saved-options)))))
63 (with-test-prefix "reading"
65 (equal? (read-string "0") 0))
67 (equal? (read-string "1++i") '1++i))
69 (equal? (read-string "1+i+i") '1+i+i))
71 (equal? (read-string "1+e10000i") '1+e10000i))
73 (not (equal? (imag-part (read-string "-nan.0-1i"))
74 (imag-part (read-string "-nan.0+1i")))))
76 ;; At one time the arg list for "Unknown # object: ~S" didn't make it out
77 ;; of read.c. Check that `format' can be applied to this error.
78 (pass-if "error message on bad #"
82 ;; oops, this # is supposed to be unrecognised
84 (lambda (key subr message args rest)
85 (apply format #f message args)
86 ;; message and args are ok
89 (pass-if "block comment"
91 (read-string "(+ 1 #! this is a\ncomment !# 2 3)")))
93 (pass-if "block comment finishing s-exp"
95 (read-string "(+ 2 #! a comment\n!#\n) ")))
97 (pass-if "R6RS lexeme comment"
99 (read-string "(+ 1 #!r6rs 2 3)")))
101 (pass-if "partial R6RS lexeme comment"
103 (read-string "(+ 1 #!r6r !# 2 3)")))
105 (pass-if "R6RS/SRFI-30 block comment"
107 (read-string "(+ 1 #| this is a\ncomment |# 2 3)")))
109 (pass-if "R6RS/SRFI-30 nested block comment"
111 (read-string "(a b c #| d #| e |# f |#)")))
113 (pass-if "R6RS/SRFI-30 nested block comment (2)"
115 (read-string "(a b c #|||||||#)")))
117 (pass-if "R6RS/SRFI-30 nested block comment (3)"
119 (read-string "(a b c #||||||||#)")))
121 (pass-if "R6RS/SRFI-30 block comment syntax overridden"
122 ;; To be compatible with 1.8 and earlier, we should be able to override
124 (with-fluids ((%read-hash-procedures (fluid-ref %read-hash-procedures)))
125 (read-hash-extend #\| (lambda args 'not))
126 (fold (lambda (x y result)
127 (and result (eq? x y)))
129 (read-string "(this is #| a comment)")
130 `(this is not a comment))))
132 (pass-if "unprintable symbol"
133 ;; The reader tolerates unprintable characters for symbols.
134 (equal? (string->symbol "\x01\x02\x03")
135 (read-string "\x01\x02\x03")))
137 (pass-if "CR recognized as a token delimiter"
138 ;; In 1.8.3, character 0x0d was not recognized as a delimiter.
139 (equal? (read-string "one\x0dtwo") 'one))
141 (pass-if "returned strings are mutable"
142 ;; Per R5RS Section 3.4, "Storage Model", `read' is supposed to return
144 (let ((str (with-input-from-string "\"hello, world\"" read)))
145 (string-set! str 0 #\H)
146 (string=? str "Hello, world")))
148 (pass-if "square brackets are parens"
149 (equal? '() (read-string "[]")))
151 (pass-if-exception "paren mismatch" exception:unexpected-rparen
154 (pass-if-exception "paren mismatch (2)" exception:unexpected-rsqbracket
157 (pass-if-exception "paren mismatch (3)" exception:mismatched-paren
158 (read-string "'(foo bar]"))
160 (pass-if-exception "paren mismatch (4)" exception:mismatched-paren
161 (read-string "'[foo bar)")))
165 (pass-if-exception "radix passed to number->string can't be zero"
166 exception:out-of-range
167 (number->string 10 0))
168 (pass-if-exception "radix passed to number->string can't be one either"
169 exception:out-of-range
170 (number->string 10 1))
173 (with-test-prefix "mismatching parentheses"
174 (pass-if-exception "opening parenthesis"
177 (pass-if-exception "closing parenthesis following mismatched opening"
178 exception:unexpected-rparen
180 (pass-if-exception "closing square bracket following mismatched opening"
181 exception:unexpected-rsqbracket
183 (pass-if-exception "opening vector parenthesis"
186 (pass-if-exception "closing parenthesis following mismatched vector opening"
187 exception:unexpected-rparen
191 (with-test-prefix "exceptions"
193 ;; Reader exceptions: although they are not documented, they may be relied
194 ;; on by some programs, hence these tests.
196 (pass-if-exception "unterminated block comment"
197 exception:unterminated-block-comment
198 (read-string "(+ 1 #! comment\n..."))
199 (pass-if-exception "R6RS/SRFI-30 unterminated nested block comment"
200 exception:unterminated-block-comment
201 (read-string "(foo #| bar #| |#)"))
202 (pass-if-exception "unknown character name"
203 exception:unknown-character-name
204 (read-string "#\\theunknowncharacter"))
205 (pass-if-exception "unknown sharp object"
206 exception:unknown-sharp-object
208 (pass-if-exception "eof in string"
209 exception:eof-in-string
210 (read-string "\"the string that never ends"))
211 (pass-if-exception "illegal escape in string"
212 exception:illegal-escape
213 (read-string "\"some string \\???\"")))
216 (with-test-prefix "read-options"
217 (pass-if "case-sensitive"
218 (not (eq? 'guile 'GuiLe)))
219 (pass-if "case-insensitive"
221 (with-read-options '(case-insensitive)
223 (read-string "GuiLe")))))
224 (pass-if "prefix keywords"
226 (with-read-options '(keywords prefix case-insensitive)
228 (read-string ":KeyWord")))))
229 (pass-if "prefix non-keywords"
230 (symbol? (with-read-options '(keywords prefix)
232 (read-string "srfi88-keyword:")))))
233 (pass-if "postfix keywords"
235 (with-read-options '(keywords postfix)
237 (read-string "keyword:")))))
238 (pass-if "long postfix keywords"
239 (eq? #:keyword0123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789
240 (with-read-options '(keywords postfix)
242 (read-string "keyword0123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789:")))))
243 (pass-if "`:' is not a postfix keyword (per SRFI-88)"
245 (with-read-options '(keywords postfix)
247 (read-string ":")))))
248 (pass-if "no positions"
249 (let ((sexp (with-read-options '()
251 (read-string "(+ 1 2 3)")))))
252 (and (not (source-property sexp 'line))
253 (not (source-property sexp 'column)))))
255 (let ((sexp (with-read-options '(positions)
257 (read-string "(+ 1 2 3)")))))
258 (and (equal? (source-property sexp 'line) 0)
259 (equal? (source-property sexp 'column) 0))))
260 (pass-if "positions on quote"
261 (let ((sexp (with-read-options '(positions)
263 (read-string "'abcde")))))
264 (and (equal? (source-property sexp 'line) 0)
265 (equal? (source-property sexp 'column) 0))))
266 (pass-if "position of SCSH block comment"
267 ;; In Guile 2.0.0 the reader would not update the port's position
268 ;; when reading an SCSH block comment.
269 (let ((sexp (with-read-options '(positions)
271 (read-string "#!foo\nbar\nbaz\n!#\n(hello world)\n")))))
272 (= 4 (source-property sexp 'line))))
274 (with-test-prefix "r6rs-hex-escapes"
275 (pass-if-exception "non-hex char in two-digit hex-escape"
276 exception:illegal-escape
277 (with-read-options '(r6rs-hex-escapes)
279 (with-input-from-string "\"\\x0g;\"" read))))
281 (pass-if-exception "non-hex char in four-digit hex-escape"
282 exception:illegal-escape
283 (with-read-options '(r6rs-hex-escapes)
285 (with-input-from-string "\"\\x000g;\"" read))))
287 (pass-if-exception "non-hex char in six-digit hex-escape"
288 exception:illegal-escape
289 (with-read-options '(r6rs-hex-escapes)
291 (with-input-from-string "\"\\x00000g;\"" read))))
293 (pass-if-exception "no semicolon at termination of one-digit hex-escape"
294 exception:illegal-escape
295 (with-read-options '(r6rs-hex-escapes)
297 (with-input-from-string "\"\\x0\"" read))))
299 (pass-if-exception "no semicolon at termination of three-digit hex-escape"
300 exception:illegal-escape
301 (with-read-options '(r6rs-hex-escapes)
303 (with-input-from-string "\"\\x000\"" read))))
305 (pass-if "two-digit hex escape"
307 (with-read-options '(r6rs-hex-escapes)
309 (string-ref (with-input-from-string "\"--\\xff;--\"" read) 2)))
310 (integer->char #xff)))
312 (pass-if "four-digit hex escape"
314 (with-read-options '(r6rs-hex-escapes)
316 (string-ref (with-input-from-string "\"--\\x0100;--\"" read) 2)))
317 (integer->char #x0100)))
319 (pass-if "six-digit hex escape"
321 (with-read-options '(r6rs-hex-escapes)
323 (string-ref (with-input-from-string "\"--\\x010300;--\"" read) 2)))
324 (integer->char #x010300)))
326 (pass-if "escaped characters match non-escaped ASCII characters"
328 (with-read-options '(r6rs-hex-escapes)
330 (with-input-from-string "\"\\x41;\\x0042;\\x000043;\"" read)))
333 (pass-if "write R6RS string escapes"
334 (let* ((s1 (apply string
335 (map integer->char '(#x8 ; backspace
341 (s2 (with-read-options '(r6rs-hex-escapes)
343 (with-output-to-string
344 (lambda () (write s1)))))))
347 (list #\" #\\ #\b #\\ #\x #\1 #\8 #\; #\space #\0 #\@ #\"))))
349 (pass-if "display R6RS string escapes"
351 (with-read-options '(r6rs-hex-escapes)
353 (let ((pt (open-output-string))
354 (s1 (apply string (map integer->char
355 '(#xFF #x100 #xFFF #x1000 #xFFFF #x10000)))))
356 (set-port-encoding! pt "ASCII")
357 (set-port-conversion-strategy! pt 'escape)
359 (get-output-string pt))))
360 "\\xff;\\x100;\\xfff;\\x1000;\\xffff;\\x10000;"))
362 (pass-if "one-digit hex escape"
363 (eqv? (with-input-from-string "#\\xA" read)
364 (integer->char #x0A)))
366 (pass-if "two-digit hex escape"
367 (eqv? (with-input-from-string "#\\xFF" read)
368 (integer->char #xFF)))
370 (pass-if "four-digit hex escape"
371 (eqv? (with-input-from-string "#\\x00FF" read)
372 (integer->char #xFF)))
374 (pass-if "eight-digit hex escape"
375 (eqv? (with-input-from-string "#\\x00006587" read)
376 (integer->char #x6587)))
378 (pass-if "write R6RS escapes"
380 (with-read-options '(r6rs-hex-escapes)
382 (with-output-to-string
384 (write (integer->char #x80))))))
387 (with-test-prefix "hungry escapes"
388 (pass-if "default not hungry"
389 ;; Assume default setting of not hungry.
390 (equal? (with-input-from-string "\"foo\\\n bar\""
396 (read-enable 'hungry-eol-escapes))
398 (equal? (with-input-from-string "\"foo\\\n bar\""
402 (read-disable 'hungry-eol-escapes))))))
404 (with-test-prefix "per-port-read-options"
405 (pass-if "case-sensitive"
406 (equal? '(guile GuiLe gUIle)
407 (with-read-options '(case-insensitive)
409 (with-input-from-string "GUIle #!no-fold-case GuiLe gUIle"
411 (list (read) (read) (read))))))))
412 (pass-if "case-insensitive"
413 (equal? '(GUIle guile guile)
414 (with-input-from-string "GUIle #!fold-case GuiLe gUIle"
416 (list (read) (read) (read)))))))
418 (with-test-prefix "#;"
422 (equal? (with-input-from-string (car pair) read) (cdr pair))))
425 ("#;(10 20 30) foo" . foo)
426 ("#; (10 20 30) foo" . foo)
427 ("#;\n10\n20" . 20)))
430 (eof-object? (with-input-from-string "#;foo" read)))
432 (pass-if-exception "#;"
433 exception:missing-expression
434 (with-input-from-string "#;" read))
435 (pass-if-exception "#;("
437 (with-input-from-string "#;(" read)))
439 (with-test-prefix "#'"
443 (equal? (with-input-from-string (car pair) read) (cdr pair))))
445 '(("#'foo". (syntax foo))
446 ("#`foo" . (quasisyntax foo))
447 ("#,foo" . (unsyntax foo))
448 ("#,@foo" . (unsyntax-splicing foo)))))
450 (with-test-prefix "#{}#"
451 (pass-if (equal? (read-string "#{}#") '#{}#))
452 (pass-if (not (equal? (read-string "(a #{.}# b)") '(a . b))))
453 (pass-if (equal? (read-string "#{a}#") 'a))
454 (pass-if (equal? (read-string "#{a b}#") '#{a b}#))
455 (pass-if-exception "#{" exception:eof-in-symbol
457 (pass-if (equal? (read-string "#{a\\x20;b}#") '#{a b}#)))
460 (with-test-prefix "deprecated #{}# escapes"
461 (pass-if (equal? (read-string "#{a\\ b}#") '#{a b}#))))
464 ;;; eval: (put 'with-read-options 'scheme-indent-function 1)