From: Juho Snellman <jsnell@iki.fi>
Date: Thu, 26 May 2005 22:53:59 +0000 (+0000)
Subject: 0.9.1.1:
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=3277bf7fd150b594708ae1227a428aa5ad945f71;p=sbcl.git

0.9.1.1:
    * Invalid dotted lists no longer raise a read error when
      *READ-SUPPRESS* is T
    * Use a more tasteful :EXPECTED-TYPE for type errors related to
      function names
---

diff --git a/NEWS b/NEWS
index 4a1a28b..a144a6f 100644
--- a/NEWS
+++ b/NEWS
@@ -1,3 +1,8 @@
+changes in sbcl-0.9.2 relative to sbcl-0.9.1:
+  * fixed some bugs revealed by Paul Dietz' test suite:
+    ** Invalid dotted lists no longer raise a read error when 
+       *READ-SUPPRESS* is T
+
 changes in sbcl-0.9.1 relative to sbcl-0.9.0:
   * fixed cross-compiler leakages that prevented building a 32-bit
     target with a 64-bit host compiler.
diff --git a/src/code/early-extensions.lisp b/src/code/early-extensions.lisp
index 7ae0061..f87de04 100644
--- a/src/code/early-extensions.lisp
+++ b/src/code/early-extensions.lisp
@@ -645,12 +645,14 @@
 (defun legal-fun-name-p (name)
   (values (valid-function-name-p name)))
 
+(deftype function-name () '(satisfies legal-fun-name-p))
+
 ;;; Signal an error unless NAME is a legal function name.
 (defun legal-fun-name-or-type-error (name)
   (unless (legal-fun-name-p name)
     (error 'simple-type-error
 	   :datum name
-	   :expected-type '(or symbol (cons (member setf) (cons symbol null)))
+	   :expected-type 'function-name
 	   :format-control "invalid function name: ~S"
 	   :format-arguments (list name))))
 
diff --git a/src/code/reader.lisp b/src/code/reader.lisp
index b6f28cf..86b223e 100644
--- a/src/code/reader.lisp
+++ b/src/code/reader.lisp
@@ -554,9 +554,10 @@
 	    (let ((nextchar (read-char stream t)))
 	      (cond ((token-delimiterp nextchar)
 		     (cond ((eq listtail thelist)
-			    (%reader-error
-			     stream
-			     "Nothing appears before . in list."))
+			    (unless *read-suppress*
+			      (%reader-error
+			       stream
+			       "Nothing appears before . in list.")))
 			   ((whitespacep nextchar)
 			    (setq nextchar (flush-whitespace stream))))
 		     (rplacd listtail
@@ -577,7 +578,9 @@
   (let ((lastobj ()))
     (do ((char firstchar (flush-whitespace stream)))
 	((char= char #\) )
-	 (%reader-error stream "Nothing appears after . in list."))
+	 (if *read-suppress*
+	     (return-from read-after-dot nil)
+	     (%reader-error stream "Nothing appears after . in list.")))
       ;; See whether there's something there.
       (setq lastobj (read-maybe-nothing stream char))
       (when lastobj (return t)))
@@ -587,7 +590,8 @@
 		   (flush-whitespace stream)))
 	((char= lastchar #\) ) lastobj)	;success!
       ;; Try reading virtual whitespace.
-      (if (read-maybe-nothing stream lastchar)
+      (if (and (read-maybe-nothing stream lastchar)
+	       (not *read-suppress*))
 	  (%reader-error stream "More than one object follows . in list.")))))
 
 (defun read-string (stream closech)
diff --git a/src/code/sharpm.lisp b/src/code/sharpm.lisp
index 049145d..08665e7 100644
--- a/src/code/sharpm.lisp
+++ b/src/code/sharpm.lisp
@@ -21,7 +21,12 @@
 (defun sharp-left-paren (stream ignore length)
   (declare (ignore ignore) (special *backquote-count*))
   (let* ((list (read-list stream nil))
-	 (listlength (length list)))
+	 (listlength (handler-case (length list)
+		       (type-error
+			(error)
+			(declare (ignore error))
+			(%reader-error stream "improper list in #(): ~S"
+				       list)))))
     (declare (list list)
 	     (fixnum listlength))
     (cond (*read-suppress* nil)
diff --git a/version.lisp-expr b/version.lisp-expr
index cd421a6..d9b0146 100644
--- 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.9.1"
+"0.9.1.1"