;; no problem, can just use the ordinary expansion
`(function (setf ,place-function-name))))
-99:
- DESCRIBE interacts poorly with *PRINT-CIRCLE*, e.g. the output from
- (let ((*print-circle* t)) (describe (make-hash-table)))
- is weird,
- #<HASH-TABLE :TEST EQL :COUNT 0 {90BBFC5}> is an . (EQL)
- Its SIZE is 16.
- Its REHASH-SIZE is 1.5. Its REHASH-THRESHOLD is . (1.0)
- It holds 0 key/value pairs.
- where the ". (EQL)" and ". (1.0)" substrings are screwups.
- (This is likely a pretty-printer problem which happens to
- be exercised by DESCRIBE, not actually a DESCRIBE problem.)
-
100:
There's apparently a bug in CEILING optimization which caused
Douglas Crosher to patch the CMU CL version. Martin Atzmueller
/usr/stuff/sbcl/src/code/host-alieneval.lisp
Created: Monday, March 12, 2001 07:47:43 AM CST
-105:
- (DESCRIBE 'STREAM-READ-BYTE)
-
106:
(reported by Eric Marsden on cmucl-imp 2001-06-15)
(and APD pointed out on sbcl-devel 2001-12-29 that it's the same
APD Alexey Dejneka
NJF Nathan Froyd
RAM Robert MacLachlan
-WHN William Newman
+WHN William ("Bill") Newman
+CSR Christopher Rhodes
PVE Peter Van Eynde
for early 0.7.x:
* patches postponed until after 0.7.0:
- ** Christophe Rhodes "rough patch to fix bug 106" 2001-10-28
+ ** CSR "rough patch to fix bug 106" 2001-10-28
** Alexey Dejneka "bug 111" 2001-12-30
* building with CLISP (or explaining why not). This will likely involve
a rearrangement of the build system so that it never renames
:reader gf-arg-info)
(dfun-state
:initform ()
- :accessor gf-dfun-state)
- (pretty-arglist
- :initform ()
- :accessor gf-pretty-arglist))
+ :accessor gf-dfun-state))
(:metaclass funcallable-standard-class)
(:default-initargs :method-class *the-class-standard-method*
:method-combination *standard-method-combination*))
(defvar *describe-metaobjects-as-objects-p* nil)
(defmethod describe-object ((fun standard-generic-function) stream)
- (format stream "~A is a generic function.~%" fun)
+ (format stream "~&~A is a generic function.~%" fun)
(format stream "Its arguments are:~% ~S~%"
(generic-function-pretty-arglist fun))
- (format stream "Its methods are:")
- (dolist (method (generic-function-methods fun))
- (format stream "~2% ~{~S ~}~:S =>~%"
- (method-qualifiers method)
- (unparse-specializers method))
- (describe-object (or (method-fast-function method)
- (method-function method))
- stream))
+ (let ((methods (generic-function-methods fun)))
+ (if (null methods)
+ (format stream "It has no methods.~%")
+ (let ((gf-name (generic-function-name fun)))
+ (format stream "Its methods are:")
+ (dolist (method methods)
+ (format stream "~2% (~A ~{~S ~}~:S) =>~%"
+ gf-name
+ (method-qualifiers method)
+ (unparse-specializers method))
+ (describe-object (or (method-fast-function method)
+ (method-function method))
+ stream)))))
(when *describe-metaobjects-as-objects-p*
(call-next-method)))
(defgeneric gf-dfun-state (standard-generic-function))
-(defgeneric gf-pretty-arglist (standard-generic-function))
-
(defgeneric long-method-combination-function (long-method-combination))
(defgeneric method-combination-documentation (standard-method-combination))
(defgeneric (setf gf-dfun-state) (new-value standard-generic-function))
-(defgeneric (setf gf-pretty-arglist) (new-value standard-generic-function))
-
(defgeneric (setf method-generic-function) (new-value standard-method))
(defgeneric (setf object-plist) (new-value plist-mixin))
;;; into account at all yet.
(defmethod generic-function-pretty-arglist
((generic-function standard-generic-function))
- (let ((methods (generic-function-methods generic-function))
- (arglist ()))
- (when methods
- (multiple-value-bind (required optional rest key allow-other-keys)
- (method-pretty-arglist (car methods))
- (dolist (m (cdr methods))
- (multiple-value-bind (method-key-keywords
- method-allow-other-keys
- method-key)
- (function-keywords m)
- ;; we've modified function-keywords to return what we want as
- ;; the third value, no other change here.
- (declare (ignore method-key-keywords))
- (setq key (union key method-key))
- (setq allow-other-keys (or allow-other-keys
- method-allow-other-keys))))
- (when allow-other-keys
- (setq arglist '(&allow-other-keys)))
- (when key
- (setq arglist (nconc (list '&key) key arglist)))
- (when rest
- (setq arglist (nconc (list '&rest rest) arglist)))
- (when optional
- (setq arglist (nconc (list '&optional) optional arglist)))
- (nconc required arglist)))))
+ (let ((methods (generic-function-methods generic-function)))
+ (if methods
+ (let ((arglist ()))
+ ;; arglist is constructed from the GF's methods - maybe with
+ ;; keys and rest stuff added
+ (multiple-value-bind (required optional rest key allow-other-keys)
+ (method-pretty-arglist (car methods))
+ (dolist (m (cdr methods))
+ (multiple-value-bind (method-key-keywords
+ method-allow-other-keys
+ method-key)
+ (function-keywords m)
+ ;; we've modified function-keywords to return what we want as
+ ;; the third value, no other change here.
+ (declare (ignore method-key-keywords))
+ (setq key (union key method-key))
+ (setq allow-other-keys (or allow-other-keys
+ method-allow-other-keys))))
+ (when allow-other-keys
+ (setq arglist '(&allow-other-keys)))
+ (when key
+ (setq arglist (nconc (list '&key) key arglist)))
+ (when rest
+ (setq arglist (nconc (list '&rest rest) arglist)))
+ (when optional
+ (setq arglist (nconc (list '&optional) optional arglist)))
+ (nconc required arglist)))
+ ;; otherwise we take the lambda-list from the GF directly, with no
+ ;; other 'keys' added ...
+ (let ((lambda-list (generic-function-lambda-list generic-function)))
+ lambda-list))))
(defmethod method-pretty-arglist ((method standard-method))
(let ((required ())
fi
}
-tmpfilename="clos-test-$$-tmp.lisp"
+base_tmpfilename="clos-test-$$-tmp"
+tmpfilename="$base_tmpfilename.lisp"
+compiled_tmpfilename="$base_tmpfilename.fasl"
# This should fail, but didn't until sbcl-0.6.12.7, with Martin
# Atzmueller's port of Pierre Mai's fixes.
expect_load_error $tmpfilename
rm $tmpfilename
+rm $compiled_tmpfilename
# success
exit 104
echo //running $f test
$SBCL <<EOF ; tenfour
(compile-file "$f")
- (progn (load *) (sb-ext:quit :unix-status 104))
+ (progn
+ (unwind-protect
+ (load *)
+ (ignore-errors (delete-file (compile-file-pathname "$f"))))
+ (sb-ext:quit :unix-status 104))
EOF
fi
done
echo //running $f test
$SBCL <<EOF ; tenfour
(compile-file "$f")
- (progn (load *) (sb-ext:quit :unix-status 104))
+ (progn
+ (unwind-protect
+ (load *)
+ (ignore-errors (delete-file (compile-file-pathname "$f"))))
+ (sb-ext:quit :unix-status 104))
EOF
fi
done
;;; for internal versions, especially for internal versions off the
;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.pre7.127"
+"0.pre7.128"
projects / sbcl.git / commitdiff