X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=BUGS;h=e50ba7321a1ea24d0198a43c9a2abc532ab166c6;hb=f9d6d21a7f54638292214ceb9886edc03b99d545;hp=94a87e1743b67aafc5c69ef352df963c919f476b;hpb=947522ee16a30d43466c8f86efacee7003e5d85f;p=sbcl.git diff --git a/BUGS b/BUGS index 94a87e1..e50ba73 100644 --- a/BUGS +++ b/BUGS @@ -50,31 +50,33 @@ WORKAROUND: believers in ANSI compatibility and all, (1) there's no obvious simple way to do it (short of disabling all warnings for type mismatches everywhere), and (2) there's a good portable - workaround. ANSI justifies this specification by saying + workaround, and (3) by their own reasoning, it looks as though + ANSI may have gotten it wrong. ANSI justifies this specification + by saying The restriction against issuing a warning for type mismatches between a slot-initform and the corresponding slot's :TYPE option is necessary because a slot-initform must be specified in order to specify slot options; in some cases, no suitable default may exist. - In SBCL, as in CMU CL (or, for that matter, any compiler which - really understands Common Lisp types) a suitable default does - exist, in all cases, because the compiler understands the concept - of functions which never return (i.e. has return type NIL, e.g. - ERROR). Thus, as a portable workaround, you can use a call to - some known-never-to-return function as the default. E.g. + However, in SBCL (as in CMU CL or, for that matter, any compiler + which really understands Common Lisp types) a suitable default + does exist, in all cases, because the compiler understands the + concept of functions which never return (i.e. has return type NIL). + Thus, as a portable workaround, you can use a call to some + known-never-to-return function as the default. E.g. (DEFSTRUCT FOO (BAR (ERROR "missing :BAR argument") :TYPE SOME-TYPE-TOO-HAIRY-TO-CONSTRUCT-AN-INSTANCE-OF)) or - (DECLAIM (FTYPE () NIL) MISSING-ARG) + (DECLAIM (FTYPE (FUNCTION () NIL) MISSING-ARG)) (DEFUN REQUIRED-ARG () ; workaround for SBCL non-ANSI slot init typing (ERROR "missing required argument")) (DEFSTRUCT FOO (BAR (REQUIRED-ARG) :TYPE TRICKY-TYPE-OF-SOME-SORT) (BLETCH (REQUIRED-ARG) :TYPE TRICKY-TYPE-OF-SOME-SORT) (N-REFS-SO-FAR 0 :TYPE (INTEGER 0))) - Such code will compile without complaint and work correctly either - on SBCL or on a completely compliant Common Lisp system. + 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 @@ -88,9 +90,9 @@ WORKAROUND: to really grok function declarations. 7: - The "byte compiling top-level form:" output ought to be condensed. + The "compiling top-level form:" output ought to be condensed. Perhaps any number of such consecutive lines ought to turn into a - single "byte compiling top-level forms:" line. + single "compiling top-level forms:" line. 10: The way that the compiler munges types with arguments together @@ -243,7 +245,8 @@ WORKAROUND: E.g. compiling and loading (DECLAIM (OPTIMIZE (SAFETY 3))) (DEFUN FACTORIAL (X) (GAMMA (1+ X))) - (DECLAIM (FTYPE (FUNCTION (UNSIGNED-BYTE) FACTORIAL))) + (DEFUN GAMMA (X) X) + (DECLAIM (FTYPE (FUNCTION (UNSIGNED-BYTE)) FACTORIAL)) (DEFUN FOO (X) (COND ((> (FACTORIAL X) 1.0E6) (FORMAT T "too big~%")) @@ -342,11 +345,6 @@ WORKAROUND: MERGE also have the same problem. c: (COERCE 'AND 'FUNCTION) returns something related to (MACRO-FUNCTION 'AND), but ANSI says it should raise an error. - d: ELT signals SIMPLE-ERROR if its index argument - isn't a valid index for its sequence argument, but should - signal TYPE-ERROR instead. - e: FILE-LENGTH is supposed to signal a type error when its - argument is not a stream associated with a file, but doesn't. f: (FLOAT-RADIX 2/3) should signal an error instead of returning 2. g: (LOAD "*.lsp") should signal FILE-ERROR. @@ -386,24 +384,8 @@ WORKAROUND: c: SYMBOL-MACROLET should signal PROGRAM-ERROR if something it binds is declared SPECIAL inside. -49: - LOOP bugs reported by Peter Van Eynde July 25, 2000: - a: (LOOP WITH (A B) DO (PRINT 1)) is a syntax error according to - the definition of WITH clauses given in the ANSI spec, but - compiles and runs happily in SBCL. - b: a messy one involving package iteration: -interpreted Form: (LET ((PACKAGE (MAKE-PACKAGE "LOOP-TEST"))) (INTERN "blah" PACKAGE) (LET ((BLAH2 (INTERN "blah2" PACKAGE))) (EXPORT BLAH2 PACKAGE)) (LIST (SORT (LOOP FOR SYM BEING EACH PRESENT-SYMBOL OF PACKAGE FOR SYM-NAME = (SYMBOL-NAME SYM) COLLECT SYM-NAME) (FUNCTION STRING<)) (SORT (LOOP FOR SYM BEING EACH EXTERNAL-SYMBOL OF PACKAGE FOR SYM-NAME = (SYMBOL-NAME SYM) COLLECT SYM-NAME) (FUNCTION STRING<)))) -Should be: (("blah" "blah2") ("blah2")) -SBCL: (("blah") ("blah2")) - * (LET ((X 1)) (LOOP FOR I BY (INCF X) FROM X TO 10 COLLECT I)) - doesn't work -- SBCL's LOOP says BY isn't allowed in a FOR clause. - 50: type system errors reported by Peter Van Eynde July 25, 2000: - a: (SUBTYPEP 'BIGNUM 'INTEGER) => NIL, NIL - but should be (VALUES T T) instead. - b: (SUBTYPEP 'EXTENDED-CHAR 'CHARACTER) => NIL, NIL - but should be (VALUES T T) instead. c: (SUBTYPEP '(INTEGER (0) (0)) 'NIL) dies with nested errors. d: In general, the system doesn't like '(INTEGER (0) (0)) -- it blows up at the level of SPECIFIER-TYPE with @@ -413,8 +395,6 @@ SBCL: (("blah") ("blah2")) "Component type for Complex is not numeric: (EQL 0)." This might be easy to fix; the type system already knows that (SUBTYPEP '(EQL 0) 'NUMBER) is true. - f: The type system doesn't know about the condition system, - so that e.g. (TYPEP 'SIMPLE-ERROR 'ERROR)=>NIL. g: The type system isn't all that smart about relationships between hairy types, as shown in the type.erg test results, e.g. (SUBTYPEP 'CONS '(NOT ATOM)) => NIL, NIL. @@ -441,14 +421,6 @@ SBCL: (("blah") ("blah2")) need to document exactly what metaobject protocol specification we're following -- the current code is just inherited from PCL.) -53: - another error from Peter Van Eynde 5 September 2000: - (FORMAT NIL "~F" "FOO") should work, but instead reports an error. - PVE submitted a patch to deal with this bug, but it exposes other - comparably serious bugs, so I didn't apply it. It looks as though - the FORMAT code needs a fair amount of rewriting in order to comply - with the various details of the ANSI spec. - 54: The implementation of #'+ returns its single argument without type checking, e.g. (+ "illegal") => "illegal". @@ -664,21 +636,6 @@ Error in function C::GET-LAMBDA-TO-COMPILE: 72: (DECLAIM (OPTIMIZE ..)) doesn't work properly inside LOCALLY forms. -74: - As noted in the ANSI specification for COERCE, (COERCE 3 'COMPLEX) - gives a result which isn't COMPLEX. The result type optimizer - for COERCE doesn't know this, perhaps because it was written before - ANSI threw this curveball: the optimizer thinks that COERCE always - returns a result of the specified type. Thus while the interpreted - function - (DEFUN TRICKY (X) (TYPEP (COERCE X 'COMPLEX) 'COMPLEX)) - returns the correct result, - (TRICKY 3) => NIL - the compiled function - (COMPILE 'TRICKY) - does not: - (TRICKY 3) => T - 75: As reported by Martin Atzmueller on sbcl-devel 26 Dec 2000, ANSI says that WITH-OUTPUT-TO-STRING should have a keyword @@ -705,20 +662,6 @@ Error in function C::GET-LAMBDA-TO-COMPILE: LOAD-FOREIGN, and (2) hunt for any other code which uses temporary files and make it share the same new safe logic. -80: - (fixed early Feb 2001 by MNA) - -81: - As reported by wbuss@TELDA.NET (Wolfhard Buss) on cmucl-help - 2001-02-14, - According to CLHS - (loop with (a . b) of-type float = '(0.0 . 1.0) - and (c . d) of-type float = '(2.0 . 3.0) - return (list a b c d)) - should evaluate to (0.0 1.0 2.0 3.0). cmucl-18c disagrees and - invokes the debugger: "B is not of type list". - SBCL does the same thing. - 82: Functions are assigned names based on the context in which they're defined. This is less than ideal for the functions which are @@ -888,16 +831,6 @@ Error in function C::GET-LAMBDA-TO-COMPILE: the first time around, until regression tests are written I'm not comfortable merging the patches in the CVS version of SBCL. -101: - The error message for calls to structure accessors with the - wrong number of arguments is confusing and of the wrong - condition class (TYPE-ERROR instead of PROGRAM-ERROR): - * (defstruct foo x y) - * (foo-x) - debugger invoked on condition of type SIMPLE-TYPE-ERROR: - Structure for accessor FOO-X is not a FOO: - 301988783 - 102: As reported by Arthur Lemmens sbcl-devel 2001-05-05, ANSI requires that SYMBOL-MACROLET refuse to rebind special variables, @@ -907,13 +840,6 @@ Error in function C::GET-LAMBDA-TO-COMPILE: As of sbcl-0.6.12.x, this dependence on the nonconforming behavior has been fixed, but the nonconforming behavior remains.) -103: - As reported by Arthur Lemmens sbcl-devel 2001-05-05, ANSI's - definition of (LOOP .. DO ..) requires that the terms following - DO all be compound forms. SBCL's implementation of LOOP allows - non-compound forms (like the bare symbol COUNT, in his example) - here. - 104: (DESCRIBE 'SB-ALIEN:DEF-ALIEN-TYPE) reports the macro argument list incorrectly: @@ -931,12 +857,8 @@ Error in function C::GET-LAMBDA-TO-COMPILE: 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 + (and APD pointed out on sbcl-devel 2001-12-29 that it's the same + as bug 50e) 108: (TIME (ROOM T)) reports more than 200 Mbytes consed even for @@ -1039,21 +961,6 @@ Error in function C::GET-LAMBDA-TO-COMPILE: ; (while making load form for #) ; A logical host can't be dumped as a constant: # -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: @@ -1112,42 +1019,6 @@ Error in function C::GET-LAMBDA-TO-COMPILE: Raymond Toy comments that this is tricky on the X86 since its FPU uses 80-bit precision internally. -119: - a bug in the byte compiler and/or interpreter: Compile - (IN-PACKAGE :CL-USER) - (DECLAIM (OPTIMIZE (SPEED 0) (SAFETY 1) (DEBUG 1))) - (DEFUN BAR (&REST DIMS) - (IF (EVERY #'INTEGERP DIMS) - 1 - 2)) - then execute (BAR '(1 2 3 4)). In sbcl-0.pre7.14.flaky4.8 - this gives a TYPE-ERROR, - The value #:UNINITIALIZED-EVAL-STACK-ELEMENT is not - of type (MOD 536870911). - The same error will probably occur in earlier versions as well, - although the name of the uninitialized-element placeholder will - be shorter. - - The same thing happens if the compiler macro expansion of - EVERY into MAP is hand-expanded: - (defun bar2 (dims) - (if (block blockname - (map nil - (lambda (dim) - (let ((pred-value (funcall #'integerp dim))) - (unless pred-value - (return-from blockname - nil)))) - dims) - t) - 1 - 2)) - CMU CL doesn't have this compiler macro expansion, so it was - immune to the original bug in BAR, but once we hand-expand it - into BAR2, CMU CL 18c has the same bug. (Run (BAR '(NIL NIL)).) - - The native compiler handles it fine, both in SBCL and in CMU CL. - 120a: The compiler incorrectly figures the return type of (DEFUN FOO (FRAME UP-FRAME) @@ -1169,89 +1040,338 @@ Error in function C::GET-LAMBDA-TO-COMPILE: is attached to FOO in 120a above, and used to optimize code which calls FOO. -121: - In sbcl-0.7.14.flaky4.10, the last MAPTEST test case at the end - of tests/map-tests.impure.lisp dies with - The value - #> - :ARGS (#)> - is not of type - SB-C::COMBINATION. - in - (SB-C::GENERATE-BYTE-CODE-FOR-REF - # - # - :WHERE-FROM :DECLARED - :KIND :GLOBAL-FUNCTION>> - #) +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. + +123: + The *USE-IMPLEMENTATION-TYPES* hack causes bugs, particularly + (IN-PACKAGE :SB-KERNEL) + (TYPE= (SPECIFIER-TYPE '(VECTOR T)) + (SPECIFIER-TYPE '(VECTOR UNDEFTYPE))) + Then because of this, the compiler bogusly optimizes + (TYPEP #(11) '(SIMPLE-ARRAY UNDEF-TYPE 1)) + to T. Unfortunately, just setting *USE-IMPLEMENTATION-TYPES* to + NIL around sbcl-0.pre7.14.flaky4.12 didn't work: the compiler complained + about type mismatches (probably harmlessly, another instance of bug 117); + and then cold init died with a segmentation fault. + +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 + 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. + Unfortunately I (WHN) don't see any simple way to detect this + condition in order to issue such an error, so for the meantime + SBCL just does this weird broken "conforming" thing. + + The ANSI standard says, in the definition of the special operator + MACROLET, + The macro-expansion functions defined by MACROLET are defined + in the lexical environment in which the MACROLET form appears. + Declarations and MACROLET and SYMBOL-MACROLET definitions affect + 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. + Then it seems to contradict itself by giving the example + (defun foo (x flag) + (macrolet ((fudge (z) + ;The parameters x and flag are not accessible + ; at this point; a reference to flag would be to + ; the global variable of that name. + ` (if flag (* ,z ,z) ,z))) + ;The parameters x and flag are accessible here. + (+ x + (fudge x) + (fudge (+ x 1))))) + The comment "a reference to flag would be to the global variable + of the same name" sounds like good behavior for the system to have. + but actual specification quoted above says that the actual behavior + is undefined. + +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. + +126: + (fixed in 0.pre7.41) + +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). + +130: + reported by Alexey Dejneka on sbcl-devel 2001-11-03 + (defun x (x) + "Return X if X is a non-negative integer." + (let ((step (lambda (%funcall) + (lambda (n) + (cond ((= n 0) 0) + (t (1+ (funcall %funcall (1- n))))))))) + (funcall + ((lambda (a) + (funcall step (lambda (n) + (funcall (funcall a a) n)))) + (lambda (a) + (funcall step (lambda (n) + (funcall (funcall a a) n))))) + x))) + This function returns its argument. But after removing percents it + does not work: "Result of (1- n) is not a function". + +131: + As of sbcl-0.pre7.86.flaky7.3, the cross-compiler, and probably + the CL:COMPILE function (which is based on the same %COMPILE + mechanism) get confused by +(defun sxhash (x) + (labels ((sxhash-number (x) + (etypecase x + (fixnum (sxhash x)) ; through DEFTRANSFORM + (integer (sb!bignum:sxhash-bignum x)) + (single-float (sxhash x)) ; through DEFTRANSFORM + (double-float (sxhash x)) ; through DEFTRANSFORM + #!+long-float (long-float (error "stub: no LONG-FLOAT")) + (ratio (let ((result 127810327)) + (declare (type fixnum result)) + (mixf result (sxhash-number (numerator x))) + (mixf result (sxhash-number (denominator x))) + result)) + (complex (let ((result 535698211)) + (declare (type fixnum result)) + (mixf result (sxhash-number (realpart x))) + (mixf result (sxhash-number (imagpart x))) + result)))) + (sxhash-recurse (x &optional (depthoid +max-hash-depthoid+)) + (declare (type index depthoid)) + (typecase x + (list + (if (plusp depthoid) + (mix (sxhash-recurse (car x) (1- depthoid)) + (sxhash-recurse (cdr x) (1- depthoid))) + 261835505)) + (instance + (if (typep x 'structure-object) + (logxor 422371266 + (sxhash ; through DEFTRANSFORM + (class-name (layout-class (%instance-layout x))))) + 309518995)) + (symbol (sxhash x)) ; through DEFTRANSFORM + (number (sxhash-number x)) + (array + (typecase x + (simple-string (sxhash x)) ; through DEFTRANSFORM + (string (%sxhash-substring x)) + (bit-vector (let ((result 410823708)) + (declare (type fixnum result)) + (dotimes (i (min depthoid (length x))) + (mixf result (aref x i))) + result)) + (t (logxor 191020317 (sxhash (array-rank x)))))) + (character + (logxor 72185131 + (sxhash (char-code x)))) ; through DEFTRANSFORM + (t 42)))) + (sxhash-recurse x))) + complaining "function called with two arguments, but wants exactly + one" about SXHASH-RECURSE. (This might not be strictly a new bug, + since IIRC post-fork CMU CL has also had problems with &OPTIONAL + arguments in FLET/LABELS: it might be an old Python bug which is + only exercised by the new arrangement of the SBCL compiler.) + +132: + Trying to compile + (DEFUN FOO () (CATCH 0 (PRINT 1331))) + gives an error + # is not valid as the second argument to VOP: + SB-C:MAKE-CATCH-BLOCK, + since the TN's primitive type SB-VM::POSITIVE-FIXNUM doesn't allow + any of the SCs allowed by the operand restriction: + (SB-VM::DESCRIPTOR-REG) + The (CATCH 0 ...) construct is bad style (because of unportability + of EQ testing of numbers) but it is legal, and shouldn't cause an + internal compiler error. (This error occurs in sbcl-0.6.13 and in + 0.pre7.86.flaky7.14.) + +133: + Trying to compile something like + (sb!alien:def-alien-routine "breakpoint_remove" sb!c-call:void + (code-obj sb!c-call:unsigned-long) + (pc-offset sb!c-call:int) + (old-inst sb!c-call:unsigned-long)) + in SBCL-0.pre7.86.flaky7.22 after warm init fails with an error + cannot use values types here + probably because the SB-C-CALL:VOID type gets translated to (VALUES). + It should be valid to use VOID for a function return type, so perhaps + instead of calling SPECIFIER-TYPE (which excludes all VALUES types + automatically) we should call VALUES-SPECIFIER-TYPE and handle VALUES + types manually, allowing the special case (VALUES) but still excluding + all more-complex VALUES types. + +135: + Ideally, uninterning a symbol would allow it, and its associated + 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. + +137: + (SB-DEBUG:BACKTRACE) output should start with something + including the name BACKTRACE, not (as in 0.pre7.88) + just "0: (\"hairy arg processor\" ...)". Until about + sbcl-0.pre7.109, the names in BACKTRACE were all screwed + up compared to the nice useful names in sbcl-0.6.13. + Around sbcl-0.pre7.109, they were mostly fixed by using + NAMED-LAMBDA to implement DEFUN. However, there are still + some screwups left, e.g. as of sbcl-0.pre7.109, there are + still some functions named "hairy arg processor" and + "SB-INT:&MORE processor". + +138: + a pair of cross-compiler bugs in sbcl-0.pre7.107 + +138a: + $ cat > /tmp/bug138.lisp << EOF + (in-package "SB!KERNEL") + (defun f-c-l (name parent-types) + (let* ((cpl (mapcar (lambda (x) + (condition-class-cpl x)) + parent-types)) + (new-inherits + (concatenate 'simple-vector + (layout-inherits cond-layout)))) + (if (not (mismatch (layout-inherits olayout) new-inherits)) + olayout + (make-layout)))) + EOF + $ sbcl --core output/after-xc.core + ... + * (target-compile-file "/tmp/bug138.lisp") + ... + internal error, failed AVER: + "(COMMON-LISP:MEMBER SB!C::FUN (SB!C::COMPONENT-LAMBDAS SB!C:COMPONENT))" + + It seems as though this xc bug is likely to correspond to a bug in the + ordinary compiler, but I haven't yet found a test case which causes + this problem in the ordinary compiler. + + related weirdness: Using #'(LAMBDA (X) ...) instead of (LAMBDA (X) ...) + makes the assertion failure go away. + +138b: + Even when you relax the AVER that fails in 138a, there's another + problem cross-compiling the same code: + internal error, failed AVER: + "(COMMON-LISP:ZEROP + (COMMON-LISP:HASH-TABLE-COUNT + (SB!FASL::FASL-OUTPUT-PATCH-TABLE SB!FASL:FASL-OUTPUT)))" + + The same problem appears in the simpler test case + (in-package "SB!KERNEL") + (defun f-c-l () + (let ((cpl (foo (lambda (x) + (condition-class-cpl x)))) + (new-inherits (layout-inherits cond-layout))) + (layout-inherits olayout))) + + Changing CONDITION-CLASS-CPL or (either of the calls to) LAYOUT-INHERITS + to arbitrary nonmagic not-defined-yet just-do-a-full-call functions makes + the problem go away. Also, even in this simpler test case which fails + on a very different AVER, the 138a weirdness about s/(lambda/#'(lambda/ + making the problem go away is preserved. + + I still haven't found any way to make this happen in the ordinary + (not cross-) SBCL compiler, nor in CMU CL. + +138c: + In sbcl-0.pre7.111 I added an assertion upstream, in IR2-CONVERT-CLOSURE, + which fails for the test case above but doesn't keep the system + from cross-compiling itself or passing its tests. + +139: + In sbcl-0.pre7.107, (DIRECTORY "*.*") is broken, as reported by + Nathan Froyd sbcl-devel 2001-12-28. + + Christophe Rhodes suggested (sbcl-devel 2001-12-30) converting + the MERGED-PATHNAME expression in DEFUN DIRECTORY to + (merged-pathname (merge-pathnames pathname + *default-pathname-defaults*)) + This looks right, and fixes this bug, but it interacts with the NODES + logic in %ENUMERATE-PATHNAMES to create a new bug, so that + (DIRECTORY "../**/*.*") no longer shows files in the current working + directory. Probably %ENUMERATE-PATHNAMES (or related logic like + %ENUMERATE-MATCHES) needs to be patched as well. + + Note: The MERGED-PATHNAME change changes behavior incompatibly, + making e.g. (DIRECTORY "*") no longer equivalent to (DIRECTORY "*.*"), + so deserves a NEWS entry. E.g. +* minor incompatible change (part of a bug fix by Christophe Rhodes + to DIRECTORY behavior): DIRECTORY no longer implicitly promotes + NIL slots of its pathname argument to :WILD, and in particular + asking for the contents of a directory, which you used to be able + to do without explicit wildcards, e.g. (DIRECTORY "/tmp/"), + now needs explicit wildcards, e.g. (DIRECTORY "/tmp/*.*"). + KNOWN BUGS RELATED TO THE IR1 INTERPRETER -(Note: At some point, the pure interpreter (actually a semi-pure -interpreter aka "the IR1 interpreter") will probably go away, replaced -by constructs like - (DEFUN EVAL (X) (FUNCALL (COMPILE NIL (LAMBDA ..))))) -and at that time these bugs should either go away automatically or -become more tractable to fix. Until then, they'll probably remain, -since some of them aren't considered urgent, and the rest are too hard -to fix as long as so many special cases remain. After the IR1 -interpreter goes away is also the preferred time to start -systematically exterminating cases where debugging functionality -(backtrace, breakpoint, etc.) breaks down, since getting rid of the -IR1 interpreter will reduce the number of special cases we need to -support.) - -IR1-1: - The FUNCTION special operator doesn't check properly whether its - argument is a function name. E.g. (FUNCTION (X Y)) returns a value - instead of failing with an error. (Later attempting to funcall the - value does cause an error.) - -IR1-2: - COMPILED-FUNCTION-P bogusly reports T for interpreted functions: - * (DEFUN FOO (X) (- 12 X)) - FOO - * (COMPILED-FUNCTION-P #'FOO) - T - -IR1-3: - Executing - (DEFVAR *SUPPRESS-P* T) - (EVAL '(UNLESS *SUPPRESS-P* - (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE) - (FORMAT T "surprise!")))) - prints "surprise!". Probably the entire EVAL-WHEN mechanism ought to be - rewritten from scratch to conform to the ANSI definition, abandoning - the *ALREADY-EVALED-THIS* hack which is used in sbcl-0.6.8.9 (and - in the original CMU CL source, too). This should be easier to do -- - though still nontrivial -- once the various IR1 interpreter special - cases are gone. - -IR1-3a: - EVAL-WHEN's idea of what's a toplevel form is even more screwed up - than the example in IR1-3 would suggest, since COMPILE-FILE and - COMPILE both print both "right now!" messages when compiling the - following code, - (LAMBDA (X) - (COND (X - (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE) - (PRINT "yes! right now!")) - "yes!") - (T - (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE) - (PRINT "no! right now!")) - "no!"))) - and while EVAL doesn't print the "right now!" messages, the first - FUNCALL on the value returned by EVAL causes both of them to be printed. +(Now that the IR1 interpreter has gone away, these should be +relatively straightforward to fix.) IR1-4: The system accepts DECLAIM in most places where DECLARE would be