bug#22294: Patch (was: bug#22294: 25.0.50; edebug should support jumping into generic methods)

[Gemini Lasswell <gazally@runbox.com>]

[-- Attachment #1: Type: text/plain, Size: 1413 bytes --]

Hi Dmitry,

Dmitry Gutov <dgutov@yandex.ru> writes:

> Thanks for pinging me, but the patch does little to the problem I'm seeing.
>
> Specifically, edebug-step-in doesn't work to step into a function call
> that's calling a generic method.
>
Thanks for the more specific steps to reproduce your problem. I've had a
go at fixing it and have come up with the attached patch. It works by
finding and instrumenting all the methods belonging to the generic
function you are about to step into, before the call is made.

Some limitations:

- All the methods get debug instrumentation and temporary breakpoints,
not just the one that's about to be executed. But given the potential
complexity of method dispatch, it seems that fixing that would require
some deep intertwining of Edebug and cl-generic.

- If you use edebug-step-in twice on the same generic function it will
reinstrument the methods, as opposed to using edebug-step-in twice on a
regular function where Edebug can figure out that the function is
already instrumented. Fixing that would require some way to include
dynamic elements in the :name construct of an Edebug spec so that each
method could get a unique deterministic symbol as opposed to an
anonymous generated symbol. Or it could be fixed by the "future"
described in edebug-form-data's docstring.

This automates the steps to reproduce bug#24753, so apply that patch
before you try this one.


[-- Attachment #2: 0001-Make-edebug-step-in-work-on-generic-methods-Bug-2229.patch --]
[-- Type: text/plain, Size: 7994 bytes --]

From 5dcde4877bae34e4b4ab39c5f4f149a1793cffcc Mon Sep 17 00:00:00 2001
From: Gemini Lasswell <gazally@runbox.com>
Date: Wed, 26 Apr 2017 09:25:50 -0700
Subject: [PATCH] Make edebug-step-in work on generic methods (Bug#22294)

* lisp/emacs-lisp/edebug.el (edebug--step-in-symbols): New variable.
(edebug-make-form-wrapper): Add defined symbols to
edebug--step-in-symbols.
(edebug-instrument-function): If the function is a generic function,
find and instrument all of its methods. Return a list instead of a
single symbol.
(edebug-instrument-callee): Now returns a list. Update docstring.
(edebug-step-in): Handle the list returned by edebug-instrument-callee.
* lisp/subr.el (method-files): New function.
* test/lisp/subr-tests.el (subr-tests--method-files--finds-methods)
(subr-tests--method-files--nonexistent-methods): New tests.
---
 lisp/emacs-lisp/edebug.el | 49 +++++++++++++++++++++++++++++++++++------------
 lisp/subr.el              | 19 ++++++++++++++++++
 test/lisp/subr-tests.el   | 25 ++++++++++++++++++++++++
 3 files changed, 81 insertions(+), 12 deletions(-)

diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index 4116e31d0a..1aa93a91b7 100644
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -1170,6 +1170,8 @@ edebug-def-args
 (defvar edebug-def-interactive) ; is it an emacs interactive function?
 (defvar edebug-inside-func)  ;; whether code is inside function context.
 ;; Currently def-form sets this to nil; def-body sets it to t.
+(defvar edebug--step-in-symbols nil
+  "Used by edebug-step-in command to gather list of functions instrumented.")
 
 (defun edebug-interactive-p-name ()
   ;; Return a unique symbol for the variable used to store the
@@ -1332,6 +1334,7 @@ edebug-make-form-wrapper
 
       ;;    (message "defining: %s" edebug-def-name) (sit-for 2)
       (edebug-make-top-form-data-entry form-data-entry)
+      (push edebug-def-name edebug--step-in-symbols)
       (message "Edebug: %s" edebug-def-name)
       ;;(debug edebug-def-name)
 
@@ -3186,19 +3189,38 @@ edebug-step-out
 	 )))))
 
 (defun edebug-instrument-function (func)
-  ;; Func should be a function symbol.
-  ;; Return the function symbol, or nil if not instrumented.
-  (let ((func-marker (get func 'edebug)))
+  "Instrument the function or generic method FUNC.
+Return the list of function symbols which were instrumented.
+This may be simply (FUNC) for a normal function, or a list of
+generated symbols for methods.  If a function or method to
+instrument cannot be found, signal an error."
+  (let ((func-marker (get func 'edebug))
+        edebug--step-in-symbols)
     (cond
      ((and (markerp func-marker) (marker-buffer func-marker))
       ;; It is uninstrumented, so instrument it.
       (with-current-buffer (marker-buffer func-marker)
 	(goto-char func-marker)
 	(edebug-eval-top-level-form)
-	func))
+	edebug--step-in-symbols))
      ((consp func-marker)
       (message "%s is already instrumented." func)
-      func)
+      (list func))
+     ((get func 'cl--generic)
+      (let ((method-defs (method-files func)))
+        (unless method-defs
+          (error "Could not find any method definitions for %s" func))
+        (while method-defs
+          (let* ((file (caar method-defs))
+                 (spec (cdar method-defs))
+                 (loc (find-function-search-for-symbol spec 'cl-defmethod file)))
+            (unless (cdr loc)
+              (error "Could not find the definition for %s in its file" spec))
+            (with-current-buffer (car loc)
+              (goto-char (cdr loc))
+              (edebug-eval-top-level-form)))
+          (setq method-defs (cdr method-defs))))
+      edebug--step-in-symbols)
      (t
       (let ((loc (find-function-noselect func t)))
 	(unless (cdr loc)
@@ -3206,13 +3228,16 @@ edebug-instrument-function
 	(with-current-buffer (car loc)
 	  (goto-char (cdr loc))
 	  (edebug-eval-top-level-form)
-	  func))))))
+	  edebug--step-in-symbols))))))
 
 (defun edebug-instrument-callee ()
   "Instrument the definition of the function or macro about to be called.
 Do this when stopped before the form or it will be too late.
 One side effect of using this command is that the next time the
-function or macro is called, Edebug will be called there as well."
+function or macro is called, Edebug will be called there as well.
+If the callee is a generic function, Edebug will instrument all
+the methods, not just the one which is about to be called.  Return
+the list of symbols which were instrumented."
   (interactive)
   (if (not (looking-at "("))
       (error "You must be before a list form")
@@ -3227,15 +3252,15 @@ edebug-instrument-callee
 
 
 (defun edebug-step-in ()
-  "Step into the definition of the function or macro about to be called.
+  "Step into the definition of the function, macro or method about to be called.
 This first does `edebug-instrument-callee' to ensure that it is
 instrumented.  Then it does `edebug-on-entry' and switches to `go' mode."
   (interactive)
-  (let ((func (edebug-instrument-callee)))
-    (if func
+  (let ((funcs (edebug-instrument-callee)))
+    (if funcs
 	(progn
-	  (edebug-on-entry func 'temp)
-	  (edebug-go-mode nil)))))
+          (mapc (lambda (func) (edebug-on-entry func 'temp)) funcs)
+          (edebug-go-mode nil)))))
 
 (defun edebug-on-entry (function &optional flag)
   "Cause Edebug to stop when FUNCTION is called.
diff --git a/lisp/subr.el b/lisp/subr.el
index 1dd5d2ffef..4e7ddb3f2b 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -2026,6 +2026,25 @@ symbol-file
 	(setq files (cdr files)))
       file)))
 
+(defun method-files (method)
+  "Return a list of files where METHOD is defined by `cl-defmethod'.
+The list will have entries of the form (FILE . (METHOD ...))
+where (METHOD ...) contains the qualifiers and specializers of
+the method and is a suitable argument for
+`find-function-search-for-symbol'.  Filenames are absolute."
+  (let ((files load-history)
+        result)
+    (while files
+      (let ((defs (cdr (car files))))
+        (while defs
+          (let ((def (car defs)))
+            (if (and (eq (car-safe def) 'cl-defmethod)
+                     (eq (cadr def) method))
+                (push (cons (car (car files)) (cdr def)) result)))
+          (setq defs (cdr defs))))
+      (setq files (cdr files)))
+    result))
+
 (defun locate-library (library &optional nosuffix path interactive-call)
   "Show the precise file name of Emacs library LIBRARY.
 LIBRARY should be a relative file name of the library, a string.
diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el
index 0d243cc5d8..4a355bd2c9 100644
--- a/test/lisp/subr-tests.el
+++ b/test/lisp/subr-tests.el
@@ -291,5 +291,30 @@ subr-test--frames-1
   (should-error (eval '(dolist "foo") t)
                 :type 'wrong-type-argument))
 
+
+(require 'cl-generic)
+(cl-defgeneric subr-tests--generic (x))
+(cl-defmethod subr-tests--generic ((x string))
+  (message "%s is a string" x))
+(cl-defmethod subr-tests--generic ((x integer))
+  (message "%s is a number" x))
+(cl-defgeneric subr-tests--generic-without-methods (x y))
+(defvar subr-tests--this-file (or load-file-name buffer-file-name))
+
+(ert-deftest subr-tests--method-files--finds-methods ()
+  "`method-files' returns a list of files and methods for a generic function."
+  (let ((retval (method-files 'subr-tests--generic)))
+    (should (equal (length retval) 2))
+    (mapc (lambda (x)
+            (should (equal (car x) subr-tests--this-file))
+            (should (equal (cadr x) 'subr-tests--generic)))
+          retval)
+    (should-not (equal (nth 0 retval) (nth 1 retval)))))
+
+(ert-deftest subr-tests--method-files--nonexistent-methods ()
+  "`method-files' returns nil if asked to find a method which doesn't exist."
+  (should-not (method-files 'subr-tests--undefined-generic))
+  (should-not (method-files 'subr-tests--generic-without-methods)))
+
 (provide 'subr-tests)
 ;;; subr-tests.el ends here
-- 
2.12.2