diff options
Diffstat (limited to 'test/lisp/emacs-lisp/cl-macs-tests.el')
| -rw-r--r-- | test/lisp/emacs-lisp/cl-macs-tests.el | 75 |
1 files changed, 69 insertions, 6 deletions
diff --git a/test/lisp/emacs-lisp/cl-macs-tests.el b/test/lisp/emacs-lisp/cl-macs-tests.el index 17a84d2067a..19ede627a13 100644 --- a/test/lisp/emacs-lisp/cl-macs-tests.el +++ b/test/lisp/emacs-lisp/cl-macs-tests.el @@ -23,6 +23,7 @@ (require 'cl-lib) (require 'cl-macs) +(require 'edebug) (require 'ert) @@ -529,7 +530,7 @@ collection clause." (should-error ;; Use `eval' so the error is signaled when running the test rather than ;; when macroexpanding it. - (eval '(let ((l (list 1))) (cl-symbol-macrolet ((x 1)) (setq (car l) 0))))) + (eval '(let ((l (list 1))) (cl-symbol-macrolet ((x 1)) (setq (car l) 0))) t)) ;; Make sure `gv-synthetic-place' isn't macro-expanded before `setf' gets to ;; see its `gv-expander'. (should (equal (let ((l '(0))) @@ -637,17 +638,26 @@ collection clause." (/ 1 (logand n 1)) (arith-error (len3 (cdr xs) (1+ n))) (:success (len3 (cdr xs) (+ n k)))) - n))) + n)) + + ;; Tail calls in `cond'. + (len4 (xs n) + (cond (xs (cond (nil 'nevertrue) + ((len4 (cdr xs) (1+ n))))) + (t n)))) (should (equal (len nil 0) 0)) (should (equal (len2 nil 0) 0)) (should (equal (len3 nil 0) 0)) + (should (equal (len4 nil 0) 0)) (should (equal (len list-42 0) 42)) (should (equal (len2 list-42 0) 42)) (should (equal (len3 list-42 0) 42)) + (should (equal (len4 list-42 0) 42)) ;; Should not bump into stack depth limits. (should (equal (len list-42k 0) 42000)) (should (equal (len2 list-42k 0) 42000)) - (should (equal (len3 list-42k 0) 42000)))) + (should (equal (len3 list-42k 0) 42000)) + (should (equal (len4 list-42k 0) 42000)))) ;; Check that non-recursive functions are handled more efficiently. (should (pcase (macroexpand '(cl-labels ((f (x) (+ x 1))) (f 5))) @@ -657,11 +667,64 @@ collection clause." (should (pcase (macroexpand '(cl-labels ((len (xs n) (if xs (len (cdr xs) (1+ n)) n))) #'len)) - (`(function (lambda (,_ ,_) . ,_)) t)))) + (`(function (lambda (,_ ,_) . ,_)) t))) + + ;; Verify that there is no tail position inside dynamic variable bindings. + (defvar dyn-var) + (let ((dyn-var 'a)) + (cl-labels ((f (x) (if x + dyn-var + (let ((dyn-var 'b)) + (f dyn-var))))) + (should (equal (f nil) 'b)))) + + ;; Control: same as above but with lexical binding. + (let ((lex-var 'a)) + (cl-labels ((f (x) (if x + lex-var + (let ((lex-var 'b)) + (f lex-var))))) + (should (equal (f nil) 'a))))) (ert-deftest cl-macs--progv () - (should (= (cl-progv '(test test) '(1 2) test) 2)) - (should (equal (cl-progv '(test1 test2) '(1 2) (list test1 test2)) + (defvar cl-macs--test) + (defvar cl-macs--test1) + (defvar cl-macs--test2) + (should (= (cl-progv '(cl-macs--test cl-macs--test) '(1 2) cl-macs--test) 2)) + (should (equal (cl-progv '(cl-macs--test1 cl-macs--test2) '(1 2) + (list cl-macs--test1 cl-macs--test2)) '(1 2)))) +(ert-deftest cl-define-compiler-macro/edebug () + "Check that we can instrument compiler macros." + (with-temp-buffer + (dolist (form '((defun cl-define-compiler-macro/edebug (a b) nil) + (cl-define-compiler-macro + cl-define-compiler-macro/edebug + (&whole w a b) + w))) + (print form (current-buffer))) + (let ((edebug-all-defs t) + (edebug-initial-mode 'Go-nonstop)) + ;; Just make sure the forms can be instrumented. + (eval-buffer)))) + +(ert-deftest cl-defstruct/edebug () + "Check that we can instrument `cl-defstruct' forms." + (with-temp-buffer + (dolist (form '((cl-defstruct cl-defstruct/edebug/1) + (cl-defstruct (cl-defstruct/edebug/2 + :noinline)) + (cl-defstruct (cl-defstruct/edebug/3 + (:noinline t))) + (cl-defstruct (cl-defstruct/edebug/4 + :named)) + (cl-defstruct (cl-defstruct/edebug/5 + (:named t))))) + (print form (current-buffer))) + (let ((edebug-all-defs t) + (edebug-initial-mode 'Go-nonstop)) + ;; Just make sure the forms can be instrumented. + (eval-buffer)))) + ;;; cl-macs-tests.el ends here |