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.
This commit is contained in:
Gemini Lasswell 2017-11-01 21:13:02 -07:00
parent 16358d4fcb
commit 0ded1b41a9
4 changed files with 58 additions and 29 deletions

View file

@ -684,7 +684,7 @@ its argument list allows full Common Lisp conventions."
(defmacro cl-destructuring-bind (args expr &rest body) (defmacro cl-destructuring-bind (args expr &rest body)
"Bind the variables in ARGS to the result of EXPR and execute BODY." "Bind the variables in ARGS to the result of EXPR and execute BODY."
(declare (indent 2) (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) (let* ((cl--bind-lets nil) (cl--bind-forms nil)
(cl--bind-defs nil) (cl--bind-block 'cl-none) (cl--bind-enquote nil)) (cl--bind-defs nil) (cl--bind-block 'cl-none) (cl--bind-enquote nil))
(cl--do-arglist (or args '(&aux)) expr) (cl--do-arglist (or args '(&aux)) expr)

View file

@ -950,7 +950,8 @@ circular objects. Let `read' read everything else."
;;; Cursors for traversal of list and vector elements with offsets. ;;; 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) (defun edebug-new-cursor (expressions offsets)
;; Return a new cursor for EXPRESSIONS with 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. ;;; Matching of specs.
(defvar edebug-after-dotted-spec nil)
(defvar edebug-matching-depth 0) ;; initial value (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. (let ((edebug-dotted-spec t));; Containing spec list was dotted.
(edebug-match-specs cursor (list specs) remainder-handler))) (edebug-match-specs cursor (list specs) remainder-handler)))
;; Is the form dotted? ;; The reason for processing here &optional, &rest, and vectors
((not (listp (edebug-cursor-expressions cursor)));; allow nil ;; 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) (if (not edebug-dotted-spec)
(edebug-no-match cursor "Dotted spec required.")) (edebug-no-match cursor "Dotted spec required."))
;; Cancel dotted spec and dotted form. ;; Cancel dotted spec and dotted form.
(let ((edebug-dotted-spec) (let ((edebug-dotted-spec)
(this-form (edebug-cursor-expressions cursor)) (this-form (edebug-cursor-expressions cursor))
(this-offset (edebug-cursor-offsets cursor))) (this-offset (edebug-cursor-offsets cursor)))
;; Wrap the form in a list, (by changing the cursor??)... ;; Wrap the form in a list, by changing the cursor.
(edebug-set-cursor cursor (list this-form) this-offset) (edebug-set-cursor cursor (list this-form) this-offset)
;; and process normally, then unwrap the result. ;; Process normally, then unwrap the result.
(car (edebug-match-specs cursor specs remainder-handler)))) (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)))))))
;; Define specs for all the symbol specs with functions used to process them. ;; 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 ;; Perhaps we shouldn't be doing this with edebug-form-specs since the

View file

@ -126,5 +126,9 @@
!start!(with-current-buffer (get-buffer-create "*edebug-test-code-buffer*") !start!(with-current-buffer (get-buffer-create "*edebug-test-code-buffer*")
!body!(format "current-buffer: %s" (current-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) (provide 'edebug-test-code)
;;; edebug-test-code.el ends here ;;; edebug-test-code.el ends here

View file

@ -899,5 +899,19 @@ test and possibly others should be updated."
"@g" (should (equal edebug-tests-@-result "@g" (should (equal edebug-tests-@-result
'(#("abcd" 1 3 (face italic)) 511)))))) '(#("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) (provide 'edebug-tests)
;;; edebug-tests.el ends here ;;; edebug-tests.el ends here