From e37366e7bb72bc80c6c9908efe09f94ce26add16 Mon Sep 17 00:00:00 2001 From: William Harold Newman Date: Sat, 16 Jun 2001 13:18:13 +0000 Subject: [PATCH] 0.6.12.35: null-*PRINT-LENGTH* bugfix in structure printing (from Alexey Dejneka sbcl-devel 2001-06-14) merged Eric Marsden ANSI compliance fixes (from cmucl-imp 2001-06-15); except that I skipped the ones in eval-comp.lisp because I hope to get rid of the IR1 interpreter completely sometime in the next few months, and I skipped COMPILER-ERROR-is-PROGRAM-ERROR because (1) I think not all compiler errors are program errors (e.g. type errors or i/o errors) and (2) SBCL mostly handles COMPILER-ERRORs before the user sees them anyway, so I couldn't think of a test case where this matters --- BUGS | 11 +++++++++++ src/code/fd-stream.lisp | 10 ++++++++++ src/code/float.lisp | 10 +++++++--- src/code/target-defstruct.lisp | 1 + src/code/target-format.lisp | 13 +++++++++---- tests/filesys.pure.lisp | 8 ++++++++ tests/float.pure.lisp | 8 ++++++++ tests/print.impure.lisp | 6 ++++++ version.lisp-expr | 2 +- 9 files changed, 61 insertions(+), 8 deletions(-) diff --git a/BUGS b/BUGS index efc6e60..67862a1 100644 --- a/BUGS +++ b/BUGS @@ -971,6 +971,17 @@ Error in function C::GET-LAMBDA-TO-COMPILE: 105: (DESCRIBE 'STREAM-READ-BYTE) +106: + (reported by Eric Marsden on cmucl-imp 2001-06-15) + Executing + (TYPEP 0 '(COMPLEX (EQL 0))) + signals an error in sbcl-0.6.12.34, + The component type for COMPLEX is not numeric: (EQL 0) + This is funny since sbcl-0.6.12.34 knows + (SUBTYPEP '(EQL 0) 'NUMBER) => T + + + KNOWN BUGS RELATED TO THE IR1 INTERPRETER (Note: At some point, the pure interpreter (actually a semi-pure diff --git a/src/code/fd-stream.lisp b/src/code/fd-stream.lisp index 9c835c1..4b6f09d 100644 --- a/src/code/fd-stream.lisp +++ b/src/code/fd-stream.lisp @@ -853,6 +853,16 @@ (:charpos (fd-stream-char-pos fd-stream)) (:file-length + (unless (fd-stream-file fd-stream) + ;; This is a TYPE-ERROR because ANSI's species FILE-LENGTH + ;; "should signal an error of type TYPE-ERROR if stream is not + ;; a stream associated with a file". Too bad there's no very + ;; appropriate value for the EXPECTED-TYPE slot.. + (error 'simple-type-error + :datum fd-stream + :expected-type 'file-stream + :format-control "~S is not a stream associated with a file." + :format-arguments (list fd-stream))) (multiple-value-bind (okay dev ino mode nlink uid gid rdev size atime mtime ctime blksize blocks) (sb!unix:unix-fstat (fd-stream-fd fd-stream)) diff --git a/src/code/float.lisp b/src/code/float.lisp index 6e71f91..2d0650f 100644 --- a/src/code/float.lisp +++ b/src/code/float.lisp @@ -308,9 +308,13 @@ (defun float-radix (x) #!+sb-doc - "Returns (as an integer) the radix b of its floating-point - argument." - (declare (type float x) (ignore x)) + "Return (as an integer) the radix b of its floating-point argument." + (declare (type float x)) + ;; ANSI says this function "should signal an error if [..] argument + ;; is not a float". Since X is otherwise ignored, Python doesn't + ;; check the type by default, so we have to do it ourself: + (unless (floatp x) + (error 'type-error :datum x :expected-type 'float)) 2) ;;;; INTEGER-DECODE-FLOAT and DECODE-FLOAT diff --git a/src/code/target-defstruct.lisp b/src/code/target-defstruct.lisp index 8942ffc..91a361b 100644 --- a/src/code/target-defstruct.lisp +++ b/src/code/target-defstruct.lisp @@ -211,6 +211,7 @@ (slots (dd-slots dd) (cdr slots))) ((or (null slots) (and (not *print-readably*) + *print-length* (>= index *print-length*))) (if (null slots) (write-string ")" stream) diff --git a/src/code/target-format.lisp b/src/code/target-format.lisp index 13c3480..3e62ac0 100644 --- a/src/code/target-format.lisp +++ b/src/code/target-format.lisp @@ -167,10 +167,15 @@ (write-string string stream)) (dotimes (i minpad) (write-char padchar stream)) - (do ((chars (+ (length string) minpad) (+ chars colinc))) - ((>= chars mincol)) - (dotimes (i colinc) - (write-char padchar stream))) + ;; As of sbcl-0.6.12.34, we could end up here when someone tries to + ;; print e.g. (FORMAT T "~F" "NOTFLOAT"), in which case ANSI says + ;; we're supposed to soldier on bravely, and so we have to deal with + ;; the unsupplied-MINCOL-and-COLINC case without blowing up. + (when (and mincol colinc) + (do ((chars (+ (length string) minpad) (+ chars colinc))) + ((>= chars mincol)) + (dotimes (i colinc) + (write-char padchar stream)))) (when padleft (write-string string stream))) diff --git a/tests/filesys.pure.lisp b/tests/filesys.pure.lisp index 0356cd5..2ff7dbb 100644 --- a/tests/filesys.pure.lisp +++ b/tests/filesys.pure.lisp @@ -35,3 +35,11 @@ (search "tests/filesys.pure.lisp" (namestring pathname))) dir))) + +;;; ANSI: FILE-LENGTH should signal an error of type TYPE-ERROR if +;;; stream is not a stream associated with a file. +;;; +;;; (Peter Van Eynde's ansi-test suite caught this, and Eric Marsden +;;; reported a fix for CMU CL, which was ported to sbcl-0.6.12.35.) +(assert (subtypep (nth-value 1 (ignore-errors (file-length *terminal-io*))) + 'type-error)) diff --git a/tests/float.pure.lisp b/tests/float.pure.lisp index f4382e3..30ea87e 100644 --- a/tests/float.pure.lisp +++ b/tests/float.pure.lisp @@ -40,3 +40,11 @@ (assert (>= 100 -ifni)) (assert (not (<= 6/7 (* 3 -ifni)))) (assert (not (> +ifni +ifni))))) + +;;; ANSI: FILE-LENGTH should signal an error of type TYPE-ERROR if +;;; stream is not a stream associated with a file. +;;; +;;; (Peter Van Eynde's ansi-test suite caught this, and Eric Marsden +;;; reported a fix for CMU CL, which was ported to sbcl-0.6.12.35.) +(assert (subtypep (nth-value 1 (ignore-errors (float-radix "notfloat"))) + 'type-error)) \ No newline at end of file diff --git a/tests/print.impure.lisp b/tests/print.impure.lisp index e3a19e0..9935402 100644 --- a/tests/print.impure.lisp +++ b/tests/print.impure.lisp @@ -26,5 +26,11 @@ long-float-positive-infinity long-float-negative-infinity)) (assert-output x)) +;;; Eric Marsden reported that this would blow up in CMU CL (even +;;; though ANSI says that the mismatch between ~F expected type and +;;; provided string type is supposed to be handled without signalling +;;; an error) and provided a fix which was ported to sbcl-0.6.12.35. +(assert (null (format t "~F" "foo"))) + ;;; success (quit :unix-status 104) diff --git a/version.lisp-expr b/version.lisp-expr index 7a3b4dd..af32a2f 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -15,4 +15,4 @@ ;;; versions, and a string like "0.6.5.12" is used for versions which ;;; aren't released but correspond only to CVS tags or snapshots. -"0.6.12.34" +"0.6.12.35" -- 1.7.10.4