From df1a39b96b0e7af7c64a511c2fb6a8b05ff8ed25 Mon Sep 17 00:00:00 2001
From: pmai <pmai>
Date: Wed, 18 Dec 2002 19:16:28 +0000
Subject: [PATCH] Entomotomy Bug:
 pcl-error-reporting-unhelpful-on-missing-primary-method

Merged patches and ideas by Gerd Moellmann and Christophe Rhodes to improve
error reporting on missing applicable primary methods for standard method-
combination to report the arguments that were passed to the GF in question.
---
 pcl/braid.lisp             | 16 +++++++++++++++-
 pcl/combin.lisp            | 36 +++++++++++++++++++++++++-----------
 pcl/generic-functions.lisp |  4 +++-
 3 files changed, 43 insertions(+), 13 deletions(-)

diff --git a/pcl/braid.lisp b/pcl/braid.lisp
index 06c8a0c4a..8def17ff3 100644
--- a/pcl/braid.lisp
+++ b/pcl/braid.lisp
@@ -26,7 +26,7 @@
 ;;;
 
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/braid.lisp,v 1.27 2002/11/22 00:39:55 pmai Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/braid.lisp,v 1.28 2002/12/18 19:16:27 pmai Exp $")
 ;;;
 ;;; Bootstrapping the meta-braid.
 ;;;
@@ -621,6 +621,20 @@ when called with arguments ~S."
           :arguments args)
   (apply generic-function args))
 
+(define-condition no-primary-method (no-applicable-method)
+  ()
+  (:report (lambda (condition stream)
+             (format stream "Generic function ~S~%~
+                             No primary method given arguments ~S"
+                     (no-applicable-method-function condition)
+                     (no-applicable-method-arguments condition)))))
+
+(defmethod no-primary-method ((generic-function standard-generic-function)
+			      &rest args)
+  (cerror "Try again." 'no-primary-method
+	  :function generic-function :arguments args)
+  (apply generic-function args))
+
 (define-condition no-next-method (type-error)
   ((method :reader no-next-method-method :initarg :method)
    (arguments :reader no-next-method-arguments :initarg :arguments))
diff --git a/pcl/combin.lisp b/pcl/combin.lisp
index 25b0eeeb9..5e57beb30 100644
--- a/pcl/combin.lisp
+++ b/pcl/combin.lisp
@@ -26,7 +26,7 @@
 ;;;
 
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/combin.lisp,v 1.11 2002/08/26 02:23:11 pmai Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/combin.lisp,v 1.12 2002/12/18 19:16:28 pmai Exp $")
 ;;;
 
 (in-package :pcl)
@@ -175,14 +175,22 @@
   (multiple-value-bind (nreq applyp metatypes nkeys arg-info)
       (get-generic-function-info gf)
     (declare (ignore nreq nkeys arg-info))
-    (let ((ll (make-fast-method-call-lambda-list metatypes applyp))
-	  ;; When there are no primary methods and a next-method call occurs
-	  ;; effective-method is (error "No mumble..") and the defined
-	  ;; args are not used giving a compiler warning.
-	  (error-p (eq (first effective-method) 'error)))
-      `(lambda ,ll
-	 (declare (ignore ,@(if error-p ll '(.pv-cell. .next-method-call.))))
-	 ,effective-method))))
+    (let ((ll (make-fast-method-call-lambda-list metatypes applyp)))
+      (cond
+	;; When there are no primary methods and a next-method call
+	;; occurs effective-method is (%no-primary-method <gf>),
+	;; which we define here to collect all gf arguments, to pass
+	;; those together with the GF to no-primary-method:
+	((eq (first effective-method) '%no-primary-method)
+	  `(lambda (.pv-cell. .next-method-call. &rest .args.)
+	     (declare (ignore .pv-cell. .next-method-call.))
+	     (flet ((%no-primary-method (gf)
+	              (apply #'no-primary-method gf .args.)))
+	       ,effective-method)))
+	(t
+	  `(lambda ,ll
+	     (declare (ignore .pv-cell. .next-method-call.))
+	     ,effective-method))))))
 
 (defun expand-emf-call-method (gf form metatypes applyp env)
   (declare (ignore gf metatypes applyp env))
@@ -340,8 +348,14 @@
 	  primary (reverse primary)
 	  around  (reverse around))
     (cond ((null primary)
-	   `(error "No primary method for the generic function ~S."
-	     ',generic-function))
+	   ;;
+	   ;; This form is recognized by expand-effective-method-function,
+	   ;; which provides a definition for %no-primary-method that
+	   ;; collects all gf arguments, and passes them together with the
+	   ;; generic function to no-primary-method for more informative
+	   ;; error reporting.
+	   ;;
+	   `(%no-primary-method ',generic-function))
 	  ((and (null before) (null after) (null around))
 	   ;;
 	   ;; By returning a single call-method `form' here we enable an
diff --git a/pcl/generic-functions.lisp b/pcl/generic-functions.lisp
index 131dcd215..5f7705c7c 100644
--- a/pcl/generic-functions.lisp
+++ b/pcl/generic-functions.lisp
@@ -2,7 +2,7 @@
 ;;;
 
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/generic-functions.lisp,v 1.15 2002/11/22 01:05:23 pmai Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/generic-functions.lisp,v 1.16 2002/12/18 19:16:28 pmai Exp $")
 ;;;
 
 (in-package :pcl)
@@ -769,6 +769,8 @@
 (defgeneric no-applicable-method (generic-function &rest args))
 ;          (t)
 
+(defgeneric no-primary-method (generic-function &rest args))
+
 (defgeneric reader-method-class (class direct-slot &rest initargs))
 ;          (slot-class t)
 
-- 
GitLab