From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED!not-for-mail From: Gemini Lasswell Newsgroups: gmane.emacs.bugs Subject: bug#22294: Generating Edebug names for generic methods Date: Sat, 13 May 2017 13:58:08 -0700 Message-ID: <87wp9kwk2n.fsf@runbox.com> References: <8637uf24px.fsf@yandex.ru> <3c954fc5-fda2-1c30-a251-e2f3fecd8534@yandex.ru> <871ssevk4e.fsf_-_@runbox.com> <793941ae-4e88-80ef-3ac7-7bd5019b97f7@yandex.ru> <87efw08l99.fsf@chinook> <87zielwb82.fsf_-_@runbox.com> <3070039f-caf2-3e58-e3d3-afb8eac5152f@yandex.ru> NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: blaine.gmane.org 1494709157 22543 195.159.176.226 (13 May 2017 20:59:17 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Sat, 13 May 2017 20:59:17 +0000 (UTC) User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/25.1 (gnu/linux) Cc: 22294@debbugs.gnu.org, monnier@iro.umontreal.ca To: Dmitry Gutov Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Sat May 13 22:59:12 2017 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by blaine.gmane.org with esmtp (Exim 4.84_2) (envelope-from ) id 1d9e83-0005eT-Q9 for geb-bug-gnu-emacs@m.gmane.org; Sat, 13 May 2017 22:59:08 +0200 Original-Received: from localhost ([::1]:58804 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1d9e89-0004qs-3e for geb-bug-gnu-emacs@m.gmane.org; Sat, 13 May 2017 16:59:13 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:56063) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1d9e82-0004qc-7y for bug-gnu-emacs@gnu.org; Sat, 13 May 2017 16:59:08 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1d9e7z-0005ZC-5T for bug-gnu-emacs@gnu.org; Sat, 13 May 2017 16:59:06 -0400 Original-Received: from debbugs.gnu.org ([208.118.235.43]:40612) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1d9e7y-0005Yh-Ni for bug-gnu-emacs@gnu.org; Sat, 13 May 2017 16:59:03 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1d9e7y-0003o7-E7 for bug-gnu-emacs@gnu.org; Sat, 13 May 2017 16:59:02 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Gemini Lasswell Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Sat, 13 May 2017 20:59:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 22294 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: Original-Received: via spool by 22294-submit@debbugs.gnu.org id=B22294.149470910914597 (code B ref 22294); Sat, 13 May 2017 20:59:02 +0000 Original-Received: (at 22294) by debbugs.gnu.org; 13 May 2017 20:58:29 +0000 Original-Received: from localhost ([127.0.0.1]:43289 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1d9e7R-0003nM-37 for submit@debbugs.gnu.org; Sat, 13 May 2017 16:58:29 -0400 Original-Received: from aibo.runbox.com ([91.220.196.211]:49594) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1d9e7P-0003nE-D5 for 22294@debbugs.gnu.org; Sat, 13 May 2017 16:58:28 -0400 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=runbox.com; s=rbselector1; h=Content-Type:MIME-Version:Message-ID:In-Reply-To:Date: References:Subject:Cc:To:From; bh=ZyUKvk738yjvoEBskOY1+YqKwtKfU6WQaCoOhs1d1VI=; b=SZbn9C2MjGa84J/tk+Gfh+mrRI YLzH2pjEC8hb/xaco4mPzpuy4iSWeK9Nb/QqoklIz2YIPEdHwf7x1hrD8g9RNoO2ngmfXL9TEEPzi FVoZHPwhx/pheKb7X7bG4YQC5O2VYAcwr8VOTpVfmA19UnqpIl/3rOkMLdYkpvkawc3H58j6L2Z2W JO7vd6LUnYCD/Ni5Aa5Uqy/2LHFVuHHm9qd1v05g00iOmPMGOUMJbkEmHnRst4Zn2MC1kBVb1G8YV o0mzQKiHzEOnC0LjnT19DnEukP0Rf7yARV/k9pWtBcv6vvGO2jNZMmbkqIxx4WN71D00sYQ3DAaha uluroZqg==; Original-Received: from [10.9.9.210] (helo=mailfront10.runbox.com) by mailtransmit03.runbox with esmtp (Exim 4.86_2) (envelope-from ) id 1d9e7K-0003Ey-9d; Sat, 13 May 2017 22:58:22 +0200 Original-Received: from c-24-22-244-161.hsd1.wa.comcast.net ([24.22.244.161] helo=chinook) by mailfront10.runbox.com with esmtpsa (uid:179284 ) (TLS1.2:RSA_AES_256_CBC_SHA1:256) (Exim 4.82) id 1d9e79-00075f-K2; Sat, 13 May 2017 22:58:12 +0200 In-Reply-To: <3070039f-caf2-3e58-e3d3-afb8eac5152f@yandex.ru> (Dmitry Gutov's message of "Wed, 10 May 2017 17:18:42 +0300") X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 208.118.235.43 X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Original-Sender: "bug-gnu-emacs" Xref: news.gmane.org gmane.emacs.bugs:132486 Archived-At: --=-=-= Content-Type: text/plain Dmitry Gutov writes: > On 10.05.2017 8:07, Gemini Lasswell wrote: > > It works well in my testing, and it avoids introducing the dynamic > variable. I'll commit it in your name (since you did most of the work > anyway) if you like it. It works in my testing too. Here's a revised version of the patch with your changes incorporated and a couple of other changes too. Since a method's argument list is supposed to be a list but not nil, I changed the test for a valid one from listp to consp. I also changed the names of method-args and edebug-match-method-args to cl-generic-method-args and edebug-match-cl-generic-method-args to better associate them with the code that uses them, and to avoid the idea that this might be new Edebug specification list functionality that should really be documented. That documentation already is complex enough that it's hard to understand and doesn't need any new complex things added to it. But if you don't like the name change feel free to change it back. --=-=-= Content-Type: text/plain Content-Disposition: attachment; filename=0001-Make-edebug-step-in-work-on-generic-methods-Bug-2229.patch >From f0e50bcfc4e9b80a0975151db8ad18cecf22b719 Mon Sep 17 00:00:00 2001 From: Gemini Lasswell Date: Sat, 13 May 2017 11:35:49 -0700 Subject: [PATCH] Make edebug-step-in work on generic methods (Bug#22294) * lisp/emacs-lisp/edebug.el (edebug-match-cl-generic-method-args): New function to implement the edebug-form-spec property of the symbol cl-generic-method-args. (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/emacs-lisp/cl-generic.el (cl-defmethod): Use name and cl-generic-method-args in its Edebug spec. * lisp/emacs-lisp/eieio-compat.el (defmethod): Use name and cl-generic-method-args in its Edebug spec. * 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/cl-generic.el | 4 ++-- lisp/emacs-lisp/edebug.el | 53 ++++++++++++++++++++++++++++++++--------- lisp/emacs-lisp/eieio-compat.el | 4 ++-- lisp/subr.el | 19 +++++++++++++++ test/lisp/subr-tests.el | 25 +++++++++++++++++++ 5 files changed, 90 insertions(+), 15 deletions(-) diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index 068f4fb0c8..c64376b940 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -413,12 +413,12 @@ cl-defmethod (declare (doc-string 3) (indent 2) (debug (&define ; this means we are defining something - [&or symbolp ("setf" symbolp)] + [&or name ("setf" name :name setf)] ;; ^^ This is the methods symbol [ &rest atom ] ; Multiple qualifiers are allowed. ; Like in CLOS spec, we support ; any non-list values. - listp ; arguments + cl-generic-method-args ; arguments [ &optional stringp ] ; documentation string def-body))) ; part to be debugged (let ((qualifiers nil)) diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 4116e31d0a..65e30f8677 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -1607,6 +1607,7 @@ edebug-match-specs ;; Less frequently used: ;; (function . edebug-match-function) (lambda-expr . edebug-match-lambda-expr) + (cl-generic-method-args . edebug-match-cl-generic-method-args) (¬ . edebug-match-¬) (&key . edebug-match-&key) (place . edebug-match-place) @@ -1900,6 +1901,16 @@ edebug-match-colon-name spec)) nil) +(defun edebug-match-cl-generic-method-args (cursor) + (let ((args (edebug-top-element-required cursor "Expected arguments"))) + (if (not (consp args)) + (edebug-no-match cursor "List expected")) + ;; Append the arguments to edebug-def-name. + (setq edebug-def-name + (intern (format "%s %s" edebug-def-name args))) + (edebug-move-cursor cursor) + (list args))) + (defun edebug-match-arg (cursor) ;; set the def-args bound in edebug-defining-form (let ((edebug-arg (edebug-top-element-required cursor "Expected arg"))) @@ -3186,8 +3197,11 @@ edebug-step-out ))))) (defun edebug-instrument-function (func) - ;; Func should be a function symbol. - ;; Return the function symbol, or nil if not instrumented. + "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))) (cond ((and (markerp func-marker) (marker-buffer func-marker)) @@ -3195,10 +3209,24 @@ edebug-instrument-function (with-current-buffer (marker-buffer func-marker) (goto-char func-marker) (edebug-eval-top-level-form) - func)) + (list func))) ((consp func-marker) (message "%s is already instrumented." func) - func) + (list func)) + ((get func 'cl--generic) + (let ((method-defs (method-files func)) + symbols) + (unless method-defs + (error "Could not find any method definitions for %s" func)) + (pcase-dolist (`(,file . ,spec) method-defs) + (let* ((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) + (push (edebug-form-data-symbol) symbols)))) + symbols)) (t (let ((loc (find-function-noselect func t))) (unless (cdr loc) @@ -3206,13 +3234,16 @@ edebug-instrument-function (with-current-buffer (car loc) (goto-char (cdr loc)) (edebug-eval-top-level-form) - func)))))) + (list func))))))) (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 +3258,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/emacs-lisp/eieio-compat.el b/lisp/emacs-lisp/eieio-compat.el index fe65ae0262..e6e6d11870 100644 --- a/lisp/emacs-lisp/eieio-compat.el +++ b/lisp/emacs-lisp/eieio-compat.el @@ -105,10 +105,10 @@ defmethod (declare (doc-string 3) (obsolete cl-defmethod "25.1") (debug (&define ; this means we are defining something - [&or symbolp ("setf" symbolp)] + [&or name ("setf" name :name setf)] ;; ^^ This is the methods symbol [ &optional symbolp ] ; this is key :before etc - listp ; arguments + cl-generic-method-args ; arguments [ &optional stringp ] ; documentation string def-body ; part to be debugged ))) diff --git a/lisp/subr.el b/lisp/subr.el index 02e7993223..8d5d2a779c 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 --=-=-=--