From: Christophe Rhodes Date: Tue, 15 Oct 2002 10:08:02 +0000 (+0000) Subject: 0.7.8.39: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=27f66b547413b4a3e1b285270d468ee1e588153c;p=sbcl.git 0.7.8.39: Fix BUG 209 (wrong argument precedence order for DOCUMENTATION) as per Gerd Moellman on cmucl-imp 2002-10-13 ... see also Entomotomy bug documentation-generic-function-wrong-argument-precedence-order --- diff --git a/BUGS b/BUGS index a2953f9..308c7cc 100644 --- a/BUGS +++ b/BUGS @@ -1263,14 +1263,7 @@ WORKAROUND: to see that it should cause symbols to be interned in the CL package.) 209: "DOCUMENTATION generic function has wrong argument precedence order" - The method from - (DEFMETHOD DOCUMENTATION ((X (EQL '+)) Y) "WRONG!") - should not be executed in the call - (DOCUMENTATION '+ 'FUNCTION), - as the DOCUMENTATION generic function has a different argument - precedence order (see its entry in the CLHS). However, despite a - correct generic function definition in the PCL source code, SBCL - returns "WRONG!" for the call. + (fixed in sbcl-0.7.8.39) 210: "unsafe evaluation of DEFSTRUCT slot initforms in BOA constructors" (fixed in sbcl-0.7.8.35) diff --git a/NEWS b/NEWS index c76e8d3..729a0dc 100644 --- a/NEWS +++ b/NEWS @@ -1316,7 +1316,9 @@ changes in sbcl-0.7.9 relative to sbcl-0.7.8: ** SLOT-DEFINITION-ALLOCATION now returns :CLASS, not the class itself; ** GENERIC-FUNCTION-ARGUMENT-PRECEDENCE-ORDER is now implemented; - ** FINALIZE-INHERITANCE is now called on class finalization. + ** FINALIZE-INHERITANCE is now called on class finalization; + ** DOCUMENTATION and (SETF DOCUMENTATION) now have the correct + argument precedence order. * fixed bug 202: The compiler no longer fails on functions whose derived types contradict their declared type. * DEFMACRO is implemented via EVAL-WHEN instead of IR1 translation, diff --git a/src/pcl/boot.lisp b/src/pcl/boot.lisp index 074344d..d9c76b1 100644 --- a/src/pcl/boot.lisp +++ b/src/pcl/boot.lisp @@ -1708,13 +1708,15 @@ bootstrapping. (defun ensure-generic-function-using-class (existing spec &rest keys &key (lambda-list nil lambda-list-p) + argument-precedence-order &allow-other-keys) (declare (ignore keys)) (cond ((and existing (early-gf-p existing)) existing) ((assoc spec *!generic-function-fixups* :test #'equal) (if existing - (make-early-gf spec lambda-list lambda-list-p existing) + (make-early-gf spec lambda-list lambda-list-p existing + argument-precedence-order) (error "The function ~S is not already defined." spec))) (existing (error "~S should be on the list ~S." @@ -1722,9 +1724,11 @@ bootstrapping. '*!generic-function-fixups*)) (t (pushnew spec *!early-generic-functions* :test #'equal) - (make-early-gf spec lambda-list lambda-list-p)))) + (make-early-gf spec lambda-list lambda-list-p nil + argument-precedence-order)))) -(defun make-early-gf (spec &optional lambda-list lambda-list-p function) +(defun make-early-gf (spec &optional lambda-list lambda-list-p + function argument-precedence-order) (let ((fin (allocate-funcallable-instance *sgf-wrapper* *sgf-slots-init*))) (set-funcallable-instance-fun fin @@ -1748,7 +1752,11 @@ bootstrapping. (setf (early-gf-arg-info fin) arg-info) (when lambda-list-p (proclaim (defgeneric-declaration spec lambda-list)) - (set-arg-info fin :lambda-list lambda-list))) + (if argument-precedence-order + (set-arg-info fin + :lambda-list lambda-list + :argument-precedence-order argument-precedence-order) + (set-arg-info fin :lambda-list lambda-list)))) fin)) (defun set-dfun (gf &optional dfun cache info) diff --git a/tests/clos.impure.lisp b/tests/clos.impure.lisp index 4f26a68..f5062b7 100644 --- a/tests/clos.impure.lisp +++ b/tests/clos.impure.lisp @@ -299,7 +299,14 @@ (odd-key-args-checking 3))) (assert (= (odd-key-args-checking) 42)) (assert (eq (odd-key-args-checking :key t) t))) - + +;;; DOCUMENTATION's argument-precedence-order wasn't being faithfully +;;; preserved through the bootstrap process until sbcl-0.7.8.39. +;;; (thanks to Gerd Moellmann) +(let ((answer (documentation '+ 'function))) + (assert (stringp answer)) + (defmethod documentation ((x (eql '+)) y) "WRONG") + (assert (string= (documentation '+ 'function) answer))) ;;;; success diff --git a/tests/mop.impure.lisp b/tests/mop.impure.lisp index 5b65f1c..9e09e31 100644 --- a/tests/mop.impure.lisp +++ b/tests/mop.impure.lisp @@ -32,19 +32,11 @@ (assert (equal (sb-pcl:generic-function-argument-precedence-order #'fn-with-odd-arg-precedence) '(b c a))) - -#|| -This is actually a test of vanilla CLOS, not the MOP; however, there isn't -a terribly easy way of testing this without it (FIXME: one would have to -construct a series of DOCUMENTATION methods, probably involving -CALL-NEXT-METHOD). However, since we're actually getting this wrong -currently, better put in a quick test in the hope that we can fix it soon: - +;;; Test for DOCUMENTATION's order, which was wrong until sbcl-0.7.8.39 (assert (equal (sb-pcl:generic-function-argument-precedence-order #'documentation) (let ((ll (sb-pcl:generic-function-lambda-list #'documentation))) - (list (nth ll 1) (nth ll 0))))) -||# + (list (nth 1 ll) (nth 0 ll))))) ;;; Readers for Slot Definition Metaobjects (pp. 221--224 of AMOP) diff --git a/version.lisp-expr b/version.lisp-expr index 986b2c4..6e5ac6d 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -18,4 +18,4 @@ ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.7.8.38" +"0.7.8.39"