>From e6120334f29d97a026a3a2b2892d71ad73be0225 Mon Sep 17 00:00:00 2001 From: Gemini Lasswell Date: Wed, 1 Nov 2017 21:13:02 -0700 Subject: [PATCH] Fix Edebug's handling of dotted specs (bug#6415) * lisp/emacs-lisp/cl-macs.el (cl-destructuring-bind): Use cl-macro-list1 instead of cl-macro-list in Edebug spec. * lisp/emacs-lisp/edebug.el (edebug-after-dotted-spec): Delete unused variable. (edebug-dotted-spec): Add docstring. (edebug-match-specs): Allow &optional and &rest specs to match nothing at the tail of a dotted form. Handle matches of dotted form tails which return non-lists. * test/lisp/emacs-lisp/edebug-tests.el (edebug-tests-dotted-forms): New test. * test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el: (edebug-test-code-use-destructuring-bind): New function. --- lisp/emacs-lisp/cl-macs.el | 2 +- lisp/emacs-lisp/edebug.el | 67 +++++++++++++--------- .../edebug-resources/edebug-test-code.el | 4 ++ test/lisp/emacs-lisp/edebug-tests.el | 14 +++++ 4 files changed, 58 insertions(+), 29 deletions(-) diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index e313af2497..5535100d4a 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -684,7 +684,7 @@ cl--arglist-args (defmacro cl-destructuring-bind (args expr &rest body) "Bind the variables in ARGS to the result of EXPR and execute BODY." (declare (indent 2) - (debug (&define cl-macro-list def-form cl-declarations def-body))) + (debug (&define cl-macro-list1 def-form cl-declarations def-body))) (let* ((cl--bind-lets nil) (cl--bind-forms nil) (cl--bind-defs nil) (cl--bind-block 'cl-none) (cl--bind-enquote nil)) (cl--do-arglist (or args '(&aux)) expr) diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 0e8f77e29a..dec986ae3e 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -950,7 +950,8 @@ edebug-read-vector ;;; Cursors for traversal of list and vector elements with offsets. -(defvar edebug-dotted-spec nil) +(defvar edebug-dotted-spec nil + "Set to t when matching after the dot in a dotted spec list.") (defun edebug-new-cursor (expressions offsets) ;; Return a new cursor for EXPRESSIONS with OFFSETS. @@ -1526,8 +1527,6 @@ edebug-list-form ;;; Matching of specs. -(defvar edebug-after-dotted-spec nil) - (defvar edebug-matching-depth 0) ;; initial value @@ -1588,36 +1587,48 @@ edebug-match-specs (let ((edebug-dotted-spec t));; Containing spec list was dotted. (edebug-match-specs cursor (list specs) remainder-handler))) - ;; Is the form dotted? - ((not (listp (edebug-cursor-expressions cursor)));; allow nil + ;; The reason for processing here &optional, &rest, and vectors + ;; which might contain them even when the form is dotted is to + ;; allow them to match nothing, so we can advance to the dotted + ;; part of the spec. + ((or (listp (edebug-cursor-expressions cursor)) + (vectorp (car specs)) + (memq (car specs) '(&optional &rest))) ; Process normally. + ;; (message "%scursor=%s specs=%s" + ;; (make-string edebug-matching-depth ?|) cursor (car specs)) + (let* ((spec (car specs)) + (rest) + (first-char (and (symbolp spec) (aref (symbol-name spec) 0))) + (match (cond + ((eq ?& first-char);; "&" symbols take all following specs. + (funcall (get-edebug-spec spec) cursor (cdr specs))) + ((eq ?: first-char);; ":" symbols take one following spec. + (setq rest (cdr (cdr specs))) + (funcall (get-edebug-spec spec) cursor (car (cdr specs)))) + (t;; Any other normal spec. + (setq rest (cdr specs)) + (edebug-match-one-spec cursor spec))))) + ;; The first match result may not be a list, which can happen + ;; when matching the tail of a dotted list. In that case + ;; there is no remainder. + (if (listp match) + (nconc match + (funcall remainder-handler cursor rest remainder-handler)) + match))) + + ;; Must be a dotted form, with no remaining &rest or &optional specs to + ;; match. + (t (if (not edebug-dotted-spec) (edebug-no-match cursor "Dotted spec required.")) ;; Cancel dotted spec and dotted form. (let ((edebug-dotted-spec) - (this-form (edebug-cursor-expressions cursor)) - (this-offset (edebug-cursor-offsets cursor))) - ;; Wrap the form in a list, (by changing the cursor??)... + (this-form (edebug-cursor-expressions cursor)) + (this-offset (edebug-cursor-offsets cursor))) + ;; Wrap the form in a list, by changing the cursor. (edebug-set-cursor cursor (list this-form) this-offset) - ;; and process normally, then unwrap the result. - (car (edebug-match-specs cursor specs remainder-handler)))) - - (t;; Process normally. - (let* ((spec (car specs)) - (rest) - (first-char (and (symbolp spec) (aref (symbol-name spec) 0)))) - ;;(message "spec = %s first char = %s" spec first-char) (sit-for 1) - (nconc - (cond - ((eq ?& first-char);; "&" symbols take all following specs. - (funcall (get-edebug-spec spec) cursor (cdr specs))) - ((eq ?: first-char);; ":" symbols take one following spec. - (setq rest (cdr (cdr specs))) - (funcall (get-edebug-spec spec) cursor (car (cdr specs)))) - (t;; Any other normal spec. - (setq rest (cdr specs)) - (edebug-match-one-spec cursor spec))) - (funcall remainder-handler cursor rest remainder-handler))))))) - + ;; Process normally, then unwrap the result. + (car (edebug-match-specs cursor specs remainder-handler))))))) ;; Define specs for all the symbol specs with functions used to process them. ;; Perhaps we shouldn't be doing this with edebug-form-specs since the diff --git a/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el b/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el index f52a2b1896..ca49dcd213 100644 --- a/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el +++ b/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el @@ -126,5 +126,9 @@ edebug-test-code-current-buffer !start!(with-current-buffer (get-buffer-create "*edebug-test-code-buffer*") !body!(format "current-buffer: %s" (current-buffer)))) +(defun edebug-test-code-use-destructuring-bind () + (let ((two 2) (three 3)) + (cl-destructuring-bind (x . y) (cons two three) (+ x!x! y!y!)))) + (provide 'edebug-test-code) ;;; edebug-test-code.el ends here diff --git a/test/lisp/emacs-lisp/edebug-tests.el b/test/lisp/emacs-lisp/edebug-tests.el index 02f4d1c5ab..f6c016cdf8 100644 --- a/test/lisp/emacs-lisp/edebug-tests.el +++ b/test/lisp/emacs-lisp/edebug-tests.el @@ -899,5 +899,19 @@ edebug-tests-setup-code-file "@g" (should (equal edebug-tests-@-result '(#("abcd" 1 3 (face italic)) 511)))))) +(ert-deftest edebug-tests-dotted-forms () + "Edebug can instrument code matching the tail of a dotted spec (Bug#6415)." + (edebug-tests-with-normal-env + (edebug-tests-setup-@ "use-destructuring-bind" nil t) + (edebug-tests-run-kbd-macro + "@ SPC SPC SPC SPC SPC SPC" + (edebug-tests-should-be-at "use-destructuring-bind" "x") + (edebug-tests-should-match-result-in-messages "2 (#o2, #x2, ?\\C-b)") + "SPC" + (edebug-tests-should-be-at "use-destructuring-bind" "y") + (edebug-tests-should-match-result-in-messages "3 (#o3, #x3, ?\\C-c)") + "g" + (should (equal edebug-tests-@-result 5))))) + (provide 'edebug-tests) ;;; edebug-tests.el ends here -- 2.14.3