From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED!not-for-mail From: Dmitry Gutov Newsgroups: gmane.emacs.bugs Subject: bug#22294: Patch Date: Mon, 8 May 2017 05:19:28 +0300 Message-ID: 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> NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="------------340116A7B3956DC79401AAC4" X-Trace: blaine.gmane.org 1494210016 20666 195.159.176.226 (8 May 2017 02:20:16 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Mon, 8 May 2017 02:20:16 +0000 (UTC) User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:53.0) Gecko/20100101 Thunderbird/53.0 Cc: 22294@debbugs.gnu.org To: Gemini Lasswell Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Mon May 08 04:20:09 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 1d7YHQ-0005Cw-JF for geb-bug-gnu-emacs@m.gmane.org; Mon, 08 May 2017 04:20:08 +0200 Original-Received: from localhost ([::1]:57336 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1d7YHW-000106-57 for geb-bug-gnu-emacs@m.gmane.org; Sun, 07 May 2017 22:20:14 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:47552) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1d7YHP-0000xa-1b for bug-gnu-emacs@gnu.org; Sun, 07 May 2017 22:20:09 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1d7YHK-0005da-Vu for bug-gnu-emacs@gnu.org; Sun, 07 May 2017 22:20:07 -0400 Original-Received: from debbugs.gnu.org ([208.118.235.43]:34539) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1d7YHK-0005dS-QI for bug-gnu-emacs@gnu.org; Sun, 07 May 2017 22:20:02 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1d7YHK-0003rn-DQ for bug-gnu-emacs@gnu.org; Sun, 07 May 2017 22:20:02 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Dmitry Gutov Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Mon, 08 May 2017 02:20: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.149420997814824 (code B ref 22294); Mon, 08 May 2017 02:20:02 +0000 Original-Received: (at 22294) by debbugs.gnu.org; 8 May 2017 02:19:38 +0000 Original-Received: from localhost ([127.0.0.1]:60971 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1d7YGw-0003r1-7y for submit@debbugs.gnu.org; Sun, 07 May 2017 22:19:38 -0400 Original-Received: from mail-wm0-f53.google.com ([74.125.82.53]:35832) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1d7YGu-0003qn-OS for 22294@debbugs.gnu.org; Sun, 07 May 2017 22:19:37 -0400 Original-Received: by mail-wm0-f53.google.com with SMTP id b84so38649225wmh.0 for <22294@debbugs.gnu.org>; Sun, 07 May 2017 19:19:36 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=sender:subject:to:cc:references:from:message-id:date:user-agent :mime-version:in-reply-to:content-language; bh=fh8fcnO9NUd9vZC1AGDO+L2eArA4vul7kBeZI/VP0qc=; b=L3OevfiOwGgU8s+VGRSpVOrcd0dEyZGp92xgfs+G9TKF735xAwdMkZ1N9GXj5NCmTI FpcV1/XR20t1Q3Nq++hktWX523VsuK3fL1/IHM1BqbRJGs4WS4UjrLQvJ/htQ8ST5ed4 i3w8KuoxKyXpm3bCnpudiVAs1tF9hQBZRmEV7uv1U4L6NYh4rgj10ZlfJKeJjXgx8p4r AwtL4WG1pcT3i4Q5pqr4vVNO29n2ZdssDZr4ceeZwwP6s4kRn7HOrFr34uIUcUOgsBYw uJS4CCciQop/7oGc+gXEW7sEivCbkFxTlIpIlfsy0q+d+62zIueYMWVlYSIsgGenV9yZ hJmA== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:sender:subject:to:cc:references:from:message-id :date:user-agent:mime-version:in-reply-to:content-language; bh=fh8fcnO9NUd9vZC1AGDO+L2eArA4vul7kBeZI/VP0qc=; b=DhGgMsMxrbdcAGMIeLUmqS0TngUIHKPL89q91ODiO0RHw5cyZ5cjNwKiO5tOwjpuyT FFMCDLN1RaG0jMqDRgRyFsWyCWbqTNluW3/4fSKcpKQzaDgtXm4Jxj03gt6nDQFSvPib hn7eiBcKjbt6T8t4IgVDsUkb8SMqwQ4WTfGfoCIz3SLQdVqKWEbDfZCCHrMbA9pIAj2a 4artjCBkKWWEhsmR4LA3iM62PzTLwT/aBHK4XOg3WFOcJdMJdtdEImari7IyOW3GKPnj 33/0IEaRz2mizL8yahgbMO6Ar1UBOgpGu0xhqS79g37tZlsxCwSnXKNQSJhYKt7Rb5fN E/eg== X-Gm-Message-State: AN3rC/68Cj1mQeSZk++de9i+R67FULtJYFMVZxfGpN8coeX+ysjt7Og0 SqvVzOkUvrZJTg== X-Received: by 10.28.20.84 with SMTP id 81mr11515366wmu.51.1494209970913; Sun, 07 May 2017 19:19:30 -0700 (PDT) Original-Received: from [192.168.1.3] ([185.105.173.156]) by smtp.googlemail.com with ESMTPSA id 30sm9397915wrp.6.2017.05.07.19.19.29 (version=TLS1_2 cipher=ECDHE-RSA-AES128-GCM-SHA256 bits=128/128); Sun, 07 May 2017 19:19:30 -0700 (PDT) In-Reply-To: <87efw08l99.fsf@chinook> Content-Language: en-US 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:132365 Archived-At: This is a multi-part message in MIME format. --------------340116A7B3956DC79401AAC4 Content-Type: text/plain; charset=utf-8; format=flowed Content-Transfer-Encoding: 7bit On 07.05.2017 23:28, Gemini Lasswell wrote: > Actually the arguments are not known because they have not yet been > evaluated when edebug-step-in is invoked. So it would have to set a > breakpoint after argument evaluation, run the code under debugging > until it gets to that breakpoint, look at the evaluated arguments, > figure out what method to instrument, instrument the method and set a > breakpoint in it, and then run again. Very good point, it sounds like a pain. Fixing the edebug name for cl-defmethod seems like it should be a smaller effort. I've tried to do that via a new edebug spec for method arguments, see the attached variation of your patch (only partially tested). Unfortunately, this code fails when instrumenting a generic method (e.g. using C-u C-M-x) with something like: Unknown specializer foo@setf\ \(v\ \(_y\ \(eql\ 4\)\)\ z\) Any thoughts? edebug-match-method-args is definitely at fault there, but I'm not sure how to improve it. > I have started writing tests for > Edebug, as a step towards making it possible to improve it without > worrying about breaking things that are working. Probably it will help > me understand the code in there better too. Sounds great. > Here's a revised patch. Thanks for letting me know about pcase-dolist > as it looks very useful. It's not documented and I didn't know it > existed. I usually find those via normal introspection. Try typing 'C-h f pcase- TAB' and looking at the "public" names (without the double-dash in their name). --------------340116A7B3956DC79401AAC4 Content-Type: text/x-patch; name="0002-edebug-and-defmethod.diff" Content-Transfer-Encoding: 7bit Content-Disposition: attachment; filename="0002-edebug-and-defmethod.diff" diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index 068f4fb..a4da02a 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 + 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 4116e31..5f295ac 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) + (method-args . edebug-match-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-method-args (cursor) + (let ((args (edebug-top-element-required cursor "Expected arguments"))) + (if (not (listp 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) + nil)) + (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 fe65ae0..c073b1a 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 + method-args ; arguments [ &optional stringp ] ; documentation string def-body ; part to be debugged ))) diff --git a/lisp/subr.el b/lisp/subr.el index 02e7993..8d5d2a7 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 0d243cc..4a355bd 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 --------------340116A7B3956DC79401AAC4--