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.

diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index e313af249757b2939a87e6b267daaf551e557d15..5535100d4aea2d64b64c0b5e02f8a4bd3ae9c3c2 100644 (file)
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -684,7 +684,7 @@ its argument list allows full Common Lisp conventions."
 (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 d00b14e803e7f9b34e02184b9177621c9a70b30c..217bc2c906bd5a05675aa18ef4a05407cdc9fa23 100644 (file)
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -950,7 +950,8 @@ circular objects.  Let `read' read everything else."
 
 ;;; 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.
@@ -1494,8 +1495,6 @@ expressions; a `progn' form will be returned enclosing these forms."
 
 ;;; Matching of specs.
 
-(defvar edebug-after-dotted-spec nil)
-
 (defvar edebug-matching-depth 0)  ;; initial value
 
 
@@ -1556,36 +1555,48 @@ expressions; a `progn' form will be returned enclosing these forms."
       (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 f52a2b1896c823a57d39510a86fcb7b5c73ddbbc..ca49dcd213d97d9f1e803e7f63080d8fc243e59e 100644 (file)
--- 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 @@
   !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 02f4d1c5abe18cd5f50cfba9cacdc81a615bae79..f6c016cdf80a0ffe8b5a605b4d069c935f189556 100644 (file)
--- a/test/lisp/emacs-lisp/edebug-tests.el
+++ b/test/lisp/emacs-lisp/edebug-tests.el
@@ -899,5 +899,19 @@ test and possibly others should be updated."
     "@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