From 1234f4cd25b2d50dfa2645d66757116e64b7aae2 Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Sat, 12 Oct 2002 16:02:37 +0000 Subject: [PATCH] 0.7.8.32: Commit implementation (from Gerd Moellmann for cmucl via Pierre Mai) of GENERIC-FUNCTION-ARGUMENT-PRECEDENCE-ORDER function (defined by AMOP) ... and note that PCL's DOCUMENTATION GF somehow acquires the wrong precedence order (see Entomotomy bugs: generic-function-argument-precedence-order-missing documentation-generic-function-wrong-argument-precedence-order) --- BUGS | 10 ++++++++ src/pcl/generic-functions.lisp | 2 ++ src/pcl/methods.lisp | 8 +++++++ tests/mop.impure.lisp | 49 ++++++++++++++++++++++++++++++++++++++++ version.lisp-expr | 2 +- 5 files changed, 70 insertions(+), 1 deletion(-) create mode 100644 tests/mop.impure.lisp diff --git a/BUGS b/BUGS index 10082dc..7942a1f 100644 --- a/BUGS +++ b/BUGS @@ -1262,6 +1262,16 @@ WORKAROUND: package: FOO-SLOT". (This is fairly bad code, but still it's hard 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. + DEFUNCT CATEGORIES OF BUGS IR1-#: These labels were used for bugs related to the old IR1 interpreter. diff --git a/src/pcl/generic-functions.lisp b/src/pcl/generic-functions.lisp index bca7464..cfdf49f 100644 --- a/src/pcl/generic-functions.lisp +++ b/src/pcl/generic-functions.lisp @@ -264,6 +264,8 @@ (defgeneric function-keywords (method)) +(defgeneric generic-function-argument-precedence-order (gf)) + (defgeneric generic-function-lambda-list (gf)) (defgeneric generic-function-pretty-arglist (generic-function)) diff --git a/src/pcl/methods.lisp b/src/pcl/methods.lisp index 6dc9fd3..9f43912 100644 --- a/src/pcl/methods.lisp +++ b/src/pcl/methods.lisp @@ -403,6 +403,14 @@ (when restp `(&rest ,(intern "Discriminating Function &rest Arg"))))) +(defmethod generic-function-argument-precedence-order + ((gf standard-generic-function)) + (aver (eq *boot-state* 'complete)) + (loop with arg-info = (gf-arg-info gf) + with lambda-list = (arg-info-lambda-list arg-info) + for argument-position in (arg-info-precedence arg-info) + collect (nth argument-position lambda-list))) + (defmethod generic-function-lambda-list ((gf generic-function)) (gf-lambda-list gf)) diff --git a/tests/mop.impure.lisp b/tests/mop.impure.lisp new file mode 100644 index 0000000..6c81e86 --- /dev/null +++ b/tests/mop.impure.lisp @@ -0,0 +1,49 @@ +;;;; miscellaneous side-effectful tests of the MOP + +;;;; This software is part of the SBCL system. See the README file for +;;;; more information. +;;;; +;;;; While most of SBCL is derived from the CMU CL system, the test +;;;; files (like this one) were written from scratch after the fork +;;;; from CMU CL. +;;;; +;;;; This software is in the public domain and is provided with +;;;; absolutely no warranty. See the COPYING and CREDITS files for +;;;; more information. + +;;;; Note that the MOP is not in a supported state. Package issues +;;;; (both MOP/SB-PCL and CL/SB-PCL) have yet to be resolved, and +;;;; there is likely to be missing functionality. However, this seems +;;;; a good a way as any of ensuring that we have no regressions. + +(defpackage "MOP-TEST" + ;; eventually, we might want "MOP" as well here. + (:use "CL")) + +(in-package "MOP-TEST") + +(defgeneric fn-with-odd-arg-precedence (a b c) + (:argument-precedence-order b c a)) + +(assert (equal + (sb-pcl:generic-function-lambda-list #'fn-with-odd-arg-precedence) + '(a b c))) +(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: + +(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))))) +||# + +;;;; success +(sb-ext:quit :unix-status 104) diff --git a/version.lisp-expr b/version.lisp-expr index 921468e..f5d70ac 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -18,4 +18,4 @@ ;;; internal versions off the main CVS branch, it gets hairier, e.g. ;;; "0.pre7.14.flaky4.13".) -"0.7.8.31" +"0.7.8.32" -- 1.7.10.4