b939f7ad35
This allows the use of (declare (debug ...)) in the lexical macros defined with `cl-macrolet`. It also fixes the names used by Edebug for the methods of `cl-generic` so it doesn't need to use gensym and so they don't include the formal arg names any more. * lisp/emacs-lisp/edebug.el (edebug--match-&-spec-op): Rename from `edebug--handle-&-spec-op`. (edebug--match-&-spec-op <&interpose>): Rename from `&lookup` and generalize so it can let-bind dynamic variables around the rest of the parse. (edebug-lexical-macro-ctx): Rename from `edebug--cl-macrolet-defs` and make it into an alist. (edebug-list-form-args): Use the specs from `edebug-lexical-macro-ctx` when available. (edebug--current-cl-macrolet-defs): Delete var. (edebug-match-cl-macrolet-expr, edebug-match-cl-macrolet-name) (edebug-match-cl-macrolet-body): Delete functions. (def-declarations): Use new `&interpose`. (edebug--match-declare-arg): Rename from `edebug--get-declare-spec` and adjust to new calling convention. * lisp/subr.el (def-edebug-elem-spec): Fix docstring. (eval-after-load): Use `declare`. * lisp/emacs-lisp/cl-generic.el: Fix Edebug names so we don't need gensym any more and we only include the specializers but not the formal arg names. (cl--generic-edebug-name): New var. (cl--generic-edebug-remember-name, cl--generic-edebug-make-name): New funs. (cl-defgeneric, cl-defmethod): Use them. * lisp/emacs-lisp/cl-macs.el: Add support for `debug` declarations in `cl-macrolet`. (cl-declarations-or-string): Fix use of `lambda-doc` and allow use of `declare`. (edebug-lexical-macro-ctx): Declare var. (cl--edebug-macrolet-interposer): New function. (cl-macrolet): Use it to pass the right `lexical-macro-ctx` to the body. * lisp/emacs-lisp/pcase.el (pcase-PAT): Use new `&interpose`. (pcase--edebug-match-pat-args): Rename from `pcase--get-edebug-spec` and adjust to new calling convention. * test/lisp/emacs-lisp/cl-generic-tests.el (cl-defgeneric/edebug/method): Adjust to the new names. * test/lisp/emacs-lisp/edebug-tests.el (edebug-cl-defmethod-qualifier) (edebug-tests-cl-flet): Adjust to the new names. * doc/lispref/edebug.texi (Specification List): Document &interpose.
157 lines
5 KiB
EmacsLisp
157 lines
5 KiB
EmacsLisp
;;; edebug-test-code.el --- Sample code for the Edebug test suite -*- lexical-binding:t -*-
|
|
|
|
;; Copyright (C) 2017-2021 Free Software Foundation, Inc.
|
|
|
|
;; Author: Gemini Lasswell
|
|
|
|
;; This file is part of GNU Emacs.
|
|
|
|
;; GNU Emacs is free software: you can redistribute it and/or modify
|
|
;; it under the terms of the GNU General Public License as published by
|
|
;; the Free Software Foundation, either version 3 of the License, or
|
|
;; (at your option) any later version.
|
|
|
|
;; GNU Emacs is distributed in the hope that it will be useful,
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
;; GNU General Public License for more details.
|
|
|
|
;; You should have received a copy of the GNU General Public License
|
|
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
|
|
|
;;; Commentary:
|
|
|
|
;; This file contains sample code used by edebug-tests.el.
|
|
;; Before evaluation, it will be preprocessed by
|
|
;; `edebug-tests-setup-code-file' which will remove all tags
|
|
;; between !'s and save their positions for use by the tests.
|
|
|
|
;;; Code:
|
|
|
|
(defun edebug-test-code-fac (n)
|
|
!start!(if !step!(< 0 n)
|
|
(* n (edebug-test-code-fac (1- n)))!mult!
|
|
1))
|
|
|
|
(defun edebug-test-code-concat (a b flag)
|
|
!start!(if flag!flag!
|
|
!then-start!(concat a!then-a! b!then-b!)!then-concat!
|
|
!else-start!(concat b!else-b! a!else-a!)!else-concat!)!if!)
|
|
|
|
(defun edebug-test-code-range (num)
|
|
!start!(let ((index 0)
|
|
(result nil))
|
|
(while !lt!(< index num)!test!
|
|
(push index result)!loop!
|
|
(cl-incf index))!end-loop!
|
|
(nreverse result)))
|
|
|
|
(defun edebug-test-code-choices (input)
|
|
!start!(cond
|
|
((eq input 0) "zero")
|
|
((eq input 7) 42)
|
|
(t !edebug!(edebug))))
|
|
|
|
(defvar edebug-test-code-total nil)
|
|
|
|
(defun edebug-test-code-multiply (times value)
|
|
!start!(setq edebug-test-code-total 0)
|
|
(cl-dotimes (index times)
|
|
(setq edebug-test-code-total (+ edebug-test-code-total value))!setq!)
|
|
edebug-test-code-total)
|
|
|
|
(defun edebug-test-code-format-vector-node (node)
|
|
!start!(concat "["
|
|
(apply #'concat (mapcar #'edebug-test-code-format-node node))!apply!
|
|
"]"))
|
|
|
|
(defun edebug-test-code-format-list-node (node)
|
|
!start!(concat "{"
|
|
(apply #'concat (mapcar #'edebug-test-code-format-node node))!apply!
|
|
"}"))
|
|
|
|
(defun edebug-test-code-format-node (node)
|
|
!start!(cond
|
|
(!vectorp!(vectorp node!vnode!)!vtest! !vbefore!(edebug-test-code-format-vector-node node))
|
|
((listp node) (edebug-test-code-format-list-node node))
|
|
(t (format "%s" node))))
|
|
|
|
(defvar edebug-test-code-flavor "strawberry")
|
|
|
|
(defmacro edebug-test-code-with-flavor (new-flavor &rest body)
|
|
(declare (debug (form body))
|
|
(indent 1))
|
|
`(let ((edebug-test-code-flavor ,new-flavor))
|
|
,@body))
|
|
|
|
(defun edebug-test-code-try-flavors ()
|
|
(let* (tried)
|
|
(push edebug-test-code-flavor tried)
|
|
!macro!(edebug-test-code-with-flavor "chocolate"
|
|
(push edebug-test-code-flavor tried))
|
|
tried)!end!)
|
|
|
|
(unless (featurep 'edebug-tests-nutty)!nutty!
|
|
!setq!(setq edebug-test-code-flavor (car (edebug-test-code-try-flavors)))!end-setq!)!end-unless!
|
|
|
|
(cl-defgeneric edebug-test-code-emphasize (x))
|
|
(cl-defmethod edebug-test-code-emphasize ((x integer))
|
|
!start!(format "The number is not %s or %s, but %s!"
|
|
(1+ x) (1- x) x))
|
|
(cl-defmethod edebug-test-code-emphasize ((x string))
|
|
!start!(format "***%s***" x))
|
|
|
|
(defun edebug-test-code-use-methods ()
|
|
(list
|
|
!number!(edebug-test-code-emphasize 100)
|
|
!string!(edebug-test-code-emphasize "yes")))
|
|
|
|
(defun edebug-test-code-make-lambda (n)
|
|
(lambda (x) (+ x!x! n)))
|
|
|
|
(defun edebug-test-code-use-lambda ()
|
|
!start!(mapcar (edebug-test-code-make-lambda 10) '(1 2 3)))
|
|
|
|
(defun edebug-test-code-circular-read-syntax ()
|
|
'(#1=a . #1#))
|
|
|
|
(defun edebug-test-code-hash-read-syntax ()
|
|
!start!(list #("abcd" 1 3 (face italic))
|
|
#x01ff))
|
|
|
|
(defun edebug-test-code-empty-string-list ()
|
|
!start!(list "")!step!)
|
|
|
|
(defun 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!))))
|
|
|
|
(defun edebug-test-code-use-cl-macrolet (x)
|
|
(cl-macrolet ((wrap (func &rest args)
|
|
`(format "The result of applying %s to %s is %S"
|
|
',func!func! ',args
|
|
,(cons func args))))
|
|
(wrap + 1 x)))
|
|
|
|
(defun edebug-test-code-cl-flet1 ()
|
|
(cl-flet
|
|
;; This `&rest' sexp head should not collide with
|
|
;; the Edebug spec elem of the same name.
|
|
((f (&rest x) x)
|
|
(gate (x) (+ x 5)))
|
|
;; This call to `gate' shouldn't collide with the Edebug spec elem
|
|
;; of the same name.
|
|
(message "Hi %s" (gate 7))))
|
|
|
|
(defun edebug-test-code-use-gv-expander (x)
|
|
(declare (gv-expander
|
|
(lambda (do)
|
|
(funcall do `(car ,x) (lambda (v) `(setcar ,x ,v))))))
|
|
(car x))
|
|
|
|
(provide 'edebug-test-code)
|
|
;;; edebug-test-code.el ends here
|