0.6.12.43:
authorWilliam Harold Newman <william.newman@airmail.net>
Sat, 30 Jun 2001 21:47:55 +0000 (21:47 +0000)
committerWilliam Harold Newman <william.newman@airmail.net>
Sat, 30 Jun 2001 21:47:55 +0000 (21:47 +0000)
made PEEK-CHAR check its argument type explicitly, so
it will issue a TYPE-ERROR on e.g.
(WITH-INPUT-FROM-STRING (S "SZ[19]")
    (PEEK-CHAR S))
instead doing PEEK-CHAR on *STANDARD-INPUT*
fixed completely-broken bignum-sized-consing code path in
profile.lisp (Code coverage testing? What's that?:-)
merged MNA/CMUCL compiler bug collection (sbcl-devel
2001-06-25) to BUGS

BUGS
src/code/profile.lisp
src/code/stream.lisp
version.lisp-expr

diff --git a/BUGS b/BUGS
index 2076479..cf652e8 100644 (file)
--- a/BUGS
+++ b/BUGS
@@ -556,7 +556,7 @@ Error in function C::GET-LAMBDA-TO-COMPILE:
   rightward of the correct location.
 
 65:
-  (probably related to bug #70)
+  (probably related to bug #70; maybe related to bug #109)
   As reported by Carl Witty on submit@bugs.debian.org 1999-05-08,
   compiling this file
 (in-package "CL-USER")
@@ -653,7 +653,7 @@ Error in function C::GET-LAMBDA-TO-COMPILE:
   or at least issue a warning.
 
 70:
-  (probably related to bug #65)
+  (probably related to bug #65; maybe related to bug #109)
   The compiler doesn't like &OPTIONAL arguments in LABELS and FLET
   forms. E.g.
     (DEFUN FIND-BEFORE (ITEM SEQUENCE &KEY (TEST #'EQL))
@@ -963,6 +963,131 @@ Error in function C::GET-LAMBDA-TO-COMPILE:
   time trying to GC afterwards. Surely there's some more economical
   way to implement (ROOM T).
 
+109:
+  reported by Martin Atzmueller 2001-06-25; originally from CMU CL bugs
+  collection:
+    ;;; This file fails to compile.
+    ;;; Maybe this bug is related to bugs #65, #70 in the BUGS file.
+    (in-package :cl-user)
+    (defun tst2 ()
+      (labels 
+          ((eff (&key trouble)
+             (eff)
+             ;; nil
+             ;; Uncomment and it works
+             ))
+        (eff)))
+  In SBCL 0.6.12.42, the problem is
+    internal error, failed AVER:
+      "(COMMON-LISP:EQ (SB!C::LAMBDA-TAIL-SET SB!C::CALLER)
+                  (SB!C::LAMBDA-TAIL-SET (SB!C::LAMBDA-HOME SB!C::CALLEE)))"
+
+110:
+  reported by Martin Atzmueller 2001-06-25; originally from CMU CL bugs
+  collection:
+    ;;; The compiler is flushing the argument type test, and the default
+    ;;; case in the cond, so that calling with say a fixnum 0 causes a
+    ;;; SIGBUS.
+    (declaim (optimize (safety 2) (speed 3)))
+    (defun tst (x)
+      (declare (type (or string stream) x))
+      (cond ((typep x 'string) 'string)
+            ((typep x 'stream) 'stream)
+            (t
+             'none)))
+  The symptom in sbcl-0.6.12.42 on OpenBSD is actually (TST 0)=>STREAM
+  (not the SIGBUS reported in the comment) but that's broken too; 
+  type declarations are supposed to be treated as assertions unless
+  SAFETY 0, so we should be getting a TYPE-ERROR.
+
+111:
+  reported by Martin Atzmueller 2001-06-25; originally from CMU CL bugs
+  collection:
+    (in-package :cl-user)
+    ;;; Produces an assertion failures when compiled.
+    (defun foo (z)
+      (declare (type (or (function (t) t) null) z))
+      (let ((z (or z #'identity)))
+        (declare (type (function (t) t) z))
+        (funcall z 1)))
+  The error in sbcl-0.6.12.42 is
+    internal error, failed AVER:
+      "(COMMON-LISP:NOT (COMMON-LISP:EQ SB!C::CHECK COMMON-LISP:T))"
+
+112:
+  reported by Martin Atzmueller 2001-06-25; taken from CMU CL bugs
+  collection; apparently originally reported by Bruno Haible
+    (in-package :cl-user)
+    ;;; From: Bruno Haible
+    ;;; Subject: scope of SPECIAL declarations
+    ;;; It seems CMUCL has a bug relating to the scope of SPECIAL
+    ;;; declarations.  I observe this with "CMU Common Lisp 18a x86-linux
+    ;;; 1.4.0 cvs".
+    (let ((x 0))
+      (declare (special x))
+      (let ((x 1))
+        (let ((y x))
+          (declare (special x)) y)))
+    ;;; Gives: 0 (this should return 1 according to CLHS)
+    (let ((x 0))
+      (declare (special x))
+      (let ((x 1))
+        (let ((y x) (x 5))
+          (declare (special x)) y)))
+    ;;; Gives: 1 (correct).
+  The reported results match what we get from the interpreter
+  in sbcl-0.6.12.42.
+
+113:
+  reported by Martin Atzmueller 2001-06-25; originally from CMU CL bugs
+  collection:
+    (in-package :cl-user)
+    ;;; From: David Gadbois <gadbois@cyc.com>
+    ;;;
+    ;;; Logical pathnames aren't externalizable.
+    ;;; Test case:
+    (let ((tempfile "/tmp/test.lisp"))
+      (setf (logical-pathname-translations "XXX")
+            '(("XXX:**;*.*" "/tmp/**/*.*")))
+      (with-open-file (out tempfile :direction :output)
+        (write-string "(defvar *path* #P\"XXX:XXX;FOO.LISP\")" out))
+      (compile-file tempfile))
+  The error message in sbcl-0.6.12.42 is
+    ; caught ERROR:
+    ;   (while making load form for #<SB-IMPL::LOGICAL-HOST "XXX">)
+    ; A logical host can't be dumped as a constant: #<SB-IMPL::LOGICAL-HOST "XXX">
+
+114:
+  reported by Martin Atzmueller 2001-06-25; originally from CMU CL bugs
+  collection:
+    (in-package :cl-user)
+    ;;; This file causes the byte compiler to fail.
+    (declaim (optimize (speed 0) (safety 1)))
+    (defun tst1 ()
+      (values
+        (multiple-value-list
+         (catch 'a
+          (return-from tst1)))))
+  The error message in sbcl-0.6.12.42 is
+    internal error, failed AVER:
+      "(COMMON-LISP:EQUAL (SB!C::BYTE-BLOCK-INFO-START-STACK SB!INT:INFO) SB!C::STACK)"
+
+115:
+  reported by Martin Atzmueller 2001-06-25; originally from CMU CL bugs
+  collection:
+    (in-package :cl-user)
+    ;;; The following invokes a compiler error.
+    (declaim (optimize (speed 2) (debug 3)))
+    (defun tst ()
+      (flet ((m1 ()
+               (unwind-protect nil)))
+        (if (catch nil)
+          (m1)
+          (m1))))
+  The error message in sbcl-0.6.12.42 is
+    internal error, failed AVER:
+      "(COMMON-LISP:EQ (SB!C::TN-ENVIRONMENT SB!C:TN) SB!C::TN-ENV)"
+
 KNOWN BUGS RELATED TO THE IR1 INTERPRETER
 
 (Note: At some point, the pure interpreter (actually a semi-pure
index c156fdd..a381821 100644 (file)
                    (*enclosed-profiles* 0)
                    (nbf-pcounter *n-bytes-freed-or-purified-pcounter*)
                    ;; Typically NBF-PCOUNTER will represent a bignum.
-                   ;; In general we don't want to cons up a new bignum for every
-                   ;; encapsulated call, so instead we keep track of
-                   ;; the PCOUNTER internals, so that as long as we
-                   ;; only cons small amounts, we'll almost always
-                   ;; just do fixnum arithmetic. (And for encapsulated
-                   ;; functions which cons large amounts, then we don't
-                   ;; much care about a single extra consed bignum.)
+                   ;; In general we don't want to cons up a new
+                   ;; bignum for every encapsulated call, so instead
+                   ;; we keep track of the PCOUNTER internals, so
+                   ;; that as long as we only cons small amounts,
+                   ;; we'll almost always just do fixnum arithmetic.
+                   ;; (And for encapsulated functions which cons
+                   ;; large amounts, then we don't much care about a
+                   ;; single extra consed bignum.)
                    (start-consing-integer (pcounter-integer nbf-pcounter))
                    (start-consing-fixnum (pcounter-fixnum nbf-pcounter)))
               (declare (inline pcounter-or-fixnum->integer))
                             (- (pcounter-fixnum nbf-pcounter)
                                start-consing-fixnum)
                             (- (get-bytes-consed)
-                               (+ pcounter-integer pcounter-fixnum))))
+                               (+ (pcounter-integer nbf-pcounter)
+                                  (pcounter-fixnum nbf-pcounter)))))
                   (setf inner-enclosed-profiles
                         (pcounter-or-fixnum->integer *enclosed-profiles*))
                   (let ((net-dticks (fastbig- dticks *enclosed-ticks*)))
index 5828180..e9af49c 100644 (file)
        (let ((index (1- (lisp-stream-in-index stream)))
              (buffer (lisp-stream-in-buffer stream)))
          (declare (fixnum index))
-         (when (minusp index) (error "Nothing to unread."))
+         (when (minusp index) (error "nothing to unread"))
          (cond (buffer
                 (setf (aref buffer index) (char-code character))
                 (setf (lisp-stream-in-index stream) index))
 (defun peek-char (&optional (peek-type nil)
                            (stream *standard-input*)
                            (eof-error-p t)
-                           eof-value recursive-p)
+                           eof-value
+                           recursive-p)
   (declare (ignore recursive-p))
+  ;; FIXME: The type of PEEK-TYPE is also declared in a DEFKNOWN, but
+  ;; the compiler doesn't seem to be smart enough to go from there to
+  ;; imposing a type check. Figure out why (because PEEK-TYPE is an
+  ;; &OPTIONAL argument?) and fix it, and then this explicit type
+  ;; check can go away.
+  (unless (typep peek-type '(or character boolean))
+    (error 'simple-type-error
+          :datum peek-type
+          :expected-type '(or character boolean)
+          :format-control "~@<bad PEEK-TYPE=~S, ~_expected ~S~:>"
+          :format-arguments (list peek-type '(or character boolean))))
   (let ((stream (in-synonym-of stream)))
     (if (lisp-stream-p stream)
        (let ((char (read-char stream eof-error-p eof-value)))
                      (unless (eq char eof-value)
                        (unread-char char stream))
                      char)))
-               (t
+               ((null peek-type)
                 (unread-char char stream)
-                char)))
-       ;; must be Gray streams FUNDAMENTAL-STREAM
+                char)
+               (t
+                (error "internal error: impossible case"))))
+       ;; by elimination, must be Gray streams FUNDAMENTAL-STREAM
        (cond ((characterp peek-type)
-              (do ((char (stream-read-char stream) (stream-read-char stream)))
+              (do ((char (stream-read-char stream)
+                         (stream-read-char stream)))
                   ((or (eq char :eof) (char= char peek-type))
                    (cond ((eq char :eof)
                           (eof-or-lose stream eof-error-p eof-value))
                           (stream-unread-char stream char)
                           char)))))
              ((eq peek-type t)
-              (do ((char (stream-read-char stream) (stream-read-char stream)))
+              (do ((char (stream-read-char stream)
+                         (stream-read-char stream)))
                   ((or (eq char :eof) (not (whitespace-char-p char)))
                    (cond ((eq char :eof)
                           (eof-or-lose stream eof-error-p eof-value))
                          (t
                           (stream-unread-char stream char)
                           char)))))
-             (t
+             ((null peek-type)
               (let ((char (stream-peek-char stream)))
                 (if (eq char :eof)
                     (eof-or-lose stream eof-error-p eof-value)
-                    char)))))))
+                    char)))
+             (t
+              (error "internal error: impossible case"))))))
 
 (defun listen (&optional (stream *standard-input*))
   (let ((stream (in-synonym-of stream)))
index 340d216..cd6e51e 100644 (file)
@@ -16,4 +16,4 @@
 ;;; four numeric fields, is used for versions which aren't released
 ;;; but correspond only to CVS tags or snapshots.
 
-"0.6.12.42"
+"0.6.12.43"