From: William Harold Newman Date: Tue, 18 Jun 2002 17:45:14 +0000 (+0000) Subject: 0.7.4.39: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=6ff8c9d8fa5770038489d40d1993c7a1156b9811;p=sbcl.git 0.7.4.39: merged pmai patch (sbcl-devel 2002-06-18) for bug 180 (where :MOST-SPECIFIC-LAST options were ignored in method combination) --- diff --git a/BUGS b/BUGS index eb00513..2ba3b13 100644 --- a/BUGS +++ b/BUGS @@ -1287,53 +1287,7 @@ WORKAROUND: (defun bug178alternative (x) (funcall (the nil x))) -179: - (fixed in sbcl-0.7.4.28) - -180: - In sbcl-0.7.4.35, PCL seems not to understand the :MOST-SPECIFIC-LAST - option for PROGN method combination. It does understand that - :MOST-SPECIFIC-FIRST and :MOST-SPECIFIC-LAST belong with PROGN. - If I use another keyword, it complains: - (defgeneric foo ((x t)) - (:method-combination progn :most-specific-first)) - outputs - method combination error in CLOS dispatch: - Illegal options to a short method combination type. - The method combination type PROGN accepts one option which - must be either :MOST-SPECIFIC-FIRST or :MOST-SPECIFIC-LAST. - And when I use :MOST-SPECIFIC-FIRST, I get the expected default - behavior: - (defgeneric foo ((x t)) - (:method-combination progn :most-specific-first)) - (defmethod foo progn ((x number)) - (print 'number)) - (defmethod foo progn ((x fixnum)) - (print 'fixnum)) - (foo 14) - outputs - FIXNUM - NUMBER - and returns - NUMBER - But with :MOST-SPECIFIC-LAST, - (defgeneric foo ((x t)) - (:method-combination progn :most-specific-last)) - (defmethod foo progn ((x number)) - (print 'number)) - (defmethod foo progn ((x fixnum)) - (print 'fixnum)) - (foo 14) - the behavior doesn't change, giving output of - FIXNUM - NUMBER - and returning - NUMBER - Raymond Toy reported 2002-06-15 on sbcl-devel that CMU CL's PCL - doesn't seem to have this bug, outputting NUMBER before FIXNUM - as expected in the last case above. - -181: +181: "bad type specifier drops compiler into debugger" Compiling (in-package :cl-user) (defun bar (x) diff --git a/NEWS b/NEWS index 17ce44d..d6cdc13 100644 --- a/NEWS +++ b/NEWS @@ -1127,11 +1127,11 @@ changes in sbcl-0.7.4 relative to sbcl-0.7.3: |AB|, instead of A as it used to. changes in sbcl-0.7.5 relative to sbcl-0.7.4: - * SBCL now runs on the Tru64 (aka OSF/1) operating system on the - Alpha architecture. * SBCL now builds with OpenMCL (version 0.12) as the cross-compilation host; also, more progress has been made toward bootstrapping under CLISP. + * SBCL now runs on the Tru64 (aka OSF/1) operating system on the + Alpha architecture. * bug 140 fixed: redefinition of classes with different supertypes is now reflected in the type hierarchy. (thanks to Pierre Mai) * bug 158 fixed: the compiler can now deal with integer loop @@ -1148,6 +1148,8 @@ changes in sbcl-0.7.5 relative to sbcl-0.7.4: count as they should. * bug fix: classes with :METACLASS STRUCTURE-CLASS now print correctly. (thanks to Pierre Mai) + * bug 180 fixed: method combination specifications no longer ignore + the :MOST-SPECIFIC-LAST option * minor incompatible change: The --noprogrammer option is deprecated in favor of the new name --disable-debugger option, which takes effect at a slightly different time at startup (so that e.g. @@ -1158,8 +1160,8 @@ changes in sbcl-0.7.5 relative to sbcl-0.7.4: Debian maintainers, who might want to run non-interactive scripts to build SBCL cores which will later be used interactively.) * minor incompatible change: The LOAD function no longer, when given - a wild pathname to load, loads all files matching that pathname; - instead, an error of type FILE-ERROR is signalled. + a wild pathname to load, loads all files matching that pathname. + Instead, an error of type FILE-ERROR is signalled. planned incompatible changes in 0.7.x: * When the profiling interface settles down, maybe in 0.7.x, maybe diff --git a/src/pcl/combin.lisp b/src/pcl/combin.lisp index 3429ad7..395d32f 100644 --- a/src/pcl/combin.lisp +++ b/src/pcl/combin.lisp @@ -351,9 +351,10 @@ (let ((main-effective-method (if (or before after) `(multiple-value-prog1 - (progn ,(make-call-methods before) - (call-method ,(first primary) - ,(rest primary))) + (progn + ,(make-call-methods before) + (call-method ,(first primary) + ,(rest primary))) ,(make-call-methods (reverse after))) `(call-method ,(first primary) ,(rest primary))))) (if around diff --git a/src/pcl/defcombin.lisp b/src/pcl/defcombin.lisp index 8c4bd49..dacd520 100644 --- a/src/pcl/defcombin.lisp +++ b/src/pcl/defcombin.lisp @@ -124,6 +124,7 @@ (let ((type (method-combination-type combin)) (operator (short-combination-operator combin)) (ioa (short-combination-identity-with-one-argument combin)) + (order (car (method-combination-options combin))) (around ()) (primary ())) (dolist (m applicable-methods) @@ -147,8 +148,11 @@ (push m primary)) (t (lose m "has an illegal qualifier")))))) - (setq around (nreverse around) - primary (nreverse primary)) + (setq around (nreverse around)) + (ecase order + (:most-specific-last) ; nothing to be done, already in correct order + (:most-specific-first + (setq primary (nreverse primary)))) (let ((main-method (if (and (null (cdr primary)) (not (null ioa))) diff --git a/tests/clos.impure.lisp b/tests/clos.impure.lisp index 64089c6..1e70590 100644 --- a/tests/clos.impure.lisp +++ b/tests/clos.impure.lisp @@ -130,7 +130,6 @@ ((a-slot :initarg :a-slot :accessor a-slot) (b-slot :initarg :b-slot :accessor b-slot) (c-slot :initarg :c-slot :accessor c-slot))) - (let ((foo (make-instance 'class-with-slots :a-slot 1 :b-slot 2 @@ -140,26 +139,33 @@ (assert (= (b-slot bar) 2)) (assert (= (c-slot bar) 3)))) -;;; some more change-class testing, now that we have an ANSI-compliant -;;; version (thanks to Espen Johnsen): +;;; some more CHANGE-CLASS testing, now that we have an ANSI-compliant +;;; version (thanks to Espen Johnsen) (defclass from-class () ((foo :initarg :foo :accessor foo))) - (defclass to-class () ((foo :initarg :foo :accessor foo) (bar :initarg :bar :accessor bar))) - (let* ((from (make-instance 'from-class :foo 1)) (to (change-class from 'to-class :bar 2))) (assert (= (foo to) 1)) (assert (= (bar to) 2))) + +;;; Until Pierre Mai's patch (sbcl-devel 2002-06-18, merged in +;;; sbcl-0.7.4.39) the :MOST-SPECIFIC-LAST option had no effect. +(defgeneric bug180 ((x t)) + (:method-combination list :most-specific-last)) +(defmethod bug180 list ((x number)) + 'number) +(defmethod bug180 list ((x fixnum)) + 'fixnum) +(assert (equal (bug180 14) '(number fixnum))) ;;; printing a structure class should not loop indefinitely (or cause ;;; a stack overflow): (defclass test-printing-structure-class () ((slot :initarg :slot)) (:metaclass structure-class)) - (print (make-instance 'test-printing-structure-class :slot 2)) ;;; structure-classes should behave nicely when subclassed @@ -167,11 +173,9 @@ ((a :initarg :a :accessor a-accessor) (b :initform 2 :reader b-reader)) (:metaclass structure-class)) - (defclass sub-structure (super-structure) ((c :initarg :c :writer c-writer :accessor c-accessor)) (:metaclass structure-class)) - (let ((foo (make-instance 'sub-structure :a 1 :c 3))) (assert (= (a-accessor foo) 1)) (assert (= (b-reader foo) 2)) diff --git a/version.lisp-expr b/version.lisp-expr index 7e61201..efc84f1 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -18,4 +18,4 @@ ;;; for internal versions, especially for internal versions off the ;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.7.4.38" +"0.7.4.39"