test-suite/tests/reader.test

   1 ;;;; reader.test --- Exercise the reader.               -*- Scheme -*-
   2 ;;;;
   3 ;;;; Copyright (C) 1999, 2001, 2002, 2003, 2007 Free Software Foundation, Inc.
   4 ;;;; Jim Blandy <jimb@red-bean.com>
   5 ;;;;
   6 ;;;; This library is free software; you can redistribute it and/or
   7 ;;;; modify it under the terms of the GNU Lesser General Public
   8 ;;;; License as published by the Free Software Foundation; either
   9 ;;;; version 2.1 of the License, or (at your option) any later version.
  10 ;;;;
  11 ;;;; This library is distributed in the hope that it will be useful,
  12 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  14 ;;;; Lesser General Public License for more details.
  15 ;;;;
  16 ;;;; You should have received a copy of the GNU Lesser General Public
  17 ;;;; License along with this library; if not, write to the Free Software
  18 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  19
  20 (define-module (test-suite reader)
  21   :use-module (test-suite lib))
  22
  23
  24 (define exception:eof
  25   (cons 'read-error "end of file$"))
  26 (define exception:unexpected-rparen
  27   (cons 'read-error "unexpected \")\"$"))
  28 (define exception:unterminated-block-comment
  29   (cons 'read-error "unterminated `#! ... !#' comment$"))
  30 (define exception:unknown-character-name
  31   (cons 'read-error "unknown character name .*$"))
  32 (define exception:unknown-sharp-object
  33   (cons 'read-error "Unknown # object: .*$"))
  34 (define exception:eof-in-string
  35   (cons 'read-error "end of file in string constant$"))
  36 (define exception:illegal-escape
  37   (cons 'read-error "illegal character in escape sequence: .*$"))
  38
  39
  40 (define (read-string s)
  41   (with-input-from-string s (lambda () (read))))
  42
  43 (define (with-read-options opts thunk)
  44   (let ((saved-options (read-options)))
  45     (dynamic-wind
  46         (lambda ()
  47           (read-options opts))
  48         thunk
  49         (lambda ()
  50           (read-options saved-options)))))
  51
  52 \f
  53 (with-test-prefix "reading"
  54   (pass-if "0"
  55     (equal? (read-string "0") 0))
  56   (pass-if "1++i"
  57     (equal? (read-string "1++i") '1++i))
  58   (pass-if "1+i+i"
  59     (equal? (read-string "1+i+i") '1+i+i))
  60   (pass-if "1+e10000i"
  61     (equal? (read-string "1+e10000i") '1+e10000i))
  62
  63   ;; At one time the arg list for "Unknown # object: ~S" didn't make it out
  64   ;; of read.c.  Check that `format' can be applied to this error.
  65   (pass-if "error message on bad #"
  66     (catch #t
  67            (lambda ()
  68              (read-string "#ZZZ")
  69              ;; oops, this # is supposed to be unrecognised
  70              #f)
  71            (lambda (key subr message args rest)
  72              (apply format #f message args)
  73              ;; message and args are ok
  74              #t)))
  75
  76   (pass-if "block comment"
  77     (equal? '(+ 1 2 3)
  78             (read-string "(+ 1 #! this is a\ncomment !# 2 3)")))
  79
  80   (pass-if "block comment finishing s-exp"
  81     (equal? '(+ 2)
  82             (read-string "(+ 2 #! a comment\n!#\n) ")))
  83
  84   (pass-if "unprintable symbol"
  85     ;; The reader tolerates unprintable characters for symbols.
  86     (equal? (string->symbol "\001\002\003")
  87             (read-string "\001\002\003"))))
  88
  89 \f
  90 (pass-if-exception "radix passed to number->string can't be zero"
  91   exception:out-of-range
  92   (number->string 10 0))
  93 (pass-if-exception "radix passed to number->string can't be one either"
  94   exception:out-of-range
  95   (number->string 10 1))
  96
  97 \f
  98 (with-test-prefix "mismatching parentheses"
  99   (pass-if-exception "opening parenthesis"
 100     exception:eof
 101     (read-string "("))
 102   (pass-if-exception "closing parenthesis following mismatched opening"
 103     exception:unexpected-rparen
 104     (read-string ")"))
 105   (pass-if-exception "opening vector parenthesis"
 106     exception:eof
 107     (read-string "#("))
 108   (pass-if-exception "closing parenthesis following mismatched vector opening"
 109      exception:unexpected-rparen
 110      (read-string ")")))
 111
 112 \f
 113 (with-test-prefix "exceptions"
 114
 115   ;; Reader exceptions: although they are not documented, they may be relied
 116   ;; on by some programs, hence these tests.
 117
 118   (pass-if-exception "unterminated block comment"
 119     exception:unterminated-block-comment
 120     (read-string "(+ 1 #! comment\n..."))
 121   (pass-if-exception "unknown character name"
 122     exception:unknown-character-name
 123     (read-string "#\\theunknowncharacter"))
 124   (pass-if-exception "unknown sharp object"
 125     exception:unknown-sharp-object
 126     (read-string "#?"))
 127   (pass-if-exception "eof in string"
 128     exception:eof-in-string
 129     (read-string "\"the string that never ends"))
 130   (pass-if-exception "illegal escape in string"
 131     exception:illegal-escape
 132     (read-string "\"some string \\???\"")))
 133
 134 \f
 135 (with-test-prefix "read-options"
 136   (pass-if "case-sensitive"
 137     (not (eq? 'guile 'GuiLe)))
 138   (pass-if "case-insensitive"
 139     (eq? 'guile
 140          (with-read-options '(case-insensitive)
 141            (lambda ()
 142              (read-string "GuiLe")))))
 143   (pass-if "prefix keywords"
 144     (eq? #:keyword
 145          (with-read-options '(keywords prefix case-insensitive)
 146            (lambda ()
 147              (read-string ":KeyWord")))))
 148   (pass-if "no positions"
 149     (let ((sexp (with-read-options '()
 150                   (lambda ()
 151                     (read-string "(+ 1 2 3)")))))
 152       (and (not (source-property sexp 'line))
 153            (not (source-property sexp 'column)))))
 154   (pass-if "positions"
 155     (let ((sexp (with-read-options '(positions)
 156                   (lambda ()
 157                     (read-string "(+ 1 2 3)")))))
 158       (and (equal? (source-property sexp 'line) 0)
 159            (equal? (source-property sexp 'column) 0))))
 160   (pass-if "positions on quote"
 161     (let ((sexp (with-read-options '(positions)
 162                   (lambda ()
 163                     (read-string "'abcde")))))
 164       (and (equal? (source-property sexp 'line) 0)
 165            (equal? (source-property sexp 'column) 0)))))
 166