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