--- /dev/null
+;;;; reader.test --- Exercise the reader. -*- Scheme -*-
+;;;;
+;;;; Copyright (C) 1999, 2001, 2002, 2003, 2007, 2008 Free Software Foundation, Inc.
+;;;; Jim Blandy <jimb@red-bean.com>
+;;;;
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 2.1 of the License, or (at your option) any later version.
+;;;;
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;;;; Lesser General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+(define-module (test-suite reader)
+ :use-module (test-suite lib))
+
+
+(define exception:eof
+ (cons 'read-error "end of file$"))
+(define exception:unexpected-rparen
+ (cons 'read-error "unexpected \")\"$"))
+(define exception:unterminated-block-comment
+ (cons 'read-error "unterminated `#! ... !#' comment$"))
+(define exception:unknown-character-name
+ (cons 'read-error "unknown character name .*$"))
+(define exception:unknown-sharp-object
+ (cons 'read-error "Unknown # object: .*$"))
+(define exception:eof-in-string
+ (cons 'read-error "end of file in string constant$"))
+(define exception:illegal-escape
+ (cons 'read-error "illegal character in escape sequence: .*$"))
+
+
+(define (read-string s)
+ (with-input-from-string s (lambda () (read))))
+
+(define (with-read-options opts thunk)
+ (let ((saved-options (read-options)))
+ (dynamic-wind
+ (lambda ()
+ (read-options opts))
+ thunk
+ (lambda ()
+ (read-options saved-options)))))
+
+\f
+(with-test-prefix "reading"
+ (pass-if "0"
+ (equal? (read-string "0") 0))
+ (pass-if "1++i"
+ (equal? (read-string "1++i") '1++i))
+ (pass-if "1+i+i"
+ (equal? (read-string "1+i+i") '1+i+i))
+ (pass-if "1+e10000i"
+ (equal? (read-string "1+e10000i") '1+e10000i))
+
+ ;; 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 #"
+ (catch #t
+ (lambda ()
+ (read-string "#ZZZ")
+ ;; oops, this # is supposed to be unrecognised
+ #f)
+ (lambda (key subr message args rest)
+ (apply format #f message args)
+ ;; message and args are ok
+ #t)))
+
+ (pass-if "block comment"
+ (equal? '(+ 1 2 3)
+ (read-string "(+ 1 #! this is a\ncomment !# 2 3)")))
+
+ (pass-if "block comment finishing s-exp"
+ (equal? '(+ 2)
+ (read-string "(+ 2 #! a comment\n!#\n) ")))
+
+ (pass-if "unprintable symbol"
+ ;; The reader tolerates unprintable characters for symbols.
+ (equal? (string->symbol "\001\002\003")
+ (read-string "\001\002\003")))
+
+ (pass-if "CR recognized as a token delimiter"
+ ;; In 1.8.3, character 0x0d was not recognized as a delimiter.
+ (equal? (read-string "one\x0dtwo") 'one))
+
+ (pass-if "returned strings are mutable"
+ ;; Per R5RS Section 3.4, "Storage Model", `read' is supposed to return
+ ;; mutable objects.
+ (let ((str (with-input-from-string "\"hello, world\"" read)))
+ (string-set! str 0 #\H)
+ (string=? str "Hello, world"))))
+
+\f
+(pass-if-exception "radix passed to number->string can't be zero"
+ exception:out-of-range
+ (number->string 10 0))
+(pass-if-exception "radix passed to number->string can't be one either"
+ exception:out-of-range
+ (number->string 10 1))
+
+\f
+(with-test-prefix "mismatching parentheses"
+ (pass-if-exception "opening parenthesis"
+ exception:eof
+ (read-string "("))
+ (pass-if-exception "closing parenthesis following mismatched opening"
+ exception:unexpected-rparen
+ (read-string ")"))
+ (pass-if-exception "opening vector parenthesis"
+ exception:eof
+ (read-string "#("))
+ (pass-if-exception "closing parenthesis following mismatched vector opening"
+ exception:unexpected-rparen
+ (read-string ")")))
+
+\f
+(with-test-prefix "exceptions"
+
+ ;; Reader exceptions: although they are not documented, they may be relied
+ ;; on by some programs, hence these tests.
+
+ (pass-if-exception "unterminated block comment"
+ exception:unterminated-block-comment
+ (read-string "(+ 1 #! comment\n..."))
+ (pass-if-exception "unknown character name"
+ exception:unknown-character-name
+ (read-string "#\\theunknowncharacter"))
+ (pass-if-exception "unknown sharp object"
+ exception:unknown-sharp-object
+ (read-string "#?"))
+ (pass-if-exception "eof in string"
+ exception:eof-in-string
+ (read-string "\"the string that never ends"))
+ (pass-if-exception "illegal escape in string"
+ exception:illegal-escape
+ (read-string "\"some string \\???\"")))
+
+\f
+(with-test-prefix "read-options"
+ (pass-if "case-sensitive"
+ (not (eq? 'guile 'GuiLe)))
+ (pass-if "case-insensitive"
+ (eq? 'guile
+ (with-read-options '(case-insensitive)
+ (lambda ()
+ (read-string "GuiLe")))))
+ (pass-if "prefix keywords"
+ (eq? #:keyword
+ (with-read-options '(keywords prefix case-insensitive)
+ (lambda ()
+ (read-string ":KeyWord")))))
+ (pass-if "prefix non-keywords"
+ (symbol? (with-read-options '(keywords prefix)
+ (lambda ()
+ (read-string "srfi88-keyword:")))))
+ (pass-if "postfix keywords"
+ (eq? #:keyword
+ (with-read-options '(keywords postfix)
+ (lambda ()
+ (read-string "keyword:")))))
+ (pass-if "long postfix keywords"
+ (eq? #:keyword0123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789
+ (with-read-options '(keywords postfix)
+ (lambda ()
+ (read-string "keyword0123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789:")))))
+ (pass-if "`:' is not a postfix keyword (per SRFI-88)"
+ (eq? ':
+ (with-read-options '(keywords postfix)
+ (lambda ()
+ (read-string ":")))))
+ (pass-if "no positions"
+ (let ((sexp (with-read-options '()
+ (lambda ()
+ (read-string "(+ 1 2 3)")))))
+ (and (not (source-property sexp 'line))
+ (not (source-property sexp 'column)))))
+ (pass-if "positions"
+ (let ((sexp (with-read-options '(positions)
+ (lambda ()
+ (read-string "(+ 1 2 3)")))))
+ (and (equal? (source-property sexp 'line) 0)
+ (equal? (source-property sexp 'column) 0))))
+ (pass-if "positions on quote"
+ (let ((sexp (with-read-options '(positions)
+ (lambda ()
+ (read-string "'abcde")))))
+ (and (equal? (source-property sexp 'line) 0)
+ (equal? (source-property sexp 'column) 0)))))
+
projects / lilypond.git / blobdiff