test-suite/tests/reader.test

   1 ;;;; reader.test --- Reader test.    -*- coding: iso-8859-1; mode: scheme -*-
   2 ;;;;
   3 ;;;; Copyright (C) 1999, 2001, 2002, 2003, 2007, 2008, 2009, 2010 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 3 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 (srfi srfi-1)
  22   :use-module (test-suite lib))
  23
  24
  25 (define exception:eof
  26   (cons 'read-error "end of file$"))
  27 (define exception:unexpected-rparen
  28   (cons 'read-error "unexpected \")\"$"))
  29 (define exception:unterminated-block-comment
  30   (cons 'read-error "unterminated `#. \\.\\.\\. .#' comment$"))
  31 (define exception:unknown-character-name
  32   (cons 'read-error "unknown character name .*$"))
  33 (define exception:unknown-sharp-object
  34   (cons 'read-error "Unknown # object: .*$"))
  35 (define exception:eof-in-string
  36   (cons 'read-error "end of file in string constant$"))
  37 (define exception:illegal-escape
  38   (cons 'read-error "illegal character in escape sequence: .*$"))
  39 (define exception:missing-expression
  40   (cons 'read-error "no expression after #;"))
  41
  42
  43 (define (read-string s)
  44   (with-fluids ((%default-port-encoding #f))
  45     (with-input-from-string s (lambda () (read)))))
  46
  47 (define (with-read-options opts thunk)
  48   (let ((saved-options (read-options)))
  49     (dynamic-wind
  50         (lambda ()
  51           (read-options opts))
  52         thunk
  53         (lambda ()
  54           (read-options saved-options)))))
  55
  56 \f
  57 (with-test-prefix "reading"
  58   (pass-if "0"
  59     (equal? (read-string "0") 0))
  60   (pass-if "1++i"
  61     (equal? (read-string "1++i") '1++i))
  62   (pass-if "1+i+i"
  63     (equal? (read-string "1+i+i") '1+i+i))
  64   (pass-if "1+e10000i"
  65     (equal? (read-string "1+e10000i") '1+e10000i))
  66
  67   ;; At one time the arg list for "Unknown # object: ~S" didn't make it out
  68   ;; of read.c.  Check that `format' can be applied to this error.
  69   (pass-if "error message on bad #"
  70     (catch #t
  71            (lambda ()
  72              (read-string "#ZZZ")
  73              ;; oops, this # is supposed to be unrecognised
  74              #f)
  75            (lambda (key subr message args rest)
  76              (apply format #f message args)
  77              ;; message and args are ok
  78              #t)))
  79
  80   (pass-if "block comment"
  81     (equal? '(+ 1 2 3)
  82             (read-string "(+ 1 #! this is a\ncomment !# 2 3)")))
  83
  84   (pass-if "block comment finishing s-exp"
  85     (equal? '(+ 2)
  86             (read-string "(+ 2 #! a comment\n!#\n) ")))
  87
  88   (pass-if "R6RS/SRFI-30 block comment"
  89     (equal? '(+ 1 2 3)
  90             (read-string "(+ 1 #| this is a\ncomment |# 2 3)")))
  91
  92   (pass-if "R6RS/SRFI-30 nested block comment"
  93     (equal? '(a b c)
  94             (read-string "(a b c #| d #| e |# f |#)")))
  95
  96   (pass-if "R6RS/SRFI-30 block comment syntax overridden"
  97     ;; To be compatible with 1.8 and earlier, we should be able to override
  98     ;; this syntax.
  99     (let ((rhp read-hash-procedures))
 100       (dynamic-wind
 101         (lambda ()
 102           (read-hash-extend #\| (lambda args 'not)))
 103         (lambda ()
 104           (fold (lambda (x y result)
 105                   (and result (eq? x y)))
 106                 #t
 107                 (read-string "(this is #| a comment)")
 108                 `(this is not a comment)))
 109         (lambda ()
 110           (set! read-hash-procedures rhp)))))
 111
 112   (pass-if "unprintable symbol"
 113     ;; The reader tolerates unprintable characters for symbols.
 114     (equal? (string->symbol "\x01\x02\x03")
 115             (read-string "\x01\x02\x03")))
 116
 117   (pass-if "CR recognized as a token delimiter"
 118     ;; In 1.8.3, character 0x0d was not recognized as a delimiter.
 119     (equal? (read-string "one\x0dtwo") 'one))
 120
 121   (pass-if "returned strings are mutable"
 122     ;; Per R5RS Section 3.4, "Storage Model", `read' is supposed to return
 123     ;; mutable objects.
 124     (let ((str (with-input-from-string "\"hello, world\"" read)))
 125       (string-set! str 0 #\H)
 126       (string=? str "Hello, world"))))
 127
 128 \f
 129 (pass-if-exception "radix passed to number->string can't be zero"
 130   exception:out-of-range
 131   (number->string 10 0))
 132 (pass-if-exception "radix passed to number->string can't be one either"
 133   exception:out-of-range
 134   (number->string 10 1))
 135
 136 \f
 137 (with-test-prefix "mismatching parentheses"
 138   (pass-if-exception "opening parenthesis"
 139     exception:eof
 140     (read-string "("))
 141   (pass-if-exception "closing parenthesis following mismatched opening"
 142     exception:unexpected-rparen
 143     (read-string ")"))
 144   (pass-if-exception "opening vector parenthesis"
 145     exception:eof
 146     (read-string "#("))
 147   (pass-if-exception "closing parenthesis following mismatched vector opening"
 148      exception:unexpected-rparen
 149      (read-string ")")))
 150
 151 \f
 152 (with-test-prefix "exceptions"
 153
 154   ;; Reader exceptions: although they are not documented, they may be relied
 155   ;; on by some programs, hence these tests.
 156
 157   (pass-if-exception "unterminated block comment"
 158     exception:unterminated-block-comment
 159     (read-string "(+ 1 #! comment\n..."))
 160   (pass-if-exception "R6RS/SRFI-30 unterminated nested block comment"
 161     exception:unterminated-block-comment
 162     (read-string "(foo #| bar #| |#)"))
 163   (pass-if-exception "unknown character name"
 164     exception:unknown-character-name
 165     (read-string "#\\theunknowncharacter"))
 166   (pass-if-exception "unknown sharp object"
 167     exception:unknown-sharp-object
 168     (read-string "#?"))
 169   (pass-if-exception "eof in string"
 170     exception:eof-in-string
 171     (read-string "\"the string that never ends"))
 172   (pass-if-exception "illegal escape in string"
 173     exception:illegal-escape
 174     (read-string "\"some string \\???\"")))
 175
 176 \f
 177 (with-test-prefix "read-options"
 178   (pass-if "case-sensitive"
 179     (not (eq? 'guile 'GuiLe)))
 180   (pass-if "case-insensitive"
 181     (eq? 'guile
 182          (with-read-options '(case-insensitive)
 183            (lambda ()
 184              (read-string "GuiLe")))))
 185   (pass-if "prefix keywords"
 186     (eq? #:keyword
 187          (with-read-options '(keywords prefix case-insensitive)
 188            (lambda ()
 189              (read-string ":KeyWord")))))
 190   (pass-if "prefix non-keywords"
 191     (symbol? (with-read-options '(keywords prefix)
 192                (lambda ()
 193                  (read-string "srfi88-keyword:")))))
 194   (pass-if "postfix keywords"
 195     (eq? #:keyword
 196          (with-read-options '(keywords postfix)
 197            (lambda ()
 198              (read-string "keyword:")))))
 199   (pass-if "long postfix keywords"
 200     (eq? #:keyword0123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789
 201          (with-read-options '(keywords postfix)
 202            (lambda ()
 203              (read-string "keyword0123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789:")))))
 204   (pass-if "`:' is not a postfix keyword (per SRFI-88)"
 205     (eq? ':
 206          (with-read-options '(keywords postfix)
 207            (lambda ()
 208              (read-string ":")))))
 209   (pass-if "no positions"
 210     (let ((sexp (with-read-options '()
 211                   (lambda ()
 212                     (read-string "(+ 1 2 3)")))))
 213       (and (not (source-property sexp 'line))
 214            (not (source-property sexp 'column)))))
 215   (pass-if "positions"
 216     (let ((sexp (with-read-options '(positions)
 217                   (lambda ()
 218                     (read-string "(+ 1 2 3)")))))
 219       (and (equal? (source-property sexp 'line) 0)
 220            (equal? (source-property sexp 'column) 0))))
 221   (pass-if "positions on quote"
 222     (let ((sexp (with-read-options '(positions)
 223                    (lambda ()
 224                     (read-string "'abcde")))))
 225       (and (equal? (source-property sexp 'line) 0)
 226            (equal? (source-property sexp 'column) 0))))
 227   (with-test-prefix "r6rs-hex-escapes"
 228       (pass-if-exception "non-hex char in two-digit hex-escape"
 229       exception:illegal-escape
 230       (with-read-options '(r6rs-hex-escapes)
 231         (lambda ()
 232           (with-input-from-string "\"\\x0g;\"" read))))
 233
 234     (pass-if-exception "non-hex char in four-digit hex-escape"
 235       exception:illegal-escape
 236       (with-read-options '(r6rs-hex-escapes)
 237         (lambda ()
 238           (with-input-from-string "\"\\x000g;\"" read))))
 239
 240     (pass-if-exception "non-hex char in six-digit hex-escape"
 241       exception:illegal-escape
 242       (with-read-options '(r6rs-hex-escapes)
 243         (lambda ()
 244           (with-input-from-string "\"\\x00000g;\"" read))))
 245
 246     (pass-if-exception "no semicolon at termination of one-digit hex-escape"
 247       exception:illegal-escape
 248       (with-read-options '(r6rs-hex-escapes)
 249         (lambda ()
 250           (with-input-from-string "\"\\x0\"" read))))
 251
 252     (pass-if-exception "no semicolon at termination of three-digit hex-escape"
 253       exception:illegal-escape
 254       (with-read-options '(r6rs-hex-escapes)
 255         (lambda ()
 256           (with-input-from-string "\"\\x000\"" read))))
 257
 258     (pass-if "two-digit hex escape"
 259       (eqv?
 260        (with-read-options '(r6rs-hex-escapes)
 261          (lambda ()
 262            (string-ref (with-input-from-string "\"--\\xff;--\"" read) 2)))
 263        (integer->char #xff)))
 264
 265     (pass-if "four-digit hex escape"
 266       (eqv?
 267        (with-read-options '(r6rs-hex-escapes)
 268          (lambda ()
 269            (string-ref (with-input-from-string "\"--\\x0100;--\"" read) 2)))
 270        (integer->char #x0100)))
 271
 272     (pass-if "six-digit hex escape"
 273       (eqv?
 274        (with-read-options '(r6rs-hex-escapes)
 275          (lambda ()
 276            (string-ref (with-input-from-string "\"--\\x010300;--\"" read) 2)))
 277        (integer->char #x010300)))
 278
 279     (pass-if "escaped characters match non-escaped ASCII characters"
 280       (string=?
 281        (with-read-options '(r6rs-hex-escapes)
 282          (lambda ()
 283            (with-input-from-string "\"\\x41;\\x0042;\\x000043;\"" read)))
 284        "ABC"))
 285
 286     (pass-if "write R6RS string escapes"
 287        (let* ((s1 (apply string
 288                          (map integer->char '(#x8 ; backspace
 289                                               #x20 ; space
 290                                               #x30 ; zero
 291                                               #x40 ; at sign
 292                                               ))))
 293               (s2 (with-read-options '(r6rs-hex-escapes)
 294                      (lambda ()
 295                       (with-output-to-string
 296                         (lambda () (write s1)))))))
 297          (lset= eqv?
 298                 (string->list s2)
 299                 (list #\" #\\ #\x #\8 #\; #\space #\0 #\@ #\"))))
 300
 301     (pass-if "display R6RS string escapes"
 302       (string=?
 303        (with-read-options '(r6rs-hex-escapes)
 304          (lambda ()
 305            (let ((pt (open-output-string))
 306                  (s1 (apply string (map integer->char
 307                                         '(#xFF #x100 #xFFF #x1000 #xFFFF #x10000)))))
 308              (set-port-encoding! pt "ASCII")
 309              (set-port-conversion-strategy! pt 'escape)
 310              (display s1 pt)
 311              (get-output-string pt))))
 312        "\\xff;\\x100;\\xfff;\\x1000;\\xffff;\\x10000;"))
 313
 314     (pass-if "one-digit hex escape"
 315       (eqv? (with-read-options '(r6rs-hex-escapes)
 316               (lambda ()
 317                 (with-input-from-string "#\\xA" read)))
 318             (integer->char #x0A)))
 319
 320     (pass-if "two-digit hex escape"
 321       (eqv? (with-read-options '(r6rs-hex-escapes)
 322               (lambda ()
 323                 (with-input-from-string "#\\xFF" read)))
 324             (integer->char #xFF)))
 325
 326     (pass-if "four-digit hex escape"
 327       (eqv? (with-read-options '(r6rs-hex-escapes)
 328               (lambda ()
 329                 (with-input-from-string "#\\x00FF" read)))
 330             (integer->char #xFF)))
 331
 332     (pass-if "eight-digit hex escape"
 333       (eqv? (with-read-options '(r6rs-hex-escapes)
 334               (lambda ()
 335                 (with-input-from-string "#\\x00006587" read)))
 336             (integer->char #x6587)))
 337     (pass-if "write R6RS escapes"
 338       (string=?
 339        (with-read-options '(r6rs-hex-escapes)
 340          (lambda ()
 341            (with-output-to-string
 342              (lambda ()
 343                (write (integer->char #x80))))))
 344        "#\\x80"))))
 345
 346
 347
 348 (with-test-prefix "#;"
 349   (for-each
 350    (lambda (pair)
 351      (pass-if (car pair)
 352        (equal? (with-input-from-string (car pair) read) (cdr pair))))
 353
 354    '(("#;foo 10". 10)
 355      ("#;(10 20 30) foo" . foo)
 356      ("#;   (10 20 30) foo" . foo)
 357      ("#;\n10\n20" . 20)))
 358
 359   (pass-if "#;foo"
 360     (eof-object? (with-input-from-string "#;foo" read)))
 361
 362   (pass-if-exception "#;"
 363     exception:missing-expression
 364     (with-input-from-string "#;" read))
 365   (pass-if-exception "#;("
 366     exception:eof
 367     (with-input-from-string "#;(" read)))
 368
 369 (with-test-prefix "#'"
 370   (for-each
 371    (lambda (pair)
 372      (pass-if (car pair)
 373        (equal? (with-input-from-string (car pair) read) (cdr pair))))
 374
 375    '(("#'foo". (syntax foo))
 376      ("#`foo" . (quasisyntax foo))
 377      ("#,foo" . (unsyntax foo))
 378      ("#,@foo" . (unsyntax-splicing foo)))))
 379
 380