From 0abf6fe3a8e7378b8b4aaccaf3a4daafd77aec4e Mon Sep 17 00:00:00 2001 From: gerd <gerd> Date: Mon, 14 Apr 2003 21:45:22 +0000 Subject: [PATCH] * src-head/pcl/dfun.lisp (cache-miss-values-internal): Test for accessors. * src-head/pcl/rt/defmethod.lisp (defmethod-metacircle.0): New test. * src-head/pcl/rt/defgeneric.lisp (method-class.0): Call the method with the non-standard method class. * src-head/pcl/rt/pkg.lisp ("PCL-TEST"): Don't shadowing-import from PCL. --- pcl/dfun.lisp | 6 ++++-- pcl/rt/defgeneric.lisp | 6 +++--- pcl/rt/defmethod.lisp | 17 ++++++++++++++++- pcl/rt/pkg.lisp | 7 ++----- 4 files changed, 25 insertions(+), 11 deletions(-) diff --git a/pcl/dfun.lisp b/pcl/dfun.lisp index 552b630e1..84b1adea0 100644 --- a/pcl/dfun.lisp +++ b/pcl/dfun.lisp @@ -25,7 +25,7 @@ ;;; ************************************************************************* (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/dfun.lisp,v 1.23 2003/04/13 16:39:22 gerd Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/dfun.lisp,v 1.24 2003/04/14 21:45:22 gerd Exp $") (in-package :pcl) @@ -1120,7 +1120,9 @@ And so, we are saved. (defvar *cmv-stack* ()) (defun cache-miss-values-internal (gf arg-info wrappers classes types state) - (if (and wrappers (equal wrappers (cdr (assq gf *cmv-stack*)))) + (if (and (eq state 'accessor) + wrappers + (equal wrappers (cdr (assq gf *cmv-stack*)))) (break-vicious-metacircle gf classes arg-info) (let ((*cmv-stack* (cons (cons gf wrappers) *cmv-stack*)) (cam-std-p (or (null arg-info) diff --git a/pcl/rt/defgeneric.lisp b/pcl/rt/defgeneric.lisp index 621e8df84..033982cb3 100644 --- a/pcl/rt/defgeneric.lisp +++ b/pcl/rt/defgeneric.lisp @@ -28,7 +28,7 @@ ;;; DAMAGE. #+cmu -(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/rt/defgeneric.lisp,v 1.3 2003/04/13 16:39:22 gerd Exp $") +(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/rt/defgeneric.lisp,v 1.4 2003/04/14 21:45:22 gerd Rel $") (in-package "PCL-TEST") @@ -70,6 +70,6 @@ (defgeneric method-class.0.gf (x) (:method-class method-class.0)) (defmethod method-class.0.gf ((x integer)) x) - t) + (method-class.0.gf 1)) (values r (null c))) - t t) + 1 t) diff --git a/pcl/rt/defmethod.lisp b/pcl/rt/defmethod.lisp index 34bc0a105..857736b39 100644 --- a/pcl/rt/defmethod.lisp +++ b/pcl/rt/defmethod.lisp @@ -28,7 +28,7 @@ ;;; DAMAGE. #+cmu -(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/rt/defmethod.lisp,v 1.3 2003/04/06 09:34:39 gerd Exp $") +(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/rt/defmethod.lisp,v 1.4 2003/04/14 21:45:22 gerd Exp $") (in-package "PCL-TEST") @@ -101,3 +101,18 @@ t) (values r (null c))) t t) + +(deftest defmethod-metacircle.0 + (multiple-value-bind (r c) + (ignore-errors + (defclass dmm.0 () ()) + (defclass dmm.1 () ()) + (defclass dmm.0+1 (dmm.0 dmm.1) ()) + (defmethod dmm.0 ((x dmm.0) (y dmm.1)) 1) + (defmethod dmm.0 ((x dmm.1) (y dmm.0)) 2) + (dmm.0 (make-instance 'dmm.0+1) (make-instance 'dmm.0+1)) + (defmethod dmm.0 ((x dmm.0+1) (y dmm.0+1)) 3) + (dmm.0 (make-instance 'dmm.0+1) (make-instance 'dmm.0+1))) + (values r (null c))) + 3 t) + diff --git a/pcl/rt/pkg.lisp b/pcl/rt/pkg.lisp index 516544a94..5433020bb 100644 --- a/pcl/rt/pkg.lisp +++ b/pcl/rt/pkg.lisp @@ -28,13 +28,10 @@ ;;; DAMAGE. #+cmu -(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/rt/pkg.lisp,v 1.2 2003/03/22 16:15:14 gerd Exp $") +(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/rt/pkg.lisp,v 1.3 2003/04/14 21:45:22 gerd Rel $") (defpackage "PCL-TEST" - (:use "COMMON-LISP" #+cmu "PCL" #+sbcl "SB-PCL" "RT") - (:shadowing-import-from - #+cmu "PCL" #+sbcl "SB-PCL" - "FIND-CLASS" "CLASS-OF" "CLASS-NAME" "BUILT-IN-CLASS")) + (:use "COMMON-LISP" #+cmu "PCL" #+sbcl "SB-PCL" "RT")) #+sbcl (progn -- GitLab