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