mirror of
https://github.com/masscollaborationlabs/emacs.git
synced 2025-07-04 19:29:37 +00:00
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:
parent
16358d4fcb
commit
0ded1b41a9
4 changed files with 58 additions and 29 deletions
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue