guile18/test-suite/tests/reader.test

   1 ;;;; reader.test --- Exercise the reader.               -*- Scheme -*-
   2 ;;;;
   3 ;;;; Copyright (C) 1999, 2001, 2002, 2003, 2007, 2008 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   (pass-if "CR recognized as a token delimiter"
  90     ;; In 1.8.3, character 0x0d was not recognized as a delimiter.
  91     (equal? (read-string "one\x0dtwo") 'one))
  92
  93   (pass-if "returned strings are mutable"
  94     ;; Per R5RS Section 3.4, "Storage Model", `read' is supposed to return
  95     ;; mutable objects.
  96     (let ((str (with-input-from-string "\"hello, world\"" read)))
  97       (string-set! str 0 #\H)
  98       (string=? str "Hello, world"))))
  99
 100 \f
 101 (pass-if-exception "radix passed to number->string can't be zero"
 102   exception:out-of-range
 103   (number->string 10 0))
 104 (pass-if-exception "radix passed to number->string can't be one either"
 105   exception:out-of-range
 106   (number->string 10 1))
 107
 108 \f
 109 (with-test-prefix "mismatching parentheses"
 110   (pass-if-exception "opening parenthesis"
 111     exception:eof
 112     (read-string "("))
 113   (pass-if-exception "closing parenthesis following mismatched opening"
 114     exception:unexpected-rparen
 115     (read-string ")"))
 116   (pass-if-exception "opening vector parenthesis"
 117     exception:eof
 118     (read-string "#("))
 119   (pass-if-exception "closing parenthesis following mismatched vector opening"
 120      exception:unexpected-rparen
 121      (read-string ")")))
 122
 123 \f
 124 (with-test-prefix "exceptions"
 125
 126   ;; Reader exceptions: although they are not documented, they may be relied
 127   ;; on by some programs, hence these tests.
 128
 129   (pass-if-exception "unterminated block comment"
 130     exception:unterminated-block-comment
 131     (read-string "(+ 1 #! comment\n..."))
 132   (pass-if-exception "unknown character name"
 133     exception:unknown-character-name
 134     (read-string "#\\theunknowncharacter"))
 135   (pass-if-exception "unknown sharp object"
 136     exception:unknown-sharp-object
 137     (read-string "#?"))
 138   (pass-if-exception "eof in string"
 139     exception:eof-in-string
 140     (read-string "\"the string that never ends"))
 141   (pass-if-exception "illegal escape in string"
 142     exception:illegal-escape
 143     (read-string "\"some string \\???\"")))
 144
 145 \f
 146 (with-test-prefix "read-options"
 147   (pass-if "case-sensitive"
 148     (not (eq? 'guile 'GuiLe)))
 149   (pass-if "case-insensitive"
 150     (eq? 'guile
 151          (with-read-options '(case-insensitive)
 152            (lambda ()
 153              (read-string "GuiLe")))))
 154   (pass-if "prefix keywords"
 155     (eq? #:keyword
 156          (with-read-options '(keywords prefix case-insensitive)
 157            (lambda ()
 158              (read-string ":KeyWord")))))
 159   (pass-if "prefix non-keywords"
 160     (symbol? (with-read-options '(keywords prefix)
 161                (lambda ()
 162                  (read-string "srfi88-keyword:")))))
 163   (pass-if "postfix keywords"
 164     (eq? #:keyword
 165          (with-read-options '(keywords postfix)
 166            (lambda ()
 167              (read-string "keyword:")))))
 168   (pass-if "long postfix keywords"
 169     (eq? #:keyword0123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789
 170          (with-read-options '(keywords postfix)
 171            (lambda ()
 172              (read-string "keyword0123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789:")))))
 173   (pass-if "`:' is not a postfix keyword (per SRFI-88)"
 174     (eq? ':
 175          (with-read-options '(keywords postfix)
 176            (lambda ()
 177              (read-string ":")))))
 178   (pass-if "no positions"
 179     (let ((sexp (with-read-options '()
 180                   (lambda ()
 181                     (read-string "(+ 1 2 3)")))))
 182       (and (not (source-property sexp 'line))
 183            (not (source-property sexp 'column)))))
 184   (pass-if "positions"
 185     (let ((sexp (with-read-options '(positions)
 186                   (lambda ()
 187                     (read-string "(+ 1 2 3)")))))
 188       (and (equal? (source-property sexp 'line) 0)
 189            (equal? (source-property sexp 'column) 0))))
 190   (pass-if "positions on quote"
 191     (let ((sexp (with-read-options '(positions)
 192                   (lambda ()
 193                     (read-string "'abcde")))))
 194       (and (equal? (source-property sexp 'line) 0)
 195            (equal? (source-property sexp 'column) 0)))))
 196