Update of /cvsroot/sbcl/sbcl/src/code
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv18536/src/code
Modified Files:
early-extensions.lisp reader.lisp sharpm.lisp
Log Message:
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
Index: early-extensions.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/early-extensions.lisp,v
retrieving revision 1.74
retrieving revision 1.75
diff -u -d -r1.74 -r1.75
--- early-extensions.lisp 19 May 2005 02:50:39 -0000 1.74
+++ early-extensions.lisp 26 May 2005 22:53:59 -0000 1.75
@@ -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))))
Index: reader.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/reader.lisp,v
retrieving revision 1.43
retrieving revision 1.44
diff -u -d -r1.43 -r1.44
--- reader.lisp 1 May 2005 09:12:53 -0000 1.43
+++ reader.lisp 26 May 2005 22:53:59 -0000 1.44
@@ -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)
Index: sharpm.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/sharpm.lisp,v
retrieving revision 1.15
retrieving revision 1.16
diff -u -d -r1.15 -r1.16
--- sharpm.lisp 29 Apr 2005 14:37:37 -0000 1.15
+++ sharpm.lisp 26 May 2005 22:53:59 -0000 1.16
@@ -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)
|