diff options
Diffstat (limited to 'test/lisp/emacs-lisp')
| -rw-r--r-- | test/lisp/emacs-lisp/bytecomp-tests.el | 3 | ||||
| -rw-r--r-- | test/lisp/emacs-lisp/cl-macs-tests.el | 13 | ||||
| -rw-r--r-- | test/lisp/emacs-lisp/eieio-tests/eieio-tests.el | 12 | ||||
| -rw-r--r-- | test/lisp/emacs-lisp/ert-tests.el | 69 | ||||
| -rw-r--r-- | test/lisp/emacs-lisp/ert-x-tests.el | 8 | ||||
| -rw-r--r-- | test/lisp/emacs-lisp/pp-resources/code-formats.erts | 124 | ||||
| -rw-r--r-- | test/lisp/emacs-lisp/pp-tests.el | 4 | ||||
| -rw-r--r-- | test/lisp/emacs-lisp/subr-x-tests.el | 38 |
8 files changed, 226 insertions, 45 deletions
diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index a6e224b3d2c..41edc1f8289 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -640,6 +640,9 @@ inner loops respectively." (f (list (lambda (x) (setq a x))))) (funcall (car f) 3) (list a b)) + + (cond) + (mapcar (lambda (x) (cond ((= x 0)))) '(0 1)) ) "List of expressions for cross-testing interpreted and compiled code.") diff --git a/test/lisp/emacs-lisp/cl-macs-tests.el b/test/lisp/emacs-lisp/cl-macs-tests.el index f4e2e46a019..033764a7f98 100644 --- a/test/lisp/emacs-lisp/cl-macs-tests.el +++ b/test/lisp/emacs-lisp/cl-macs-tests.el @@ -637,17 +637,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))) diff --git a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el index 9eb7fb02230..ba2e5f7be4a 100644 --- a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el +++ b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el @@ -969,6 +969,18 @@ Subclasses to override slot attributes.") (should (eieio-instance-inheritor-slot-boundp C :b)) (should-not (eieio-instance-inheritor-slot-boundp C :c)))) +;;;; Interaction with defstruct + +(cl-defstruct eieio-test--struct a b c) + +(ert-deftest eieio-test-defstruct-slot-value () + (let ((x (make-eieio-test--struct :a 'A :b 'B :c 'C))) + (should (eq (eieio-test--struct-a x) + (slot-value x 'a))) + (should (eq (eieio-test--struct-b x) + (slot-value x 'b))) + (should (eq (eieio-test--struct-c x) + (slot-value x 'c))))) (provide 'eieio-tests) diff --git a/test/lisp/emacs-lisp/ert-tests.el b/test/lisp/emacs-lisp/ert-tests.el index a18664bba3b..79576d24032 100644 --- a/test/lisp/emacs-lisp/ert-tests.el +++ b/test/lisp/emacs-lisp/ert-tests.el @@ -695,49 +695,40 @@ This macro is used to test if macroexpansion in `should' works." (should (equal (ert--abbreviate-string "bar" 0 t) ""))) (ert-deftest ert-test-explain-equal-string-properties () - (should - (equal (ert--explain-equal-including-properties #("foo" 0 1 (a b)) - "foo") - '(char 0 "f" - (different-properties-for-key a (different-atoms b nil)) - context-before "" - context-after "oo"))) - (should (equal (ert--explain-equal-including-properties + (should-not (ert--explain-equal-including-properties-rec "foo" "foo")) + (should-not (ert--explain-equal-including-properties-rec + #("foo" 0 3 (a b)) + (propertize "foo" 'a 'b))) + (should-not (ert--explain-equal-including-properties-rec + #("foo" 0 3 (a b c d)) + (propertize "foo" 'a 'b 'c 'd))) + (should-not (ert--explain-equal-including-properties-rec + #("foo" 0 3 (a (t))) + (propertize "foo" 'a (list t)))) + + (should (equal (ert--explain-equal-including-properties-rec + #("foo" 0 3 (a b c e)) + (propertize "foo" 'a 'b 'c 'd)) + '(char 0 "f" (different-properties-for-key c (different-atoms e d)) + context-before "" + context-after "oo"))) + (should (equal (ert--explain-equal-including-properties-rec + #("foo" 0 1 (a b)) + "foo") + '(char 0 "f" + (different-properties-for-key a (different-atoms b nil)) + context-before "" + context-after "oo"))) + (should (equal (ert--explain-equal-including-properties-rec #("foo" 1 3 (a b)) #("goo" 0 1 (c d))) '(array-elt 0 (different-atoms (?f "#x66" "?f") (?g "#x67" "?g"))))) - (should - (equal (ert--explain-equal-including-properties - #("foo" 0 1 (a b c d) 1 3 (a b)) - #("foo" 0 1 (c d a b) 1 2 (a foo))) - '(char 1 "o" (different-properties-for-key a (different-atoms b foo)) - context-before "f" context-after "o")))) - -(ert-deftest ert-test-equal-including-properties () - (should (equal-including-properties "foo" "foo")) - (should (ert-equal-including-properties "foo" "foo")) - - (should (equal-including-properties #("foo" 0 3 (a b)) - (propertize "foo" 'a 'b))) - (should (ert-equal-including-properties #("foo" 0 3 (a b)) - (propertize "foo" 'a 'b))) - - (should (equal-including-properties #("foo" 0 3 (a b c d)) - (propertize "foo" 'a 'b 'c 'd))) - (should (ert-equal-including-properties #("foo" 0 3 (a b c d)) - (propertize "foo" 'a 'b 'c 'd))) - - (should-not (equal-including-properties #("foo" 0 3 (a b c e)) - (propertize "foo" 'a 'b 'c 'd))) - (should-not (ert-equal-including-properties #("foo" 0 3 (a b c e)) - (propertize "foo" 'a 'b 'c 'd))) - - ;; This is bug 6581. - (should-not (equal-including-properties #("foo" 0 3 (a (t))) - (propertize "foo" 'a (list t)))) - (should (ert-equal-including-properties #("foo" 0 3 (a (t))) - (propertize "foo" 'a (list t))))) + (should (equal (ert--explain-equal-including-properties-rec + #("foo" 0 1 (a b c d) 1 3 (a b)) + #("foo" 0 1 (c d a b) 1 2 (a foo))) + '(char 1 "o" (different-properties-for-key a (different-atoms b foo)) + context-before "f" context-after "o")))) (ert-deftest ert-test-stats-set-test-and-result () (let* ((test-1 (make-ert-test :name 'test-1 diff --git a/test/lisp/emacs-lisp/ert-x-tests.el b/test/lisp/emacs-lisp/ert-x-tests.el index 9f40a18d343..1784934acb3 100644 --- a/test/lisp/emacs-lisp/ert-x-tests.el +++ b/test/lisp/emacs-lisp/ert-x-tests.el @@ -90,10 +90,10 @@ "foo baz"))) (ert-deftest ert-propertized-string () - (should (ert-equal-including-properties + (should (equal-including-properties (ert-propertized-string "a" '(a b) "b" '(c t) "cd") #("abcd" 1 2 (a b) 2 4 (c t)))) - (should (ert-equal-including-properties + (should (equal-including-properties (ert-propertized-string "foo " '(face italic) "bar" " baz" nil " quux") #("foo bar baz quux" 4 11 (face italic))))) @@ -166,7 +166,7 @@ "1 skipped")))) (with-current-buffer buffer-name (font-lock-mode 0) - (should (ert-equal-including-properties + (should (equal-including-properties (ert-filter-string (buffer-string) '("Started at:\\(.*\\)$" 1) '("Finished at:\\(.*\\)$" 1)) @@ -175,7 +175,7 @@ ;; pretend we are. (let ((noninteractive nil)) (font-lock-mode 1)) - (should (ert-equal-including-properties + (should (equal-including-properties (ert-filter-string (buffer-string) '("Started at:\\(.*\\)$" 1) '("Finished at:\\(.*\\)$" 1)) diff --git a/test/lisp/emacs-lisp/pp-resources/code-formats.erts b/test/lisp/emacs-lisp/pp-resources/code-formats.erts new file mode 100644 index 00000000000..2b2001d0964 --- /dev/null +++ b/test/lisp/emacs-lisp/pp-resources/code-formats.erts @@ -0,0 +1,124 @@ +Code: + (lambda () + (emacs-lisp-mode) + (let ((code (read (current-buffer)))) + (erase-buffer) + (pp-emacs-lisp-code code) + (untabify (point-min) (point-max)))) + +Name: code-formats1 + +=-= +(defun foo (bar) + "Yes." + (let ((a 1) + (b 2)) + (zot 1 2 (funcall bar 2)))) +=-=-= + + +Name: code-formats2 + +=-= +(defun pp-emacs-lisp-code (sexp) + "Insert SEXP into the current buffer, formatted as Emacs Lisp code." + (require 'edebug) + (let ((start (point)) + (standard-output (current-buffer))) + (pp--insert-lisp sexp) + (insert "\n") + (goto-char start) + (indent-sexp))) +=-=-= + + +Name: code-formats3 + +=-= +(defun foo (bar) + "Yes." + (let ((a 1) + (b 2)) + (zot-zot-zot-zot-zot-zot 1 2 (funcall + bar-bar-bar-bar-bar-bar-bar-bar-bar-bar + 2)))) +=-=-= + + +Name: code-formats4 + +=-= +(defun foo (bar) + "Yes." + (let ((a 1) + (b 2) + foo bar zotfoo bar zotfoo bar zotfoo bar zotfoo bar zotfoo bar zotfoo + bar zot) + (zot 1 2 (funcall bar 2)))) +=-=-= + + +Name: code-formats5 + +=-= +(defgroup pp () + "Pretty printer for Emacs Lisp." + :prefix "pp-" + :group 'lisp) +=-=-= + +Name: code-formats6 + +=-= +(defcustom pp-escape-newlines t + "Value of `print-escape-newlines' used by pp-* functions." + :type 'boolean + :group 'pp) +=-=-= + +Name: code-formats7 + +=-= +(defun pp (object &optional stream) + (princ (pp-to-string object) (or stream standard-output))) +=-=-= + + +Name: code-formats8 + +=-= +(defun pp-eval-expression (expression) + "Evaluate EXPRESSION and pretty-print its value. +Also add the value to the front of the list in the variable `values'." + (interactive (list (read--expression "Eval: "))) + (message "Evaluating...") + (let ((result (eval expression lexical-binding))) + (values--store-value result) + (pp-display-expression result "*Pp Eval Output*"))) +=-=-= + +Name: code-formats9 + +=-= +(lambda () + (interactive) + 1) +=-=-= + + +Name: code-formats10 + +=-= +(funcall foo (concat "zot" (if (length> site 0) site + "bar") + "+" + (string-replace " " "+" query))) +=-=-= + + +Name: code-formats11 + +=-= +(lambda () + [(foo bar) (foo bar)]) +=-=-= diff --git a/test/lisp/emacs-lisp/pp-tests.el b/test/lisp/emacs-lisp/pp-tests.el index b04030cc432..4cae1a73775 100644 --- a/test/lisp/emacs-lisp/pp-tests.el +++ b/test/lisp/emacs-lisp/pp-tests.el @@ -20,6 +20,7 @@ ;;; Code: (require 'pp) +(require 'ert-x) (ert-deftest pp-print-quote () (should (string= (pp-to-string 'quote) "quote")) @@ -32,4 +33,7 @@ (should (string= (pp-to-string '(quotefoo)) "(quotefoo)\n")) (should (string= (pp-to-string '(a b)) "(a b)\n"))) +(ert-deftest test-indentation () + (ert-test-erts-file (ert-resource-file "code-formats.erts"))) + ;;; pp-tests.el ends here. diff --git a/test/lisp/emacs-lisp/subr-x-tests.el b/test/lisp/emacs-lisp/subr-x-tests.el index 1d19496ba44..f9cfea888c7 100644 --- a/test/lisp/emacs-lisp/subr-x-tests.el +++ b/test/lisp/emacs-lisp/subr-x-tests.el @@ -638,5 +638,43 @@ (should (equal (string-chop-newline "foo\nbar\n") "foo\nbar")) (should (equal (string-chop-newline "foo\nbar") "foo\nbar"))) +(ert-deftest subr-ensure-empty-lines () + (should + (equal + (with-temp-buffer + (insert "foo") + (goto-char (point-min)) + (ensure-empty-lines 2) + (buffer-string)) + "\n\nfoo")) + (should + (equal + (with-temp-buffer + (insert "foo") + (ensure-empty-lines 2) + (buffer-string)) + "foo\n\n\n")) + (should + (equal + (with-temp-buffer + (insert "foo\n") + (ensure-empty-lines 2) + (buffer-string)) + "foo\n\n\n")) + (should + (equal + (with-temp-buffer + (insert "foo\n\n\n\n\n") + (ensure-empty-lines 2) + (buffer-string)) + "foo\n\n\n")) + (should + (equal + (with-temp-buffer + (insert "foo\n\n\n") + (ensure-empty-lines 0) + (buffer-string)) + "foo\n"))) + (provide 'subr-x-tests) ;;; subr-x-tests.el ends here |