X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=BUGS;h=7bbd84c02f1fc181458a205e7ccde7783ecadef1;hb=0f807aea814ad6eddea7824675da1ed2ff9cba86;hp=bd15399e21842381848b06c653510db23d2b4354;hpb=dfe6138af5c38d92568b6dac48e852c01be0ec8e;p=sbcl.git diff --git a/BUGS b/BUGS index bd15399..7bbd84c 100644 --- a/BUGS +++ b/BUGS @@ -84,37 +84,19 @@ WORKAROUND: d: (fixed in 0.8.1.5) -7: - The "compiling top-level form:" output ought to be condensed. - Perhaps any number of such consecutive lines ought to turn into a - single "compiling top-level forms:" line. - -19: - (I *think* this is a bug. It certainly seems like strange behavior. But - the ANSI spec is scary, dark, and deep.. -- WHN) - (FORMAT NIL "~,1G" 1.4) => "1. " - (FORMAT NIL "~3,1G" 1.4) => "1. " - 27: Sometimes (SB-EXT:QUIT) fails with Argh! maximum interrupt nesting depth (4096) exceeded, exiting Process inferior-lisp exited abnormally with code 1 I haven't noticed a repeatable case of this yet. -32: - The printer doesn't report closures very well. This is true in - CMU CL 18b as well: - (PRINT #'CLASS-NAME) - gives - # - It would be nice to make closures have a settable name slot, - and make things like DEFSTRUCT and FLET, which create closures, - set helpful values into this slot. - 33: And as long as we're wishing, it would be awfully nice if INSPECT could also report on closures, telling about the values of the bound variables. + Currently INSPECT and DESCRIBE do show the values, but showing the + names of the bindings would be even nicer. + 35: The compiler assumes that any time a function of declared FTYPE doesn't signal an error, its arguments were of the declared type. @@ -156,10 +138,6 @@ WORKAROUND: so they could be supported after all. Very likely SIGCONTEXT-FLOATING-POINT-MODES could now be supported, too. -60: - The debugger LIST-LOCATIONS command doesn't work properly. - (How should it work properly?) - 61: Compiling and loading (DEFUN FAIL (X) (THROW 'FAIL-TAG X)) @@ -220,19 +198,6 @@ WORKAROUND: holding... * is not equivalent to T in many cases, such as (VECTOR *) /= (VECTOR T). -95: - The facility for dumping a running Lisp image to disk gets confused - when run without the PURIFY option, and creates an unnecessarily large - core file (apparently representing memory usage up to the previous - high-water mark). Moreover, when the file is loaded, it confuses the - GC, so that thereafter memory usage can never be reduced below that - level. - - (As of 0.8.7.3 it's likely that the latter half of this bug is fixed. - The interaction between gencgc and the variables used by - save-lisp-and-die is still nonoptimal, though, so no respite from - big core files yet) - 98: In sbcl-0.6.11.41 (and in all earlier SBCL, and in CMU CL), out-of-line structure slot setters are horribly inefficient @@ -378,24 +343,6 @@ WORKAROUND: 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) - (defun test-pred (x y) - (eq x y)) - (defun test-case () - (let* ((x *tmp*) - (func (lambda () x))) - (print (eq func func)) - (print (test-pred func func)) - (delete func (list func)))) - Now calling (TEST-CASE) gives output - NIL - NIL - (#) - Evidently Python thinks of the lambda as a code transformation so - much that it forgets that it's also an object. - 135: Ideally, uninterning a symbol would allow it, and its associated FDEFINITION and PROCLAIM data, to be reclaimed by the GC. However, @@ -628,18 +575,6 @@ WORKAROUND: 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 @@ -785,6 +720,11 @@ WORKAROUND: (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. + As of sbcl-0.9.0.36, this is solved for fd-streams, so is less of a + problem in practice. (Fully fixing this would require adding a + ansi-stream-n-bout slot and associated methods to write a byte + sequence to ansi-stream, similar to the existing ansi-stream-sout + slot/functions.) 243: "STYLE-WARNING overenthusiasm for unused variables" (observed from clx compilation) @@ -930,16 +870,13 @@ WORKAROUND: (fixed in 0.8.2.51, but a test case would be good) -278: - a. - (defun foo () - (declare (optimize speed)) - (loop for i of-type (integer 0) from 0 by 2 below 10 - collect i)) - - uses generic arithmetic. - - b. (fixed in 0.8.3.6) +276: + b. The same as in a., but using MULTIPLE-VALUE-SETQ instead of SETQ. + c. (defvar *faa*) + (defmethod faa ((*faa* double-float)) + (set '*faa* (when (< *faa* 0) (- *faa*))) + (1+ *faa*)) + (faa 1d0) => type error 279: type propagation error -- correctly inferred type goes astray? In sbcl-0.8.3 and sbcl-0.8.1.47, the warning @@ -966,24 +903,6 @@ WORKAROUND: (see also bug 117) -281: COMPUTE-EFFECTIVE-METHOD error signalling. - (slightly obscured by a non-0 default value for - SB-PCL::*MAX-EMF-PRECOMPUTE-METHODS*) - It would be natural for COMPUTE-EFFECTIVE-METHOD to signal errors - when it finds a method with invalid qualifiers. However, it - shouldn't signal errors when any such methods are not applicable to - the particular call being evaluated, and certainly it shouldn't when - simply precomputing effective methods that may never be called. - (setf sb-pcl::*max-emf-precompute-methods* 0) - (defgeneric foo (x) - (:method-combination +) - (:method ((x symbol)) 1) - (:method + ((x number)) x)) - (foo 1) -> ERROR, but should simply return 1 - - The issue seems to be that construction of a discriminating function - calls COMPUTE-EFFECTIVE-METHOD with methods that are not all applicable. - 283: Thread safety: libc functions There are places that we call unsafe-for-threading libc functions that we should find alternatives for, or put locks around. Known or @@ -1108,17 +1027,6 @@ WORKAROUND: The problem is that both EVALs sequentially write to the same LVAR. -305: - (Reported by Dave Roberts.) - Local INLINE/NOTINLINE declaration removes local FTYPE declaration: - - (defun quux (x) - (declare (ftype (function () (integer 0 10)) fee) - (inline fee)) - (1+ (fee))) - - uses generic arithmetic with INLINE and fixnum without. - 306: "Imprecise unions of array types" a.(defun foo (x) (declare (optimize speed) @@ -1145,13 +1053,6 @@ WORKAROUND: around the same time regarding a call to LIST on sparc with 1000 arguments) and other implementation limit constants. -311: "Tokeniser not thread-safe" - (see also Robert Marlow sbcl-help "Multi threaded read chucking a - spak" 2004-04-19) - The tokenizer's use of *read-buffer* and *read-buffer-length* causes - spurious errors should two threads attempt to tokenise at the same - time. - 314: "LOOP :INITIALLY clauses and scope of initializers" reported by Bruno Haible sbcl-devel "various SBCL bugs" from CLISP test suite, originally by Thomas F. Burdick. @@ -1169,16 +1070,6 @@ WORKAROUND: Expected: (2 6 15 38) Got: ERROR -317: "FORMAT of floating point numbers" - reported by Bruno Haible sbcl-devel "various SBCL bugs" from CLISP - test suite. - (format nil "~1F" 10) => "0." ; "10." expected - (format nil "~0F" 10) => "0." ; "10." expected - (format nil "~2F" 1234567.1) => "1000000." ; "1234567." expected - it would be nice if whatever fixed this also untangled the two - competing implementations of floating point printing (Steele and - White, and Burger and Dybvig) present in src/code/print.lisp - 318: "stack overflow in compiler warning with redefined class" reported by Bruno Haible sbcl-devel "various SBCL bugs" from CLISP test suite. @@ -1205,20 +1096,6 @@ WORKAROUND: #(1 2 ((SB-IMPL::|,|) + 2 2) 4) which probably isn't intentional. -323: "REPLACE, BIT-BASH and large strings" - The transform for REPLACE on simple-base-strings uses BIT-BASH, which - at present has an upper limit in size. Consequently, in sbcl-0.8.10 - (defun foo () - (declare (optimize speed (safety 1))) - (let ((x (make-string 140000000)) - (y (make-string 140000000))) - (length (replace x y)))) - (foo) - gives - debugger invoked on a TYPE-ERROR in thread 2412: - The value 1120000000 is not of type (MOD 536870911). - (see also "more and better sequence transforms" sbcl-devel 2004-05-10) - 324: "STREAMs and :ELEMENT-TYPE with large bytesize" In theory, (open foo :element-type '(unsigned-byte )) should work for all positive integral . At present, it only works for up @@ -1481,25 +1358,6 @@ WORKAROUND: method is applicable, and yet matches neither of the method group qualifier patterns. -341: PPRINT-LOGICAL-BLOCK / PPRINT-FILL / PPRINT-LINEAR sharing detection. - (from Paul Dietz' test suite) - - CLHS on PPRINT-LINEAR and PPRINT-FILL (and PPRINT-TABULAR, though - that's slightly different) states that these functions perform - circular and shared structure detection on their object. Therefore, - - a.(let ((*print-circle* t)) - (pprint-linear *standard-output* (let ((x '(a))) (list x x)))) - should print "(#1=(A) #1#)" - - b.(let ((*print-circle* t)) - (pprint-linear *standard-output* - (let ((x (cons nil nil))) (setf (cdr x) x) x))) - should print "#1=(NIL . #1#)" - - (it is likely that the fault lies in PPRINT-LOGICAL-BLOCK, as - suggested by the suggested implementation of PPRINT-TABULAR) - 343: MOP:COMPUTE-DISCRIMINATING-FUNCTION overriding causes error Even the simplest possible overriding of COMPUTE-DISCRIMINATING-FUNCTION, suggested in the PCL implementation @@ -1537,19 +1395,6 @@ WORKAROUND: In sbcl-0.8.13, all backtraces from errors caused by internal errors on the alpha seem to have a "bogus stack frame". -348: - Structure slot setters do not preserve evaluation order: - - (defstruct foo (x)) - - (let ((i (eval '-2)) - (x (make-foo))) - (funcall #'(setf foo-x) - (incf i) - (aref (vector x) (incf i))) - (foo-x x)) - => error - 349: PPRINT-INDENT rounding implementation decisions At present, pprint-indent (and indeed the whole pretty printer) more-or-less assumes that it's using a monospace font. That's @@ -1581,6 +1426,10 @@ WORKAROUND: (used on non-x86 platforms) being a more complete solution then what is done on x86. + On x86/linux large portions of tests/debug.impure.lisp have been commented + out as failures. The probable culprit for these problems is in x86-call-context + (things work fine on x86/freebsd). + More generally, the debugger internals suffer from excessive x86/non-x86 conditionalization and OAOOMization: refactoring the common parts would be good. @@ -1593,6 +1442,13 @@ WORKAROUND: Has the XEP for TEST in the backtrace, not the TEST frame itself. (sparc and x86 at least) + Since SBCL 0.8.20.1 this is hidden unless *SHOW-ENTRY-POINT-DETAILS* + is true (instead there appear two TEST frames at least on ppc). The + underlying cause seems to be that SB-C::TAIL-ANNOTATE will not merge + the tail-call for the XEP, since Python has by that time proved that + the function can never return; same happens if the function holds an + unconditional call to ERROR. + 355: change-class of generic-function (reported by Bruno Haible) The MOP doesn't support change-class on a generic-function. However, SBCL @@ -1971,3 +1827,279 @@ WORKAROUND: (:method ((x integer)) (cons 'integer nil))) => SB-KERNEL::CONTROL-STACK-EXHAUSTED +367: TYPE-ERROR at compile time, undetected TYPE-ERROR at runtime + This test program + (declaim (optimize (safety 3) (debug 2) (speed 2) (space 1))) + (defstruct e367) + (defstruct i367) + (defstruct g367 + (i367s (make-array 0 :fill-pointer t) :type (or (vector i367) null))) + (defstruct s367 + (g367 (error "missing :G367") :type g367 :read-only t)) + ;;; In sbcl-0.8.18, commenting out this (DECLAIM (FTYPE ... R367)) + ;;; gives an internal error at compile time: + ;;; The value # is not of + ;;; type SB-KERNEL:VALUES-TYPE. + (declaim (ftype (function ((vector i367) e367) (or s367 null)) r367)) + (declaim (ftype (function ((vector e367)) (values)) h367)) + (defun frob (v w) + (let ((x (g367-i367s (make-g367)))) + (let* ((y (or (r367 x w) + (h367 x))) + (z (s367-g367 y))) + (format t "~&Y=~S Z=~S~%" y z) + (g367-i367s z)))) + (defun r367 (x y) (declare (ignore x y)) nil) + (defun h367 (x) (declare (ignore x)) (values)) + ;;; In sbcl-0.8.18, executing this form causes an low-level error + ;;; segmentation violation at #X9B0E1F4 + ;;; (instead of the TYPE-ERROR that one might like). + (frob 0 (make-e367)) + can be made to cause two different problems, as noted in the comments: + bug 367a: Compile and load the file. No TYPE-ERROR is signalled at + run time (in the (S367-G367 Y) form of FROB, when Y is NIL + instead of an instance of S367). Instead (on x86/Linux at least) + we end up with a segfault. + bug 367b: Comment out the (DECLAIM (FTYPE ... R367)), and compile + the file. The compiler fails with TYPE-ERROR at compile time. + +368: miscompiled OR (perhaps related to bug 367) + Trying to relax type declarations to find a workaround for bug 367, + it turns out that even when the return type isn't declared (or + declared to be T, anyway) the system remains confused about type + inference in code similar to that for bug 367: + (in-package :cl-user) + (declaim (optimize (safety 3) (debug 2) (speed 2) (space 1))) + (defstruct e368) + (defstruct i368) + (defstruct g368 + (i368s (make-array 0 :fill-pointer t) :type (or (vector i368) null))) + (defstruct s368 + (g368 (error "missing :G368") :type g368 :read-only t)) + (declaim (ftype (function (fixnum (vector i368) e368) t) r368)) + (declaim (ftype (function (fixnum (vector e368)) t) h368)) + (defparameter *h368-was-called-p* nil) + (defun nsu (vertices e368) + (let ((i368s (g368-i368s (make-g368)))) + (let ((fuis (r368 0 i368s e368))) + (format t "~&FUIS=~S~%" fuis) + (or fuis (h368 0 i368s))))) + (defun r368 (w x y) + (declare (ignore w x y)) + nil) + (defun h368 (w x) + (declare (ignore w x)) + (setf *h368-was-called-p* t) + (make-s368 :g368 (make-g368))) + (trace r368 h368) + (format t "~&calling NSU~%") + (let ((nsu (nsu #() (make-e368)))) + (format t "~&NSU returned ~S~%" nsu) + (format t "~&*H368-WAS-CALLED-P*=~S~%" *h368-was-called-p*) + (assert (s368-p nsu)) + (assert *h368-was-called-p*)) + In sbcl-0.8.18, both ASSERTs fail, and (DISASSEMBLE 'NSU) shows + that no call to H368 is compiled. + +369: unlike-an-intersection behavior of VALUES-TYPE-INTERSECTION + In sbcl-0.8.18.2, the identity $(x \cap y \cap y)=(x \cap y)$ + does not hold for VALUES-TYPE-INTERSECTION, even for types which + can be intersected exactly, so that ASSERTs fail in this test case: + (in-package :cl-user) + (let ((types (mapcar #'sb-c::values-specifier-type + '((values (vector package) &optional) + (values (vector package) &rest t) + (values (vector hash-table) &rest t) + (values (vector hash-table) &optional) + (values t &optional) + (values t &rest t) + (values nil &optional) + (values nil &rest t) + (values sequence &optional) + (values sequence &rest t) + (values list &optional) + (values list &rest t))))) + (dolist (x types) + (dolist (y types) + (let ((i (sb-c::values-type-intersection x y))) + (assert (sb-c::type= i (sb-c::values-type-intersection i x))) + (assert (sb-c::type= i (sb-c::values-type-intersection i y))))))) + +370: reader misbehaviour on large-exponent floats + (read-from-string "1.0s1000000000000000000000000000000000000000") + causes the reader to attempt to create a very large bignum (which it + will then attempt to coerce to a rational). While this isn't + completely wrong, it is probably not ideal -- checking the floating + point control word state and then returning the relevant float + (most-positive-short-float or short-float-infinity) or signalling an + error immediately would seem to make more sense. + +372: floating-point overflow not signalled on ppc/darwin + The following assertions in float.pure.lisp fail on ppc/darwin + (Mac OS X version 10.3.7): + (assert (raises-error? (scale-float 1.0 most-positive-fixnum) + floating-point-overflow)) + (assert (raises-error? (scale-float 1.0d0 (1+ most-positive-fixnum)) + floating-point-overflow))) + as the SCALE-FLOAT just returns + #.SB-EXT:SINGLE/DOUBLE-FLOAT-POSITIVE-INFINITY. These tests have been + disabled on Darwin for now. + +375: MISC.555 + (compile nil '(lambda (p1) + (declare (optimize (speed 1) (safety 2) (debug 2) (space 0)) + (type keyword p1)) + (keywordp p1))) + + fails on hairy type check in IR2. + + 1. KEYWORDP is MAYBE-INLINE expanded (before TYPEP-like + transformation could eliminate it). + + 2. From the only call of KEYWORDP the type of its argument is + derived to be KEYWORD. + + 2. Type check for P1 is generated; it uses KEYWORDP to perform the + check, and so references the local function; from the KEYWORDP + argument type new CAST to KEYWORD is generated. The compiler + loops forever. + +377: Memory fault error reporting + On those architectures where :C-STACK-IS-CONTROL-STACK is in + *FEATURES*, we handle SIG_MEMORY_FAULT (SEGV or BUS) on an altstack, + so we cannot handle the signal directly (as in interrupt_handle_now()) + in the case when the signal comes from some external agent (the user + using kill(1), or a fault in some foreign code, for instance). As + of sbcl-0.8.20.20, this is fixed by calling + arrange_return_to_lisp_function() to a new error-signalling + function, but as a result the error reporting is poor: we cannot + even tell the user at which address the fault occurred. We should + arrange such that arguments can be passed to the function called from + arrange_return_to_lisp_function(), but this looked hard to do in + general without suffering from memory leaks. + +379: TRACE :ENCAPSULATE NIL broken on ppc/darwin + See commented-out test-case in debug.impure.lisp. + +380: Accessor redefinition fails because of old accessor name + When redefining an accessor, SB-PCL::FIX-SLOT-ACCESSORS may try to + find the generic function named by the old accessor name using + ENSURE-GENERIC-FUNCTION and then remove the old accessor's method in + the GF. If the old name does not name a function, or if the old name + does not name a generic function, no attempt to find the GF or remove + any methods is made. + + However, if an unrelated GF with an incompatible lambda list exists, + the class redefinition will fail when SB-PCL::REMOVE-READER-METHOD + tries to find and remove a method with an incompatible lambda list + from the unrelated generic function. + +381: incautious calls to EQUAL in fasl dumping + Compiling + (frob #(#1=(a #1#))) + (frob #(#1=(b #1#))) + (frob #(#1=(a #1#))) + in sbcl-0.9.0 causes CONTROL-STACK-EXHAUSTED. My (WHN) impression + is that this follows from the use of (MAKE-HASH-TABLE :TEST 'EQUAL) + to detect sharing, in which case fixing it might require either + getting less ambitious about detecting shared list structure, or + implementing the moral equivalent of EQUAL hash tables in a + cycle-tolerant way. + +382: externalization unexpectedly changes array simplicity + COMPILE-FILE and LOAD + (defun foo () + (let ((x #.(make-array 4 :fill-pointer 0))) + (values (eval `(typep ',x 'simple-array)) + (typep x 'simple-array)))) + then (FOO) => T, NIL. + + Similar problems exist with SIMPLE-ARRAY-P, ARRAY-HEADER accessors + and all array dimension functions. + +383: ASH'ing non-constant zeros + Compiling + (lambda (b) + (declare (type (integer -2 14) b)) + (declare (ignorable b)) + (ash (imagpart b) 57)) + on PPC (and other platforms, presumably) gives an error during the + emission of FASH-ASH-LEFT/FIXNUM=>FIXNUM as the assembler attempts to + stuff a too-large constant into the immediate field of a PPC + instruction. Either the VOP should be fixed or the compiler should be + taught how to transform this case away, paying particular attention + to side-effects that might occur in the arguments to ASH. + +384: Compiler runaway on very large character types + + (compile nil '(lambda (x) + (declare (type (member #\a 1) x)) + (the (member 1 nil) x))) + + The types apparently normalize into a very large type, and the compiler + gets lost in REMOVE-DUPLICATES. Perhaps the latter should use + a better algorithm (one based on hash tables, say) on very long lists + when :TEST has its default value? + + A simpler example: + + (compile nil '(lambda (x) (the (not (eql #\a)) x))) + + (partially fixed in 0.9.3.1, but a better representation for these + types is needed.) + +385: + (format nil "~4,1F" 0.001) => "0.00" (should be " 0.0"); + (format nil "~4,1@F" 0.001) => "+.00" (should be "+0.0"). + +386: SunOS/x86 stack exhaustion handling broken + According to , the + stack exhaustion checking (implemented with a write-protected guard + page) does not work on SunOS/x86. + +387: + 12:10 < jsnell> the package-lock test is basically due to a change in the test + behaviour when you install a handler for error around it. I + thought I'd disabled the test for now, but apparently that was + my imagination + 12:19 < Xophe> jsnell: ah, I see the problem in the package-locks stuff + 12:19 < Xophe> it's the same problem as we had with compiler-error conditions + 12:19 < Xophe> the thing that's signalled up and down the stack is a subtype of + ERROR, where it probably shouldn't be + +388: + (found by Dmitry Bogomolov) + + (defclass foo () ((x :type (unsigned-byte 8)))) + (defclass bar () ((x :type symbol))) + (defclass baz (foo bar) ()) + + causes error + + SB-PCL::SPECIALIZER-APPLICABLE-USING-TYPE-P cannot handle the second argument + (UNSIGNED-BYTE 8). + +389: + (reported several times on sbcl-devel, by Rick Taube, Brian Rowe and + others) + + ROUND-NUMERIC-BOUND assumes that float types always have a FORMAT + specifying whether they're SINGLE or DOUBLE. This is true for types + computed by the type system itself, but the compiler type derivation + short-circuits this and constructs non-canonical types. A temporary + fix was made to ROUND-NUMERIC-BOUND for the sbcl-0.9.6 release, but + the right fix is to remove the abstraction violation in the + compiler's type deriver. + +392: slot-accessor for subclass misses obsoleted superclass + (fixed in sbcl-0.9.7.9) + +393: Wrong error from methodless generic function + (DEFGENERIC FOO (X)) + (FOO 1 2) + gives NO-APPLICABLE-METHOD rather than an argument count error. + +394: (SETF CLASS-NAME)/REINITIALIZE-INSTANCE bug + (found by PFD ansi-tests) + in sbcl-0.9.7.15, (SETF (CLASS-NAME ) 'NIL) causes + (FIND-CLASS NIL) to return a #.