;;;; reader.test --- Reader test. -*- coding: iso-8859-1; mode: scheme -*-
;;;;
-;;;; Copyright (C) 1999, 2001, 2002, 2003, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
+;;;; Copyright (C) 1999, 2001-2003, 2007-2011, 2013-2015
+;;;; Free Software Foundation, Inc.
+;;;;
;;;; Jim Blandy <jimb@red-bean.com>
;;;;
;;;; This library is free software; you can redistribute it and/or
(cons 'read-error "end of file$"))
(define exception:unexpected-rparen
(cons 'read-error "unexpected \")\"$"))
+(define exception:unexpected-rsqbracket
+ (cons 'read-error "unexpected \"]\"$"))
(define exception:unterminated-block-comment
(cons 'read-error "unterminated `#. \\.\\.\\. .#' comment$"))
(define exception:unknown-character-name
(cons 'read-error "Unknown # object: .*$"))
(define exception:eof-in-string
(cons 'read-error "end of file in string constant$"))
+(define exception:eof-in-symbol
+ (cons 'read-error "end of file while reading symbol$"))
(define exception:illegal-escape
(cons 'read-error "illegal character in escape sequence: .*$"))
(define exception:missing-expression
(define (read-string s)
- (with-fluids ((%default-port-encoding #f))
- (with-input-from-string s (lambda () (read)))))
+ (with-input-from-string s (lambda () (read))))
(define (with-read-options opts thunk)
(let ((saved-options (read-options)))
(not (equal? (imag-part (read-string "-nan.0-1i"))
(imag-part (read-string "-nan.0+1i")))))
+ (pass-if-equal "'\|' in string literals"
+ "a|b"
+ (read-string "\"a\\|b\""))
+
+ (pass-if-equal "'(' in string literals"
+ "a(b"
+ (read-string "\"a\\(b\""))
+
+ (pass-if-equal "#\\escape"
+ '(a #\esc b)
+ (read-string "(a #\\escape b)"))
+
+ (pass-if-equal "#true"
+ '(a #t b)
+ (read-string "(a #true b)"))
+
+ (pass-if-equal "#false"
+ '(a #f b)
+ (read-string "(a #false b)"))
+
;; At one time the arg list for "Unknown # object: ~S" didn't make it out
;; of read.c. Check that `format' can be applied to this error.
(pass-if "error message on bad #"
(equal? '(a b c)
(read-string "(a b c #| d #| e |# f |#)")))
+ (pass-if "R6RS/SRFI-30 nested block comment (2)"
+ (equal? '(a b c)
+ (read-string "(a b c #|||||||#)")))
+
+ (pass-if "R6RS/SRFI-30 nested block comment (3)"
+ (equal? '(a b c)
+ (read-string "(a b c #||||||||#)")))
+
(pass-if "R6RS/SRFI-30 block comment syntax overridden"
;; To be compatible with 1.8 and earlier, we should be able to override
;; this syntax.
- (let ((rhp read-hash-procedures))
- (dynamic-wind
- (lambda ()
- (read-hash-extend #\| (lambda args 'not)))
- (lambda ()
- (fold (lambda (x y result)
- (and result (eq? x y)))
- #t
- (read-string "(this is #| a comment)")
- `(this is not a comment)))
- (lambda ()
- (set! read-hash-procedures rhp)))))
-
+ (with-fluids ((%read-hash-procedures (fluid-ref %read-hash-procedures)))
+ (read-hash-extend #\| (lambda args 'not))
+ (fold (lambda (x y result)
+ (and result (eq? x y)))
+ #t
+ (read-string "(this is #| a comment)")
+ `(this is not a comment))))
+
(pass-if "unprintable symbol"
;; The reader tolerates unprintable characters for symbols.
(equal? (string->symbol "\x01\x02\x03")
(pass-if "square brackets are parens"
(equal? '() (read-string "[]")))
-
+
(pass-if-exception "paren mismatch" exception:unexpected-rparen
(read-string "'[)"))
- (pass-if-exception "paren mismatch (2)" exception:mismatched-paren
- (read-string "'(]")))
+ (pass-if-exception "paren mismatch (2)" exception:unexpected-rsqbracket
+ (read-string "'(]"))
+
+ (pass-if-exception "paren mismatch (3)" exception:mismatched-paren
+ (read-string "'(foo bar]"))
+
+ (pass-if-exception "paren mismatch (4)" exception:mismatched-paren
+ (read-string "'[foo bar)")))
\f
(pass-if-exception "closing parenthesis following mismatched opening"
exception:unexpected-rparen
(read-string ")"))
+ (pass-if-exception "closing square bracket following mismatched opening"
+ exception:unexpected-rsqbracket
+ (read-string "]"))
(pass-if-exception "opening vector parenthesis"
exception:eof
(read-string "#("))
(with-read-options '(case-insensitive)
(lambda ()
(read-string "GuiLe")))))
+ (pass-if-equal "r7rs-symbols"
+ (list 'a (string->symbol "Hello, this is | a \"test\"") 'b)
+ (with-read-options '(r7rs-symbols)
+ (lambda ()
+ (read-string "(a |H\\x65;llo, this is \\| a \"test\"| b)"))))
(pass-if "prefix keywords"
(eq? #:keyword
(with-read-options '(keywords prefix case-insensitive)
(read-string "'abcde")))))
(and (equal? (source-property sexp 'line) 0)
(equal? (source-property sexp 'column) 0))))
+ (pass-if "position of SCSH block comment"
+ ;; In Guile 2.0.0 the reader would not update the port's position
+ ;; when reading an SCSH block comment.
+ (let ((sexp (with-read-options '(positions)
+ (lambda ()
+ (read-string "#!foo\nbar\nbaz\n!#\n(hello world)\n")))))
+ (= 4 (source-property sexp 'line))))
+
(with-test-prefix "r6rs-hex-escapes"
(pass-if-exception "non-hex char in two-digit hex-escape"
exception:illegal-escape
(pass-if "write R6RS string escapes"
(let* ((s1 (apply string
(map integer->char '(#x8 ; backspace
+ #x18 ; cancel
#x20 ; space
#x30 ; zero
#x40 ; at sign
(lambda () (write s1)))))))
(lset= eqv?
(string->list s2)
- (list #\" #\\ #\x #\8 #\; #\space #\0 #\@ #\"))))
+ (list #\" #\\ #\b #\\ #\x #\1 #\8 #\; #\space #\0 #\@ #\"))))
(pass-if "display R6RS string escapes"
(string=?
(with-output-to-string
(lambda ()
(write (integer->char #x80))))))
- "#\\x80"))))
-
+ "#\\x80")))
+
+ (with-test-prefix "hungry escapes"
+ (pass-if "default not hungry"
+ ;; Assume default setting of not hungry.
+ (equal? (with-input-from-string "\"foo\\\n bar\""
+ read)
+ "foo bar"))
+ (pass-if "hungry"
+ (dynamic-wind
+ (lambda ()
+ (read-enable 'hungry-eol-escapes))
+ (lambda ()
+ (equal? (with-input-from-string "\"foo\\\n bar\""
+ read)
+ "foobar"))
+ (lambda ()
+ (read-disable 'hungry-eol-escapes))))))
+(with-test-prefix "per-port-read-options"
+ (pass-if "case-sensitive"
+ (equal? '(guile GuiLe gUIle)
+ (with-read-options '(case-insensitive)
+ (lambda ()
+ (with-input-from-string "GUIle #!no-fold-case GuiLe gUIle"
+ (lambda ()
+ (list (read) (read) (read))))))))
+ (pass-if "case-insensitive"
+ (equal? '(GUIle guile guile)
+ (with-input-from-string "GUIle #!fold-case GuiLe gUIle"
+ (lambda ()
+ (list (read) (read) (read)))))))
(with-test-prefix "#;"
(for-each
("#,foo" . (unsyntax foo))
("#,@foo" . (unsyntax-splicing foo)))))
-
+(with-test-prefix "#{}#"
+ (pass-if (equal? (read-string "#{}#") '#{}#))
+ (pass-if (not (equal? (read-string "(a #{.}# b)") '(a . b))))
+ (pass-if (equal? (read-string "#{a}#") 'a))
+ (pass-if (equal? (read-string "#{a b}#") '#{a b}#))
+ (pass-if-exception "#{" exception:eof-in-symbol
+ (read-string "#{"))
+ (pass-if (equal? (read-string "#{a\\x20;b}#") '#{a b}#)))
+
+(begin-deprecated
+ (with-test-prefix "deprecated #{}# escapes"
+ (pass-if (equal? (read-string "#{a\\ b}#") '#{a b}#))))
+
+;;; Local Variables:
+;;; eval: (put 'with-read-options 'scheme-indent-function 1)
+;;; End:
HCoop / bpt / guile.git / blobdiff