0.8.16.1: reader ANSI fixes

           * Return primary value NIL for various READ-FOO when
              *READ-SUPPRESS* is NIL.
           * Eof-error-p in READ-FROM-STRING defaults true.

          HEALTH WARNING: These changes will probably break Slime,
           or at least parts thereof. Slime patch forthcoming.

diff --git a/NEWS b/NEWS
index 5f93cfa..5e4f658 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -1,3 +1,10 @@
+changes in sbcl-0.8.17 relative to sbcl-0.8.16:
+  * bug fix: READ, READ-PRESERVING-WHITESPACE, READ-DELIMITED-LIST,
+    and READ-FROM-STRING all now return a primary value of NIL if
+    *READ-SUPPRESS* is true. (reported by Bruno Haible for CMUCL)
+  * bug fix: Default value of EOF-ERROR-P in READ-FROM-STRING is true.
+    (reported by Bruno Haible for CMUCL)
+
 changes in sbcl-0.8.16 relative to sbcl-0.8.15:
   * enhancement: saving cores with foreign code loaded is now
     supported on x86/NetBSD and sparc/Linux in addition to the previously

diff --git a/src/code/reader.lisp b/src/code/reader.lisp
index 0f2df53..04c893f 100644 (file)
--- a/src/code/reader.lisp
+++ b/src/code/reader.lisp
@@ -407,18 +407,19 @@
   "Read from STREAM and return the value read, preserving any whitespace
    that followed the object."
   (if recursivep
-    ;; a loop for repeating when a macro returns nothing
-    (loop
-      (let ((char (read-char stream eof-error-p *eof-object*)))
-       (cond ((eofp char) (return eof-value))
-             ((whitespacep char))
-             (t
-              (let* ((macrofun (get-coerced-cmt-entry char *readtable*))
-                     (result (multiple-value-list
-                              (funcall macrofun stream char))))
-                ;; Repeat if macro returned nothing.
-                 (if result (return (car result))))))))
-    (let ((*sharp-equal-alist* nil))
+      ;; a loop for repeating when a macro returns nothing
+      (loop
+       (let ((char (read-char stream eof-error-p *eof-object*)))
+         (cond ((eofp char) (return eof-value))
+               ((whitespacep char))
+               (t
+                (let* ((macrofun (get-coerced-cmt-entry char *readtable*))
+                       (result (multiple-value-list
+                                (funcall macrofun stream char))))
+                  ;; Repeat if macro returned nothing.
+                 (when result 
+                    (return (unless *read-suppress* (car result)))))))))
+      (let ((*sharp-equal-alist* nil))
        (read-preserving-whitespace stream eof-error-p eof-value t))))
 
 ;;; Return NIL or a list with one thing, depending.
@@ -430,7 +431,8 @@
                 (funcall (get-coerced-cmt-entry char *readtable*)
                          stream
                          char))))
-    (if retval (rplacd retval nil))))
+    (when (and retval (not *read-suppress*))
+      (rplacd retval nil))))
 
 (defun read (&optional (stream *standard-input*)
                       (eof-error-p t)
@@ -442,9 +444,9 @@
                                            eof-error-p
                                            eof-value
                                            recursivep)))
-    ;; (This function generally discards trailing whitespace. If you
+    ;; This function generally discards trailing whitespace. If you
     ;; don't want to discard trailing whitespace, call
-    ;; CL:READ-PRESERVING-WHITESPACE instead.)
+    ;; CL:READ-PRESERVING-WHITESPACE instead.
     (unless (or (eql result eof-value) recursivep)
       (let ((next-char (read-char stream nil nil)))
        (unless (or (null next-char)
@@ -1419,7 +1421,7 @@
   #!+sb-doc
   "A resource of string streams for Read-From-String.")
 
-(defun read-from-string (string &optional eof-error-p eof-value
+(defun read-from-string (string &optional (eof-error-p t) eof-value
                                &key (start 0) end
                                preserve-whitespace)
   #!+sb-doc

diff --git a/tests/reader.pure.lisp b/tests/reader.pure.lisp
index be7f77c..7e964ff 100644 (file)
--- a/tests/reader.pure.lisp
+++ b/tests/reader.pure.lisp
@@ -207,3 +207,20 @@
                (unless fun (list char)))))))
     (let ((*readtable* (copy-readtable nil)))
       (assert (null (loop for c across standard-chars append (frob c)))))))
+
+;;; All these must return a primary value of NIL when *read-suppress* is T
+;;; Reported by Bruno Haible on cmucl-imp 2004-10-25.
+(let ((*read-suppress* t))
+  (assert (null (read-from-string "(1 2 3)")))
+  (assert (null (with-input-from-string (s "abc xyz)")
+                  (read-delimited-list #\) s))))
+  (assert (null (with-input-from-string (s "(1 2 3)")
+                  (read-preserving-whitespace s))))
+  (assert (null (with-input-from-string (s "(1 2 3)")
+                 (read s)))))
+
+;;; EOF-ERROR-P defaults to true. Reported by Bruno Haible on
+;;; cmucl-imp 2004-10-18.
+(multiple-value-bind (res err) (ignore-errors (read-from-string ""))
+  (assert (not res))
+  (assert (typep err 'end-of-file)))

diff --git a/version.lisp-expr b/version.lisp-expr
index 8b53e43..83d4b04 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.8.16"
+"0.8.16.1"