1 ;;;; reader.test --- Reader test. -*- coding: iso-8859-1; mode: scheme -*-
3 ;;;; Copyright (C) 1999, 2001-2003, 2007-2011, 2013-2015
4 ;;;; Free Software Foundation, Inc.
6 ;;;; Jim Blandy <jimb@red-bean.com>
8 ;;;; This library is free software; you can redistribute it and/or
9 ;;;; modify it under the terms of the GNU Lesser General Public
10 ;;;; License as published by the Free Software Foundation; either
11 ;;;; version 3 of the License, or (at your option) any later version.
13 ;;;; This library is distributed in the hope that it will be useful,
14 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
15 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
16 ;;;; Lesser General Public License for more details.
18 ;;;; You should have received a copy of the GNU Lesser General Public
19 ;;;; License along with this library; if not, write to the Free Software
20 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
22 (define-module (test-suite reader)
23 :use-module (srfi srfi-1)
24 :use-module (test-suite lib))
28 (cons 'read-error "end of file$"))
29 (define exception:unexpected-rparen
30 (cons 'read-error "unexpected \")\"$"))
31 (define exception:unexpected-rsqbracket
32 (cons 'read-error "unexpected \"]\"$"))
33 (define exception:unterminated-block-comment
34 (cons 'read-error "unterminated `#. \\.\\.\\. .#' comment$"))
35 (define exception:unknown-character-name
36 (cons 'read-error "unknown character name .*$"))
37 (define exception:unknown-sharp-object
38 (cons 'read-error "Unknown # object: .*$"))
39 (define exception:eof-in-string
40 (cons 'read-error "end of file in string constant$"))
41 (define exception:eof-in-symbol
42 (cons 'read-error "end of file while reading symbol$"))
43 (define exception:illegal-escape
44 (cons 'read-error "illegal character in escape sequence: .*$"))
45 (define exception:missing-expression
46 (cons 'read-error "no expression after #;"))
47 (define exception:mismatched-paren
48 (cons 'read-error "mismatched close paren"))
51 (define (read-string s)
52 (with-input-from-string s (lambda () (read))))
54 (define (with-read-options opts thunk)
55 (let ((saved-options (read-options)))
61 (read-options saved-options)))))
64 (with-test-prefix "reading"
66 (equal? (read-string "0") 0))
68 (equal? (read-string "1++i") '1++i))
70 (equal? (read-string "1+i+i") '1+i+i))
72 (equal? (read-string "1+e10000i") '1+e10000i))
74 (not (equal? (imag-part (read-string "-nan.0-1i"))
75 (imag-part (read-string "-nan.0+1i")))))
77 (pass-if-equal "'\|' in string literals"
79 (read-string "\"a\\|b\""))
81 (pass-if-equal "'(' in string literals"
83 (read-string "\"a\\(b\""))
85 (pass-if-equal "#\\escape"
87 (read-string "(a #\\escape b)"))
89 (pass-if-equal "#true"
91 (read-string "(a #true b)"))
93 (pass-if-equal "#false"
95 (read-string "(a #false b)"))
97 ;; At one time the arg list for "Unknown # object: ~S" didn't make it out
98 ;; of read.c. Check that `format' can be applied to this error.
99 (pass-if "error message on bad #"
103 ;; oops, this # is supposed to be unrecognised
105 (lambda (key subr message args rest)
106 (apply format #f message args)
107 ;; message and args are ok
110 (pass-if "block comment"
112 (read-string "(+ 1 #! this is a\ncomment !# 2 3)")))
114 (pass-if "block comment finishing s-exp"
116 (read-string "(+ 2 #! a comment\n!#\n) ")))
118 (pass-if "R6RS lexeme comment"
120 (read-string "(+ 1 #!r6rs 2 3)")))
122 (pass-if "partial R6RS lexeme comment"
124 (read-string "(+ 1 #!r6r !# 2 3)")))
126 (pass-if "R6RS/SRFI-30 block comment"
128 (read-string "(+ 1 #| this is a\ncomment |# 2 3)")))
130 (pass-if "R6RS/SRFI-30 nested block comment"
132 (read-string "(a b c #| d #| e |# f |#)")))
134 (pass-if "R6RS/SRFI-30 nested block comment (2)"
136 (read-string "(a b c #|||||||#)")))
138 (pass-if "R6RS/SRFI-30 nested block comment (3)"
140 (read-string "(a b c #||||||||#)")))
142 (pass-if "R6RS/SRFI-30 block comment syntax overridden"
143 ;; To be compatible with 1.8 and earlier, we should be able to override
145 (with-fluids ((%read-hash-procedures (fluid-ref %read-hash-procedures)))
146 (read-hash-extend #\| (lambda args 'not))
147 (fold (lambda (x y result)
148 (and result (eq? x y)))
150 (read-string "(this is #| a comment)")
151 `(this is not a comment))))
153 (pass-if "unprintable symbol"
154 ;; The reader tolerates unprintable characters for symbols.
155 (equal? (string->symbol "\x01\x02\x03")
156 (read-string "\x01\x02\x03")))
158 (pass-if "CR recognized as a token delimiter"
159 ;; In 1.8.3, character 0x0d was not recognized as a delimiter.
160 (equal? (read-string "one\x0dtwo") 'one))
162 (pass-if "returned strings are mutable"
163 ;; Per R5RS Section 3.4, "Storage Model", `read' is supposed to return
165 (let ((str (with-input-from-string "\"hello, world\"" read)))
166 (string-set! str 0 #\H)
167 (string=? str "Hello, world")))
169 (pass-if "square brackets are parens"
170 (equal? '() (read-string "[]")))
172 (pass-if-exception "paren mismatch" exception:unexpected-rparen
175 (pass-if-exception "paren mismatch (2)" exception:unexpected-rsqbracket
178 (pass-if-exception "paren mismatch (3)" exception:mismatched-paren
179 (read-string "'(foo bar]"))
181 (pass-if-exception "paren mismatch (4)" exception:mismatched-paren
182 (read-string "'[foo bar)")))
186 (pass-if-exception "radix passed to number->string can't be zero"
187 exception:out-of-range
188 (number->string 10 0))
189 (pass-if-exception "radix passed to number->string can't be one either"
190 exception:out-of-range
191 (number->string 10 1))
194 (with-test-prefix "mismatching parentheses"
195 (pass-if-exception "opening parenthesis"
198 (pass-if-exception "closing parenthesis following mismatched opening"
199 exception:unexpected-rparen
201 (pass-if-exception "closing square bracket following mismatched opening"
202 exception:unexpected-rsqbracket
204 (pass-if-exception "opening vector parenthesis"
207 (pass-if-exception "closing parenthesis following mismatched vector opening"
208 exception:unexpected-rparen
212 (with-test-prefix "exceptions"
214 ;; Reader exceptions: although they are not documented, they may be relied
215 ;; on by some programs, hence these tests.
217 (pass-if-exception "unterminated block comment"
218 exception:unterminated-block-comment
219 (read-string "(+ 1 #! comment\n..."))
220 (pass-if-exception "R6RS/SRFI-30 unterminated nested block comment"
221 exception:unterminated-block-comment
222 (read-string "(foo #| bar #| |#)"))
223 (pass-if-exception "unknown character name"
224 exception:unknown-character-name
225 (read-string "#\\theunknowncharacter"))
226 (pass-if-exception "unknown sharp object"
227 exception:unknown-sharp-object
229 (pass-if-exception "eof in string"
230 exception:eof-in-string
231 (read-string "\"the string that never ends"))
232 (pass-if-exception "illegal escape in string"
233 exception:illegal-escape
234 (read-string "\"some string \\???\"")))
237 (with-test-prefix "read-options"
238 (pass-if "case-sensitive"
239 (not (eq? 'guile 'GuiLe)))
240 (pass-if "case-insensitive"
242 (with-read-options '(case-insensitive)
244 (read-string "GuiLe")))))
245 (pass-if-equal "r7rs-symbols"
246 (list 'a (string->symbol "Hello, this is | a \"test\"") 'b)
247 (with-read-options '(r7rs-symbols)
249 (read-string "(a |H\\x65;llo, this is \\| a \"test\"| b)"))))
250 (pass-if "prefix keywords"
252 (with-read-options '(keywords prefix case-insensitive)
254 (read-string ":KeyWord")))))
255 (pass-if "prefix non-keywords"
256 (symbol? (with-read-options '(keywords prefix)
258 (read-string "srfi88-keyword:")))))
259 (pass-if "postfix keywords"
261 (with-read-options '(keywords postfix)
263 (read-string "keyword:")))))
264 (pass-if "long postfix keywords"
265 (eq? #:keyword0123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789
266 (with-read-options '(keywords postfix)
268 (read-string "keyword0123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789:")))))
269 (pass-if "`:' is not a postfix keyword (per SRFI-88)"
271 (with-read-options '(keywords postfix)
273 (read-string ":")))))
274 (pass-if "no positions"
275 (let ((sexp (with-read-options '()
277 (read-string "(+ 1 2 3)")))))
278 (and (not (source-property sexp 'line))
279 (not (source-property sexp 'column)))))
281 (let ((sexp (with-read-options '(positions)
283 (read-string "(+ 1 2 3)")))))
284 (and (equal? (source-property sexp 'line) 0)
285 (equal? (source-property sexp 'column) 0))))
286 (pass-if "positions on quote"
287 (let ((sexp (with-read-options '(positions)
289 (read-string "'abcde")))))
290 (and (equal? (source-property sexp 'line) 0)
291 (equal? (source-property sexp 'column) 0))))
292 (pass-if "position of SCSH block comment"
293 ;; In Guile 2.0.0 the reader would not update the port's position
294 ;; when reading an SCSH block comment.
295 (let ((sexp (with-read-options '(positions)
297 (read-string "#!foo\nbar\nbaz\n!#\n(hello world)\n")))))
298 (= 4 (source-property sexp 'line))))
300 (with-test-prefix "r6rs-hex-escapes"
301 (pass-if-exception "non-hex char in two-digit hex-escape"
302 exception:illegal-escape
303 (with-read-options '(r6rs-hex-escapes)
305 (with-input-from-string "\"\\x0g;\"" read))))
307 (pass-if-exception "non-hex char in four-digit hex-escape"
308 exception:illegal-escape
309 (with-read-options '(r6rs-hex-escapes)
311 (with-input-from-string "\"\\x000g;\"" read))))
313 (pass-if-exception "non-hex char in six-digit hex-escape"
314 exception:illegal-escape
315 (with-read-options '(r6rs-hex-escapes)
317 (with-input-from-string "\"\\x00000g;\"" read))))
319 (pass-if-exception "no semicolon at termination of one-digit hex-escape"
320 exception:illegal-escape
321 (with-read-options '(r6rs-hex-escapes)
323 (with-input-from-string "\"\\x0\"" read))))
325 (pass-if-exception "no semicolon at termination of three-digit hex-escape"
326 exception:illegal-escape
327 (with-read-options '(r6rs-hex-escapes)
329 (with-input-from-string "\"\\x000\"" read))))
331 (pass-if "two-digit hex escape"
333 (with-read-options '(r6rs-hex-escapes)
335 (string-ref (with-input-from-string "\"--\\xff;--\"" read) 2)))
336 (integer->char #xff)))
338 (pass-if "four-digit hex escape"
340 (with-read-options '(r6rs-hex-escapes)
342 (string-ref (with-input-from-string "\"--\\x0100;--\"" read) 2)))
343 (integer->char #x0100)))
345 (pass-if "six-digit hex escape"
347 (with-read-options '(r6rs-hex-escapes)
349 (string-ref (with-input-from-string "\"--\\x010300;--\"" read) 2)))
350 (integer->char #x010300)))
352 (pass-if "escaped characters match non-escaped ASCII characters"
354 (with-read-options '(r6rs-hex-escapes)
356 (with-input-from-string "\"\\x41;\\x0042;\\x000043;\"" read)))
359 (pass-if "write R6RS string escapes"
360 (let* ((s1 (apply string
361 (map integer->char '(#x8 ; backspace
367 (s2 (with-read-options '(r6rs-hex-escapes)
369 (with-output-to-string
370 (lambda () (write s1)))))))
373 (list #\" #\\ #\b #\\ #\x #\1 #\8 #\; #\space #\0 #\@ #\"))))
375 (pass-if "display R6RS string escapes"
377 (with-read-options '(r6rs-hex-escapes)
379 (let ((pt (open-output-string))
380 (s1 (apply string (map integer->char
381 '(#xFF #x100 #xFFF #x1000 #xFFFF #x10000)))))
382 (set-port-encoding! pt "ASCII")
383 (set-port-conversion-strategy! pt 'escape)
385 (get-output-string pt))))
386 "\\xff;\\x100;\\xfff;\\x1000;\\xffff;\\x10000;"))
388 (pass-if "one-digit hex escape"
389 (eqv? (with-input-from-string "#\\xA" read)
390 (integer->char #x0A)))
392 (pass-if "two-digit hex escape"
393 (eqv? (with-input-from-string "#\\xFF" read)
394 (integer->char #xFF)))
396 (pass-if "four-digit hex escape"
397 (eqv? (with-input-from-string "#\\x00FF" read)
398 (integer->char #xFF)))
400 (pass-if "eight-digit hex escape"
401 (eqv? (with-input-from-string "#\\x00006587" read)
402 (integer->char #x6587)))
404 (pass-if "write R6RS escapes"
406 (with-read-options '(r6rs-hex-escapes)
408 (with-output-to-string
410 (write (integer->char #x80))))))
413 (with-test-prefix "hungry escapes"
414 (pass-if "default not hungry"
415 ;; Assume default setting of not hungry.
416 (equal? (with-input-from-string "\"foo\\\n bar\""
422 (read-enable 'hungry-eol-escapes))
424 (equal? (with-input-from-string "\"foo\\\n bar\""
428 (read-disable 'hungry-eol-escapes))))))
430 (with-test-prefix "per-port-read-options"
431 (pass-if "case-sensitive"
432 (equal? '(guile GuiLe gUIle)
433 (with-read-options '(case-insensitive)
435 (with-input-from-string "GUIle #!no-fold-case GuiLe gUIle"
437 (list (read) (read) (read))))))))
438 (pass-if "case-insensitive"
439 (equal? '(GUIle guile guile)
440 (with-input-from-string "GUIle #!fold-case GuiLe gUIle"
442 (list (read) (read) (read)))))))
444 (with-test-prefix "#;"
448 (equal? (with-input-from-string (car pair) read) (cdr pair))))
451 ("#;(10 20 30) foo" . foo)
452 ("#; (10 20 30) foo" . foo)
453 ("#;\n10\n20" . 20)))
456 (eof-object? (with-input-from-string "#;foo" read)))
458 (pass-if-exception "#;"
459 exception:missing-expression
460 (with-input-from-string "#;" read))
461 (pass-if-exception "#;("
463 (with-input-from-string "#;(" read)))
465 (with-test-prefix "#'"
469 (equal? (with-input-from-string (car pair) read) (cdr pair))))
471 '(("#'foo". (syntax foo))
472 ("#`foo" . (quasisyntax foo))
473 ("#,foo" . (unsyntax foo))
474 ("#,@foo" . (unsyntax-splicing foo)))))
476 (with-test-prefix "#{}#"
477 (pass-if (equal? (read-string "#{}#") '#{}#))
478 (pass-if (not (equal? (read-string "(a #{.}# b)") '(a . b))))
479 (pass-if (equal? (read-string "#{a}#") 'a))
480 (pass-if (equal? (read-string "#{a b}#") '#{a b}#))
481 (pass-if-exception "#{" exception:eof-in-symbol
483 (pass-if (equal? (read-string "#{a\\x20;b}#") '#{a b}#)))
486 (with-test-prefix "deprecated #{}# escapes"
487 (pass-if (equal? (read-string "#{a\\ b}#") '#{a b}#))))
490 ;;; eval: (put 'with-read-options 'scheme-indent-function 1)