X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=BUGS;h=ab130b0bd146788004f5df0eb553d545a7c50340;hb=efb7317381c54e1a28f6c1c179a4fb8d58fdc7eb;hp=369b3f7dd1a4b214cfa95155a992500178f72ed8;hpb=627c66211b93537e90c08b34b387edbd7e301011;p=sbcl.git diff --git a/BUGS b/BUGS index 369b3f7..ab130b0 100644 --- a/BUGS +++ b/BUGS @@ -42,7 +42,8 @@ KNOWN BUGS OF NO SPECIAL CLASS: program, even if you know or guess enough about the internals of SBCL to wager that this (undefined in ANSI) operation would be safe. -3: +3: "type checking of structure slots" + a: ANSI specifies that a type mismatch in a structure slot initialization value should not cause a warning. WORKAROUND: @@ -78,19 +79,29 @@ WORKAROUND: Such code should compile without complaint and work correctly either on SBCL or on any other completely compliant Common Lisp system. -6: - bogus warnings about undefined functions for magic functions like - SB!C::%%DEFUN and SB!C::%DEFCONSTANT when cross-compiling files - like src/code/float.lisp. Fixing this will probably require - straightening out enough bootstrap consistency issues that - the cross-compiler can run with *TYPE-SYSTEM-INITIALIZED*. - Instead, the cross-compiler runs in a slightly flaky state - which is sane enough to compile SBCL itself, but which is - also unstable in several ways, including its inability - to really grok function declarations. - - As of sbcl-0.7.5, sbcl's cross-compiler does run with - *TYPE-SYSTEM-INITIALIZED*; however, this bug remains. + b: &AUX argument in a boa-constructor without a default value means + "do not initilize this slot" and does not cause type error. But + an error may be signalled at read time and it would be good if + SBCL did it. + + c: Reading of not initialized slot sometimes causes SEGV (for inline + accessors it is fixed, but out-of-line still do not perform type + check). + + d: + (declaim (optimize (safety 3) (speed 1) (space 1))) + (defstruct foo + x y) + (defstruct (stringwise-foo (:include foo + (x "x" :type simple-string) + (y "y" :type simple-string)))) + (defparameter *stringwise-foo* + (make-stringwise-foo)) + (setf (foo-x *stringwise-foo*) 0) + (defun frob-stringwise-foo (sf) + (aref (stringwise-foo-x sf) 0)) + (frob-stringwise-foo *stringwise-foo*) + SEGV. 7: The "compiling top-level form:" output ought to be condensed. @@ -135,16 +146,6 @@ WORKAROUND: (FORMAT NIL "~,1G" 1.4) => "1. " (FORMAT NIL "~3,1G" 1.4) => "1. " -20: - from Marco Antoniotti on cmucl-imp mailing list 1 Mar 2000: - (defclass ccc () ()) - (setf (find-class 'ccc1) (find-class 'ccc)) - (defmethod zut ((c ccc1)) 123) - In sbcl-0.7.1.13, this gives an error, - There is no class named CCC1. - DTC's recommended workaround from the mailing list 3 Mar 2000: - (setf (pcl::find-class 'ccc1) (pcl::find-class 'ccc)) - 27: Sometimes (SB-EXT:QUIT) fails with Argh! maximum interrupt nesting depth (4096) exceeded, exiting @@ -229,8 +230,8 @@ WORKAROUND: 45: a slew of floating-point-related errors reported by Peter Van Eynde on July 25, 2000: - b: SBCL's value for LEAST-POSITIVE-SHORT-FLOAT is bogus, and - should probably be 1.4012985e-45. In SBCL, + b: SBCL's value for LEAST-POSITIVE-SHORT-FLOAT on the x86 is + bogus, and should probably be 1.4012985e-45. In SBCL, (/ LEAST-POSITIVE-SHORT-FLOAT 2) returns a number smaller than LEAST-POSITIVE-SHORT-FLOAT. Similar problems exist for LEAST-NEGATIVE-SHORT-FLOAT, LEAST-POSITIVE-LONG-FLOAT, @@ -255,50 +256,10 @@ WORKAROUND: type safety errors reported by Peter Van Eynde July 25, 2000: c: (COERCE 'AND 'FUNCTION) returns something related to (MACRO-FUNCTION 'AND), but ANSI says it should raise an error. - h: (MAKE-CONCATENATED-STREAM (MAKE-STRING-OUTPUT-STREAM)) - should signal TYPE-ERROR. - i: MAKE-TWO-WAY-STREAM doesn't check that its arguments can - be used for input and output as needed. It should fail with - TYPE-ERROR when handed e.g. the results of - MAKE-STRING-INPUT-STREAM or MAKE-STRING-OUTPUT-STREAM in - the inappropriate positions, but doesn't. k: READ-BYTE is supposed to signal TYPE-ERROR when its argument is not a binary input stream, but instead cheerfully reads from character streams, e.g. (MAKE-STRING-INPUT-STREAM "abc"). -47: - DEFCLASS bugs reported by Peter Van Eynde July 25, 2000: - d: (DEFGENERIC IF (X)) should signal a PROGRAM-ERROR, but instead - causes a COMPILER-ERROR. - -48: - SYMBOL-MACROLET bugs reported by Peter Van Eynde July 25, 2000: - c: SYMBOL-MACROLET should signal PROGRAM-ERROR if something - it binds is declared SPECIAL inside. - -51: - miscellaneous errors reported by Peter Van Eynde July 25, 2000: - a: (PROGN - (DEFGENERIC FOO02 (X)) - (DEFMETHOD FOO02 ((X NUMBER)) T) - (LET ((M (FIND-METHOD (FUNCTION FOO02) - NIL - (LIST (FIND-CLASS (QUOTE NUMBER)))))) - (REMOVE-METHOD (FUNCTION FOO02) M) - (DEFGENERIC FOO03 (X)) - (ADD-METHOD (FUNCTION FOO03) M))) - should give an error, but SBCL allows it. - -52: - It has been reported (e.g. by Peter Van Eynde) that there are - several metaobject protocol "errors". (In order to fix them, we might - need to document exactly what metaobject protocol specification - we're following -- the current code is just inherited from PCL.) - -54: - The implementation of #'+ returns its single argument without - type checking, e.g. (+ "illegal") => "illegal". - 60: The debugger LIST-LOCATIONS command doesn't work properly. @@ -309,40 +270,6 @@ WORKAROUND: then requesting a BACKTRACE at the debugger prompt gives no information about where in the user program the problem occurred. -62: - The compiler is supposed to do type inference well enough that - the declaration in - (TYPECASE X - ((SIMPLE-ARRAY SINGLE-FLOAT) - (LOCALLY - (DECLARE (TYPE (SIMPLE-ARRAY SINGLE-FLOAT) X)) - ..)) - ..) - is redundant. However, as reported by Juan Jose Garcia Ripoll for - CMU CL, it sometimes doesn't. Adding declarations is a pretty good - workaround for the problem for now, but can't be done by the TYPECASE - macros themselves, since it's too hard for the macro to detect - assignments to the variable within the clause. - Note: The compiler *is* smart enough to do the type inference in - many cases. This case, derived from a couple of MACROEXPAND-1 - calls on Ripoll's original test case, - (DEFUN NEGMAT (A) - (DECLARE (OPTIMIZE SPEED (SAFETY 0))) - (COND ((TYPEP A '(SIMPLE-ARRAY SINGLE-FLOAT)) NIL - (LET ((LENGTH (ARRAY-TOTAL-SIZE A))) - (LET ((I 0) (G2554 LENGTH)) - (DECLARE (TYPE REAL G2554) (TYPE REAL I)) - (TAGBODY - SB-LOOP::NEXT-LOOP - (WHEN (>= I G2554) (GO SB-LOOP::END-LOOP)) - (SETF (ROW-MAJOR-AREF A I) (- (ROW-MAJOR-AREF A I))) - (GO SB-LOOP::NEXT-LOOP) - SB-LOOP::END-LOOP)))))) - demonstrates the problem; but the problem goes away if the TAGBODY - and GO forms are removed (leaving the SETF in ordinary, non-looping - code), or if the TAGBODY and GO forms are retained, but the - assigned value becomes 0.0 instead of (- (ROW-MAJOR-AREF A I)). - 63: Paul Werkowski wrote on cmucl-imp@cons.org 2000-11-15 I am looking into this problem that showed up on the cmucl-help @@ -368,9 +295,6 @@ WORKAROUND: crashes SBCL. In general tracing anything which is used in the implementation of TRACE is likely to have the same problem. -72: - (DECLAIM (OPTIMIZE ..)) doesn't work properly inside LOCALLY forms. - 75: As reported by Martin Atzmueller on sbcl-devel 26 Dec 2000, ANSI says that WITH-OUTPUT-TO-STRING should have a keyword @@ -397,17 +321,8 @@ WORKAROUND: LOAD-FOREIGN, and (2) hunt for any other code which uses temporary files and make it share the same new safe logic. -82: - Functions are assigned names based on the context in which they're - defined. This is less than ideal for the functions which are - used to implement CLOS methods. E.g. the output of - (DESCRIBE 'PRINT-OBJECT) lists functions like - # - and - # - It would be better if these functions' names always identified - them as methods, and identified their generic functions and - specializers. + (partially alleviated in sbcl-0.7.9.32 by a fix by Matthew Danish to + make the temporary filename less easily guessable) 83: RANDOM-INTEGER-EXTRA-BITS=10 may not be large enough for the RANDOM @@ -429,6 +344,10 @@ WORKAROUND: (I haven't tried to investigate this bug enough to guess whether there might be any user-level symptoms.) + In fact, the type system is likely to depend on this inequality not + holding... * is not equivalent to T in many cases, such as + (VECTOR *) /= (VECTOR T). + 94a: Inconsistencies between derived and declared VALUES return types for DEFUN aren't checked very well. E.g. the logic which successfully @@ -507,18 +426,6 @@ WORKAROUND: the first time around, until regression tests are written I'm not comfortable merging the patches in the CVS version of SBCL. -104: - (DESCRIBE 'SB-ALIEN:DEF-ALIEN-TYPE) reports the macro argument list - incorrectly: - DEF-ALIEN-TYPE is - an external symbol - in #. - Macro-function: # - Macro arguments: (#:whole-470 #:environment-471) - On Sat, May 26, 2001 09:45:57 AM CDT it was compiled from: - /usr/stuff/sbcl/src/code/host-alieneval.lisp - Created: Monday, March 12, 2001 07:47:43 AM CST - 108: (TIME (ROOM T)) reports more than 200 Mbytes consed even for a clean, just-started SBCL system. And it seems to be right: @@ -526,22 +433,6 @@ WORKAROUND: time trying to GC afterwards. Surely there's some more economical way to implement (ROOM T). -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)" - 117: When the compiler inline expands functions, it may be that different kinds of return values are generated from different code branches. @@ -592,34 +483,14 @@ WORKAROUND: is attached to FOO in 120a above, and used to optimize code which calls FOO. -122: - There was some sort of screwup in handling of - (IF (NOT (IGNORE-ERRORS ..))). E.g. - (defun foo1i () - (if (not (ignore-errors - (make-pathname :host "foo" - :directory "!bla" - :name "bar"))) - (print "ok") - (error "notunlessnot"))) - The (NOT (IGNORE-ERRORS ..)) form evaluates to T, so this should be - printing "ok", but instead it's going to the ERROR. This problem - seems to've been introduced by MNA's HANDLER-CASE patch (sbcl-devel - 2001-07-17) and as a workaround (put in sbcl-0.pre7.14.flaky4.12) - I reverted back to the old weird HANDLER-CASE code. However, I - think the problem looks like a compiler bug in handling RETURN-FROM, - so I left the MNA-patched code in HANDLER-CASE (suppressed with - #+NIL) and I'd like to go back to see whether this really is - a compiler bug before I delete this BUGS entry. - 124: As of version 0.pre7.14, SBCL's implementation of MACROLET makes the entire lexical environment at the point of MACROLET available - in the bodies of the macroexpander functions. In particular, it - allows the function bodies (which run at compile time) to try to + in the bodies of the macroexpander functions. In particular, it + allows the function bodies (which run at compile time) to try to access lexical variables (which are only defined at runtime). It doesn't even issue a warning, which is bad. - + The SBCL behavior arguably conforms to the ANSI spec (since the spec says that the behavior is undefined, ergo anything conforms). However, it would be better to issue a compile-time error. @@ -635,7 +506,7 @@ WORKAROUND: the local macro definitions in a MACROLET, but the consequences are undefined if the local macro definitions reference any local variable or function bindings that are visible in that - lexical environment. + lexical environment. Then it seems to contradict itself by giving the example (defun foo (x flag) (macrolet ((fudge (z) @@ -652,6 +523,12 @@ WORKAROUND: but actual specification quoted above says that the actual behavior is undefined. + (Since 0.7.8.23 macroexpanders are defined in a restricted version + of the lexical environment, containing no lexical variables and + functions, which seems to conform to ANSI and CLtL2, but signalling + a STYLE-WARNING for references to variables similar to locals might + be a good thing.) + 125: (as reported by Gabe Garza on cmucl-help 2001-09-21) (defvar *tmp* 3) @@ -670,75 +547,26 @@ WORKAROUND: Evidently Python thinks of the lambda as a code transformation so much that it forgets that it's also an object. -127: - The DEFSTRUCT section of the ANSI spec, in the :CONC-NAME section, - specifies a precedence rule for name collisions between slot accessors of - structure classes related by inheritance. As of 0.7.0, SBCL still - doesn't follow it. - -129: - insufficient syntax checking in MACROLET: - (defun foo (x) - (macrolet ((defmacro bar (z) `(+ z z))) - (bar x))) - shouldn't compile without error (because of the extra DEFMACRO symbol). - 135: Ideally, uninterning a symbol would allow it, and its associated - FDEFINITION and PROCLAIM data, to be reclaimed by the GC. However, + FDEFINITION and PROCLAIM data, to be reclaimed by the GC. However, at least as of sbcl-0.7.0, this isn't the case. Information about FDEFINITIONs and PROCLAIMed properties is stored in globaldb.lisp essentially in ordinary (non-weak) hash tables keyed by symbols. Thus, once a system has an entry in this system, it tends to live forever, even when it is uninterned and all other references to it - are lost. - -136: - (reported by Arnaud Rouanet on cmucl-imp 2001-12-18) - (defmethod foo ((x integer)) - x) - (defmethod foo :around ((x integer)) - (let ((x (1+ x))) - (call-next-method))) - Now (FOO 3) should return 3, but instead it returns 4. - -140: - (reported by Alexey Dejneka sbcl-devel 2002-01-03) - - SUBTYPEP does not work well with redefined classes: - --- - * (defclass a () ()) - # - * (defclass b () ()) - # - * (subtypep 'b 'a) - NIL - T - * (defclass b (a) ()) - # - * (subtypep 'b 'a) - T - T - * (defclass b () ()) - # - - ;;; And now... - * (subtypep 'b 'a) - T - T - - This bug was fixed in sbcl-0.7.4.1 by invalidating the PCL wrapper - class upon redefinition. Unfortunately, doing so causes bug #176 to - appear. Pending further investigation, one or other of these bugs - might be present at any given time. - -141: - Pretty-printing nested backquotes doesn't work right, as - reported by Alexey Dejneka sbcl-devel 2002-01-13: - * '``(FOO ,@',@S) - ``(FOO SB-IMPL::BACKQ-COMMA-AT S) - * (lisp-implementation-version) - "0.pre7.129" + are lost. + +141: "pretty printing and backquote" + a. + * '``(FOO ,@',@S) + ``(FOO SB-IMPL::BACKQ-COMMA-AT S) + + b. + * (write '`(, .ala.) :readably t :pretty t) + `(,.ALA.) + + (note the space between the comma and the point) 143: (reported by Jesse Bouwman 2001-10-24 through the unfortunately @@ -821,13 +649,17 @@ WORKAROUND: debugger invoked on condition of type TYPE-ERROR: The value NIL is not of type SB-C::NODE. The location of this failure has moved around as various related - issues were cleaned up. As of sbcl-0.7.1.9, it occurs in + issues were cleaned up. As of sbcl-0.7.1.9, it occurs in NODE-BLOCK called by LAMBDA-COMPONENT called by IR2-CONVERT-CLOSURE. -157: - Functions SUBTYPEP, TYPEP, UPGRADED-ARRAY-ELEMENT-TYPE, and - UPGRADED-COMPLEX-PART-TYPE should have an optional environment argument. - (reported by Alexey Dejneka sbcl-devel 2002-04-12) + (Python LET-converts KIDIFY1 into KID-FROB, then tries to inline + expand KID-FROB into %ZEEP. Having partially done it, it sees a call + of KIDIFY1, which already does not exist. So it gives up on + expansion, leaving garbage consisting of infinished blocks of the + partially converted function.) + + (due to reordering of the compiler this example is compiled + successfully by 0.7.14, but the bug probably remains) 162: (reported by Robert E. Brown 2002-04-16) @@ -849,31 +681,6 @@ WORKAROUND: isn't too surprising since there are many differences in stack implementation and GC conservatism between the X86 and other ports.) -166: - Compiling - (in-package :cl-user) - (defstruct uustk) - (defmethod permanentize ((uustk uustk)) - (flet ((frob (hash-table test-for-deletion) - ) - (obj-entry.stale? (oe) - (destructuring-bind (key . datum) oe - (declare (type simple-vector key)) - (deny0 (void? datum)) - (some #'stale? key)))) - (declare (inline frob obj-entry.stale?)) - (frob (uustk.args-hash->obj-alist uustk) - #'obj-entry.stale?) - (frob (uustk.hash->memoized-objs-list uustk) - #'objs.stale?)) - (call-next-method)) - in sbcl-0.7.3.11 causes an assertion failure, - failed AVER: - "(NOT -(AND (NULL (BLOCK-SUCC B)) - (NOT (BLOCK-DELETE-P B)) - (NOT (EQ B (COMPONENT-HEAD #)))))" - 167: In sbcl-0.7.3.11, compiling the (illegal) code (in-package :cl-user) @@ -888,14 +695,6 @@ WORKAROUND: macro is unhappy with the illegal syntax in the method body, and is giving an unclear error message. -172: - sbcl's treatment of at least macro lambda lists is too permissive; - e.g., in sbcl-0.7.3.7: - (defmacro foo (&rest rest bar) `(,bar ,rest)) - (macroexpand '(foo quux zot)) -> (QUUX (QUUX ZOT)) - whereas section 3.4.4 of the CLHS doesn't allow required parameters - to come after the rest argument. - 173: The compiler sometimes tries to constant-fold expressions before it checks to see whether they can be reached. This can lead to @@ -911,50 +710,6 @@ WORKAROUND: code. Since then the warning has been downgraded to STYLE-WARNING, so it's still a bug but at least it's a little less annoying. -176: - reported by Alexey Dejneka 08 Jun 2002 in sbcl-devel: - Playing with McCLIM, I've received an error "Unbound variable WRAPPER - in SB-PCL::CHECK-WRAPPER-VALIDITY". - (defun check-wrapper-validity (instance) - (let* ((owrapper (wrapper-of instance))) - (if (not (invalid-wrapper-p owrapper)) - owrapper - (let* ((state (wrapper-state wrapper)) ; !!! - ... - I've tried to replace it with OWRAPPER, but now OBSOLETE-INSTANCE-TRAP - breaks with "NIL is not of type SB-KERNEL:LAYOUT". - SBCL 0.7.4.13. - partial fix: The undefined variable WRAPPER resulted from an error - in recent refactoring, as can be seen by comparing to the code in e.g. - sbcl-0.7.2. Replacing WRAPPER with OWRAPPER (done by WHN in sbcl-0.7.4.22) - should bring the code back to its behavior as of sbcl-0.7.2, but - that still leaves the OBSOLETE-INSTANCE-TRAP bug. An example of - input which triggers that bug is - (dotimes (i 20) - (let ((lastname (intern (format nil "C~D" (1- i)))) - (name (intern (format nil "C~D" i)))) - (eval `(defclass ,name - (,@(if (= i 0) nil (list lastname))) - ())) - (eval `(defmethod initialize-instance :after ((x ,name) &rest any) - (declare (ignore any)))))) - (defclass b () ()) - (defclass c0 (b) ()) - (make-instance 'c19) - - See also bug #140. - -178: "AVER failure compiling confused THEs in FUNCALL" - In sbcl-0.7.4.24, compiling - (defun bug178 (x) - (funcall (the function (the standard-object x)))) - gives - failed AVER: - "(AND (EQ (IR2-CONTINUATION-PRIMITIVE-TYPE 2CONT) FUNCTION-PTYPE) (EQ CHECK T))" - This variant compiles OK, though: - (defun bug178alternative (x) - (funcall (the nil x))) - 183: "IEEE floating point issues" Even where floating point handling is being dealt with relatively well (as of sbcl-0.7.5, on sparc/sunos and alpha; see bug #146), the @@ -980,14 +735,6 @@ WORKAROUND: :ACCRUED-EXCEPTIONS (:INEXACT) :FAST-MODE NIL) -185: "top-level forms at the REPL" - * (locally (defstruct foo (a 0 :type fixnum))) - gives an error: - ; caught ERROR: - ; (in macroexpansion of (SB-KERNEL::%DELAYED-GET-COMPILER-LAYOUT BAR)) - however, compiling and loading the same expression in a file works - as expected. - 187: "type inference confusion around DEFTRANSFORM time" (reported even more verbosely on sbcl-devel 2002-06-28 as "strange bug in DEFTRANSFORM") @@ -1082,6 +829,28 @@ WORKAROUND: (INTEGER 1296 1296) ...)>)[:EXTERNAL] + In recent SBCL the following example also illustrates this bug: + + (time (compile + nil + '(lambda () + (declare (optimize (safety 3))) + (declare (optimize (compilation-speed 2))) + (declare (optimize (speed 1) (debug 1) (space 1))) + (let ((start 4)) + (declare (type (integer 0) start)) + (print (incf start 22)) + (print (incf start 26)) + (print (incf start 28))) + (let ((start 6)) + (declare (type (integer 0) start)) + (print (incf start 22)) + (print (incf start 26))) + (let ((start 10)) + (declare (type (integer 0) start)) + (print (incf start 22)) + (print (incf start 26)))))) + 190: "PPC/Linux pipe? buffer? bug" In sbcl-0.7.6, the run-program.test.sh test script sometimes hangs on the PPC/Linux platform, waiting for a zombie env process. This @@ -1110,93 +879,6 @@ WORKAROUND: c. the examples in CLHS 7.6.5.1 (regarding generic function lambda lists and &KEY arguments) do not signal errors when they should. -192: "Python treats free type declarations as promises." - b. What seemed like the same fundamental problem as bug 192a, but - was not fixed by the same (APD "more strict type checking - sbcl-devel 2002-08-97) patch: - (DOTIMES (I ...) (DOTIMES (J ...) (DECLARE ...) ...)): - (declaim (optimize (speed 1) (safety 3))) - (defun trust-assertion (i) - (dotimes (j i) - (declare (type (mod 4) i)) ; when commented out, behavior changes! - (unless (< i 5) - (print j)))) - (trust-assertion 6) ; prints nothing unless DECLARE is commented out - -193: "unhelpful CLOS error reporting when the primary method is missing" - In sbcl-0.7.7, when - (defmethod foo :before ((x t)) (print x)) - is the only method defined on FOO, the error reporting when e.g. - (foo 12) - is relatively unhelpful: - There is no primary method for the generic function - #. - with the offending argument nowhere visible in the backtrace. This - continues even if there *are* primary methods, just not for the - specified arg type, e.g. - (defmethod foo ((x character)) (print x)) - (defmethod foo ((x string)) (print x)) - (defmethod foo ((x pathname)) ...) - In that case it could be very helpful to know what argument value is - falling through the cracks of the defined primary methods, but the - error message stays the same (even BACKTRACE doesn't tell you what the - bad argument value is). - -194: "no error from (THE REAL '(1 2 3)) in some cases" - fixed parts: - a. In sbcl-0.7.7.9, - (multiple-value-prog1 (progn (the real '(1 2 3)))) - returns (1 2 3) instead of signalling an error. This was fixed by - APD's "more strict type checking patch", but although the fixed - code (in sbcl-0.7.7.19) works (signals TYPE-ERROR) interactively, - it's difficult to write a regression test for it, because - (IGNORE-ERRORS (MULTIPLE-VALUE-PROG1 (PROGN (THE REAL '(1 2 3))))) - still returns (1 2 3). - still-broken parts: - b. (IGNORE-ERRORS (MULTIPLE-VALUE-PROG1 (PROGN (THE REAL '(1 2 3))))) - returns (1 2 3). (As above, this shows up when writing regression - tests for fixed-ness of part a.) - c. Also in sbcl-0.7.7.9, (IGNORE-ERRORS (THE REAL '(1 2 3))) => (1 2 3). - d. At the REPL, - (null (ignore-errors - (let ((arg1 1) - (arg2 (identity (the real #(1 2 3))))) - (if (< arg1 arg2) arg1 arg2)))) - => T - but putting the same expression inside (DEFUN FOO () ...), - (FOO) => NIL. - notes: - * Actually this entry is probably multiple bugs, as - Alexey Dejneka commented on sbcl-devel 2002-09-03:) - I don't think that placing these two bugs in one entry is - a good idea: they have different explanations. The second - (min 1 nil) is caused by flushing of unused code--IDENTITY - can do nothing with it. So it is really bug 122. The first - (min nil) is due to M-V-PROG1: substituting a continuation - for the result, it forgets about type assertion. The purpose - of IDENTITY is to save the restricted continuation from - inaccurate transformations. - * Alexey Dejneka pointed out that - (IGNORE-ERRORS (IDENTITY (THE REAL '(1 2 3)))) - works as it should. Also - (IGNORE-ERRORS (VALUES (THE REAL '(1 2 3)))) - works as it should. Perhaps this is another case of VALUES type - intersections behaving in non-useful ways? - -199: "hairy FUNCTION types confuse the compiler" - (reported by APD sbcl-devel 2002-09-15) - (DEFUN MUR (F) - (EQ NIL (FUNCALL F))) - - (DEFUN FOO (F X) - (DECLARE (TYPE (AND FUNCTION (SATISFIES MUR)) F)) - (FUNCALL F X)) - - fails to compile, printing - failed AVER: - "(AND (EQ (IR2-CONTINUATION-PRIMITIVE-TYPE 2CONT) FUNCTION-PTYPE) (EQ CHECK T))" - - APD further reports that this bug is not present in CMUCL. 201: "Incautious type inference from compound CONS types" (reported by APD sbcl-devel 2002-09-17) @@ -1212,13 +894,334 @@ WORKAROUND: (FOO ' (1 . 2)) => "NIL IS INTEGER, Y = 1" -203: - Compiler does not check THEs on unused values, e.g. in - - (progn (the real (list 1)) t) - - This situation may appear during optimizing away degenerate cases of - certain functions: see bugs 54, 192b. +205: "environment issues in cross compiler" + (These bugs have no impact on user code, but should be fixed or + documented.) + a. Macroexpanders introduced with MACROLET are defined in the null + lexical environment. + b. The body of (EVAL-WHEN (:COMPILE-TOPLEVEL) ...) is evaluated in + the null lexical environment. + c. The cross-compiler cannot inline functions defined in a non-null + lexical environment. + +206: ":SB-FLUID feature broken" + (reported by Antonio Martinez-Shotton sbcl-devel 2002-10-07) + Enabling :SB-FLUID in the target-features list in sbcl-0.7.8 breaks + the build. + +207: "poorly distributed SXHASH results for compound data" + SBCL's SXHASH could probably try a little harder. ANSI: "the + intent is that an implementation should make a good-faith + effort to produce hash-codes that are well distributed + within the range of non-negative fixnums". But + (let ((hits (make-hash-table))) + (dotimes (i 16) + (dotimes (j 16) + (let* ((ij (cons i j)) + (newlist (push ij (gethash (sxhash ij) hits)))) + (when (cdr newlist) + (format t "~&collision: ~S~%" newlist)))))) + reports lots of collisions in sbcl-0.7.8. A stronger MIX function + would be an obvious way of fix. Maybe it would be acceptably efficient + to redo MIX using a lookup into a 256-entry s-box containing + 29-bit pseudorandom numbers? + +208: "package confusion in PCL handling of structure slot handlers" + In sbcl-0.7.8 compiling and loading + (in-package :cl) + (defstruct foo (slot (error "missing")) :type list :read-only t) + (defmethod print-object ((foo foo) stream) (print nil stream)) + causes CERROR "attempting to modify a symbol in the COMMON-LISP + package: FOO-SLOT". (This is fairly bad code, but still it's hard + to see that it should cause symbols to be interned in the CL package.) + +211: "keywords processing" + a. :ALLOW-OTHER-KEYS T should allow a function to receive an odd + number of keyword arguments. + e. Compiling + + (flet ((foo (&key y) (list y))) + (list (foo :y 1 :y 2))) + + issues confusing message + + ; in: LAMBDA NIL + ; (FOO :Y 1 :Y 2) + ; + ; caught STYLE-WARNING: + ; The variable #:G15 is defined but never used. + +212: "Sequence functions and circular arguments" + COERCE, MERGE and CONCATENATE go into an infinite loop when given + circular arguments; it would be good for the user if they could be + given an error instead (ANSI 17.1.1 allows this behaviour on the part + of the implementation, as conforming code cannot give non-proper + sequences to these functions. MAP also has this problem (and + solution), though arguably the convenience of being able to do + (MAP 'LIST '+ FOO '#1=(1 . #1#)) + might be classed as more important (though signalling an error when + all of the arguments are circular is probably desireable). + +213: "Sequence functions and type checking" + a. MAKE-SEQUENCE, COERCE, MERGE and CONCATENATE cannot deal with + various complicated, though recognizeable, CONS types [e.g. + (CONS * (CONS * NULL)) + which according to ANSI should be recognized] (and, in SAFETY 3 + code, should return a list of LENGTH 2 or signal an error) + b. MAP, when given a type argument that is SUBTYPEP LIST, does not + check that it will return a sequence of the given type. Fixing + it along the same lines as the others (cf. work done around + sbcl-0.7.8.45) is possible, but doing so efficiently didn't look + entirely straightforward. + c. All of these functions will silently accept a type of the form + (CONS INTEGER *) + whether or not the return value is of this type. This is + probably permitted by ANSI (see "Exceptional Situations" under + ANSI MAKE-SEQUENCE), but the DERIVE-TYPE mechanism does not + know about this escape clause, so code of the form + (INTEGERP (CAR (MAKE-SEQUENCE '(CONS INTEGER *) 2))) + can erroneously return T. + +214: + SBCL 0.6.12.43 fails to compile + + (locally + (declare (optimize (inhibit-warnings 0) (compilation-speed 2))) + (flet ((foo (&key (x :vx x-p)) (list x x-p))) + (foo 1 2))) + + or a more simple example: + + (locally + (declare (optimize (inhibit-warnings 0) (compilation-speed 2))) + (lambda (x) (declare (fixnum x)) (if (< x 0) 0 (1- x)))) + +215: ":TEST-NOT handling by functions" + a. FIND and POSITION currently signal errors when given non-NIL for + both their :TEST and (deprecated) :TEST-NOT arguments, but by + ANSI 17.2 "the consequences are unspecified", which by ANSI 1.4.2 + means that the effect is "unpredictable but harmless". It's not + clear what that actually means; it may preclude conforming + implementations from signalling errors. + b. COUNT, REMOVE and the like give priority to a :TEST-NOT argument + when conflict occurs. As a quality of implementation issue, it + might be preferable to treat :TEST and :TEST-NOT as being in some + sense the same &KEY, and effectively take the first test function in + the argument list. + c. Again, a quality of implementation issue: it would be good to issue a + STYLE-WARNING at compile-time for calls with :TEST-NOT, and a + WARNING for calls with both :TEST and :TEST-NOT; possibly this + latter should be WARNed about at execute-time too. + +216: "debugger confused by frames with invalid number of arguments" + In sbcl-0.7.8.51, executing e.g. (VECTOR-PUSH-EXTEND T), BACKTRACE, Q + leaves the system confused, enough so that (QUIT) no longer works. + It's as though the process of working with the uninitialized slot in + the bad VECTOR-PUSH-EXTEND frame causes GC problems, though that may + not be the actual problem. (CMU CL 18c doesn't have problems with this.) + +217: "Bad type operations with FUNCTION types" + In sbcl.0.7.7: + + * (values-type-union (specifier-type '(function (base-char))) + (specifier-type '(function (integer)))) + + # + + It causes insertion of wrong type assertions into generated + code. E.g. + + (defun foo (x s) + (let ((f (etypecase x + (character #'write-char) + (integer #'write-byte)))) + (funcall f x s) + (etypecase x + (character (write-char x s)) + (integer (write-byte x s))))) + + Then (FOO #\1 *STANDARD-OUTPUT*) signals type error. + + (In 0.7.9.1 the result type is (FUNCTION * *), so Python does not + produce invalid code, but type checking is not accurate. Similar + problems exist with VALUES-TYPE-INTERSECTION.) + +218: "VALUES type specifier semantics" + (THE (VALUES ...) ...) in safe code discards extra values. + + (defun test (x y) (the (values integer) (truncate x y))) + (test 10 4) => 2 + +220: + Sbcl 0.7.9 fails to compile + + (multiple-value-call #'list + (the integer (helper)) + nil) + + Type check for INTEGER, the result of which serves as the first + argument of M-V-C, is inserted after evaluation of NIL. So arguments + of M-V-C are pushed in the wrong order. As a temporary workaround + type checking was disabled for M-V-Cs in 0.7.9.13. A better solution + would be to put the check between evaluation of arguments, but it + could be tricky to check result types of PROG1, IF etc. + +229: + (subtypep 'function '(function)) => nil, t. + +233: bugs in constraint propagation + a. + (defun foo (x) + (declare (optimize (speed 2) (safety 3))) + (let ((y 0d0)) + (values + (the double-float x) + (setq y (+ x 1d0)) + (setq x 3d0) + (quux y (+ y 2d0) (* y 3d0))))) + (foo 4) => segmentation violation + + (see usage of CONTINUATION-ASSERTED-TYPE in USE-RESULT-CONSTRAINTS) + (see also bug 236) + + b. + (declaim (optimize (speed 2) (safety 3))) + (defun foo (x y) + (if (typep (prog1 x (setq x y)) 'double-float) + (+ x 1d0) + (+ x 2))) + (foo 1d0 5) => segmentation violation + +235: "type system and inline expansion" + a. + (declaim (ftype (function (cons) number) acc)) + (declaim (inline acc)) + (defun acc (c) + (the number (car c))) + + (defun foo (x y) + (values (locally (declare (optimize (safety 0))) + (acc x)) + (locally (declare (optimize (safety 3))) + (acc y)))) + + (foo '(nil) '(t)) => NIL, T. + + b. (reported by brown on #lisp 2003-01-21) + + (defun find-it (x) + (declare (optimize (speed 3) (safety 0))) + (declare (notinline mapcar)) + (let ((z (mapcar #'car x))) + (find 'foobar z))) + + Without (DECLARE (NOTINLINE MAPCAR)), Python cannot derive that Z is + LIST. + +237: "Environment arguments to type functions" + a. Functions SUBTYPEP, TYPEP, UPGRADED-ARRAY-ELEMENT-TYPE, and + UPGRADED-COMPLEX-PART-TYPE now have an optional environment + argument, but they ignore it completely. This is almost + certainly not correct. + b. Also, the compiler's optimizers for TYPEP have not been informed + about the new argument; consequently, they will not transform + calls of the form (TYPEP 1 'INTEGER NIL), even though this is + just as optimizeable as (TYPEP 1 'INTEGER). + +238: "REPL compiler overenthusiasm for CLOS code" + From the REPL, + * (defclass foo () ()) + * (defmethod bar ((x foo) (foo foo)) (call-next-method)) + causes approximately 100 lines of code deletion notes. Some + discussion on this issue happened under the title 'Three "interesting" + bugs in PCL', resulting in a fix for this oververbosity from the + compiler proper; however, the problem persists in the interactor + because the notion of original source is not preserved: for the + compiler, the original source of the above expression is (DEFMETHOD + BAR ((X FOO) (FOO FOO)) (CALL-NEXT-METHOD)), while by the time the + compiler gets its hands on the code needing compilation from the REPL, + it has been macroexpanded several times. + + A symptom of the same underlying problem, reported by Tony Martinez: + * (handler-case + (with-input-from-string (*query-io* " no") + (yes-or-no-p)) + (simple-type-error () 'error)) + ; in: LAMBDA NIL + ; (SB-KERNEL:FLOAT-WAIT) + ; + ; note: deleting unreachable code + ; compilation unit finished + ; printed 1 note + +241: "DEFCLASS mysteriously remembers uninterned accessor names." + (from tonyms on #lisp IRC 2003-02-25) + In sbcl-0.7.12.55, typing + (defclass foo () ((bar :accessor foo-bar))) + (profile foo-bar) + (unintern 'foo-bar) + (defclass foo () ((bar :accessor foo-bar))) + gives the error message + "#:FOO-BAR already names an ordinary function or a macro." + So it's somehow checking the uninterned old accessor name instead + of the new requested accessor name, which seems broken to me (WHN). + +242: "WRITE-SEQUENCE suboptimality" + (observed from clx performance) + In sbcl-0.7.13, WRITE-SEQUENCE of a sequence of type + (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) on a stream with element-type + (UNSIGNED-BYTE 8) will write to the stream one byte at a time, + rather than writing the sequence in one go, leading to severe + performance degradation. + +243: "STYLE-WARNING overenthusiasm for unused variables" + (observed from clx compilation) + In sbcl-0.7.14, in the presence of the macros + (DEFMACRO FOO (X) `(BAR ,X)) + (DEFMACRO BAR (X) (DECLARE (IGNORABLE X)) 'NIL) + somewhat surprising style warnings are emitted for + (COMPILE NIL '(LAMBDA (Y) (FOO Y))): + ; in: LAMBDA (Y) + ; (LAMBDA (Y) (FOO Y)) + ; + ; caught STYLE-WARNING: + ; The variable Y is defined but never used. + +244: "optimizing away tests for &KEY args of type declared in DEFKNOWN" + (caught by clocc-ansi-test :EXCEPSIT-LEGACY-1050) + In sbcl-0.pre8.44, (OPEN "foo" :DIRECTION :INPUT :EXTERNAL-FORMAT 'FOO) + succeeds with no error (ignoring the bogus :EXTERNAL-FORMAT argument) + apparently because the test is optimized away. The problem doesn't + exist in sbcl-0.pre8.19. Deleting the (MEMBER :DEFAULT) declaration + for :EXTERNAL-FORMAT in DEFKNOWN OPEN (and LOAD) is a workaround for + the problem (and should be removed when the problem is fixed). + +245: bugs in disassembler + a. On X86 an immediate operand for IMUL is printed incorrectly. + b. On X86 operand size prefix is not recognized. + +246: "NTH-VALUE scaling problem" + NTH-VALUE's current implementation for constant integers scales in + compile-time as O(n^4), as indeed must the optional dispatch + mechanism on which it is implemented. While it is unlikely to + matter in real user code, it's still unpleasant to observe that + (NTH-VALUE 1000 (VALUES-LIST (MAKE-LIST 1001))) takes several hours + to compile. + +248: "reporting errors in type specifier syntax" + (TYPEP 1 '(SYMBOL NIL)) says something about "unknown type + specifier". + +250: + (make-array nil :initial-element 11) causes a warning. + +251: + (defun foo (&key (a :x)) + (declare (fixnum a)) + a) + + does not cause a warning. (BTW: old SBCL issued a warning, but for a + function, which was never called!) DEFUNCT CATEGORIES OF BUGS IR1-#: