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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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)))
-
+\f
+;;; 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)))
 \f
 ;;;; success
 

diff --git a/tests/mop.impure.lisp b/tests/mop.impure.lisp
index 5b65f1c..9e09e31 100644 (file)
--- 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)))))
 \f
 ;;; Readers for Slot Definition Metaobjects (pp. 221--224 of AMOP)
 

diff --git a/version.lisp-expr b/version.lisp-expr
index 986b2c4..6e5ac6d 100644 (file)
--- 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"