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