tests/reader.impure.lisp

   1 ;;;; tests related to the Lisp reader
   2
   3 ;;;; This file is impure because we want to modify the readtable and stuff.
   4
   5 ;;;; This software is part of the SBCL system. See the README file for
   6 ;;;; more information.
   7 ;;;;
   8 ;;;; While most of SBCL is derived from the CMU CL system, the test
   9 ;;;; files (like this one) were written from scratch after the fork
  10 ;;;; from CMU CL.
  11 ;;;;
  12 ;;;; This software is in the public domain and is provided with
  13 ;;;; absolutely no warranty. See the COPYING and CREDITS files for
  14 ;;;; more information.
  15
  16 (load "assertoid.lisp")
  17 (use-package "ASSERTOID")
  18
  19 ;;; Bug 30, involving mistakes in binding the read table, made this
  20 ;;; code fail.
  21 (defun read-vector (stream char)
  22   (declare (ignorable char))
  23   (coerce (read-delimited-list #\] stream t) 'vector))
  24 (set-macro-character #\[ #'read-vector nil)
  25 (set-macro-character #\] (get-macro-character #\)) nil)
  26 (multiple-value-bind (res pos)
  27     (read-from-string "[1 2 3]") ; ==> #(1 2 3), 7
  28   (assert (equalp res #(1 2 3)))
  29   (assert (= pos 7)))
  30 (multiple-value-bind (res pos)
  31     (read-from-string "#\\x") ; ==> #\x, 3
  32   (assert (equalp res #\x))
  33   (assert (= pos 3)))
  34 (multiple-value-bind (res pos)
  35     (read-from-string "[#\\x]")
  36   (assert (equalp res #(#\x)))
  37   (assert (= pos 5)))
  38
  39 ;;; Bug 51b. (try to throw READER-ERRORs when the reader encounters
  40 ;;; dubious input)
  41 (assert (raises-error? (read-from-string "1e1000") reader-error))
  42 (assert (raises-error? (read-from-string "1/0") reader-error))
  43
  44 ;;; Bug reported by Antonio Martinez on comp.lang.lisp 2003-02-03 in
  45 ;;; message <b32da960.0302030640.7d6fc610@posting.google.com>: reading
  46 ;;; circular instances of CLOS classes didn't work:
  47 (defclass box ()
  48   ((value :initarg :value :reader value)))
  49 (defun read-box (stream char)
  50   (declare (ignore char))
  51   (let ((objects (read-delimited-list #\] stream t)))
  52     (unless (= 1 (length objects))
  53       (error "Unknown box reader syntax"))
  54     (make-instance 'box :value (first objects))))
  55 (set-macro-character #\[ 'read-box)
  56 (set-syntax-from-char #\] #\))
  57 (multiple-value-bind (res pos)
  58     (read-from-string "#1=[#1#]")
  59   (assert (eq (value res) res))
  60   (assert (= pos 8)))
  61
  62 ;;; CSR managed to break the #S reader macro in the process of merging
  63 ;;; SB-PCL:CLASS and CL:CLASS -- make sure it works
  64 (defstruct readable-struct a)
  65 (macrolet
  66     ((frob (string)
  67        `(assert (eq (readable-struct-a (read-from-string ,string)) t))))
  68   (frob "#S(READABLE-STRUCT :A T)")
  69   (frob "#S(READABLE-STRUCT A T)")
  70   (frob "#S(READABLE-STRUCT \"A\" T)")
  71   (frob "#S(READABLE-STRUCT #\\A T)")
  72   (frob "#S(READABLE-STRUCT #\\A T :A NIL)"))
  73 (macrolet
  74     ((frob (string)
  75        `(assert (raises-error? (read-from-string ,string) reader-error))))
  76   (frob "#S(READABLE-STRUCT . :A)")
  77   (frob "#S(READABLE-STRUCT :A . T)")
  78   (frob "#S(READABLE-STRUCT :A T . :A)")
  79   (frob "#S(READABLE-STRUCT :A T :A . T)"))
  80
  81 ;;; reported by Henrik Motakef
  82 (defpackage "")
  83 (assert (eq (symbol-package (read-from-string "||::FOO"))
  84             (find-package "")))
  85
  86 ;;; test nested reads, test case by Helmut Eller for cmucl
  87 (defclass my-in-stream (sb-gray:fundamental-character-input-stream)
  88   ((last-char :initarg :last-char)))
  89
  90 (let ((string " a ")
  91       (i 0))
  92   (defmethod sb-gray:stream-read-char ((s my-in-stream))
  93     (with-input-from-string (s "b") (read s))
  94     (with-slots (last-char) s
  95       (cond (last-char (prog1 last-char (setf last-char nil)))
  96              (t (prog1 (aref string i)
  97                   (setq i (mod (1+ i) (length string)))))))))
  98
  99 (defmethod sb-gray:stream-unread-char ((s my-in-stream) char)
 100   (setf (slot-value s 'last-char) char)
 101   nil)
 102
 103 (assert (eq 'a (read (make-instance 'my-in-stream :last-char nil))))
 104
 105 ;;; success
 106 (quit :unix-status 104)