diff options
Diffstat (limited to 'test/lisp/emacs-lisp/cl-macs-tests.el')
| -rw-r--r-- | test/lisp/emacs-lisp/cl-macs-tests.el | 63 |
1 files changed, 47 insertions, 16 deletions
diff --git a/test/lisp/emacs-lisp/cl-macs-tests.el b/test/lisp/emacs-lisp/cl-macs-tests.el index bcd63f73a3c..f4e2e46a019 100644 --- a/test/lisp/emacs-lisp/cl-macs-tests.el +++ b/test/lisp/emacs-lisp/cl-macs-tests.el @@ -4,18 +4,18 @@ ;; This file is part of GNU Emacs. -;; This program 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. -;; -;; This program 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. -;; +;; 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 this program. If not, see `https://www.gnu.org/licenses/'. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: @@ -617,11 +617,37 @@ collection clause." (cl-labels ((len (xs) (if xs (1+ (len (cdr xs))) 0))) (should (equal (len (make-list 42 t)) 42))) - ;; Simple tail-recursive function. - (cl-labels ((len (xs n) (if xs (len (cdr xs) (1+ n)) n))) - (should (equal (len (make-list 42 t) 0) 42)) - ;; Should not bump into stack depth limits. - (should (equal (len (make-list 42000 t) 0) 42000))) + (let ((list-42 (make-list 42 t)) + (list-42k (make-list 42000 t))) + + (cl-labels + ;; Simple tail-recursive function. + ((len (xs n) (if xs (len (cdr xs) (1+ n)) n)) + ;; Slightly obfuscated version to exercise tail calls from + ;; `let', `progn', `and' and `or'. + (len2 (xs n) (or (and (not xs) n) + (let (n1) + (and xs + (progn (setq n1 (1+ n)) + (len2 (cdr xs) n1)))))) + ;; Tail calls in error and success handlers. + (len3 (xs n) + (if xs + (condition-case k + (/ 1 (logand n 1)) + (arith-error (len3 (cdr xs) (1+ n))) + (:success (len3 (cdr xs) (+ n k)))) + n))) + (should (equal (len nil 0) 0)) + (should (equal (len2 nil 0) 0)) + (should (equal (len3 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 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)))) ;; Check that non-recursive functions are handled more efficiently. (should (pcase (macroexpand '(cl-labels ((f (x) (+ x 1))) (f 5))) @@ -633,4 +659,9 @@ collection clause." #'len)) (`(function (lambda (,_ ,_) . ,_)) t)))) +(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)) + '(1 2)))) + ;;; cl-macs-tests.el ends here |