summaryrefslogtreecommitdiff
path: root/test/lisp/emacs-lisp
diff options
context:
space:
mode:
Diffstat (limited to 'test/lisp/emacs-lisp')
-rw-r--r--test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-defun.el3
-rw-r--r--test/lisp/emacs-lisp/bytecomp-tests.el37
-rw-r--r--test/lisp/emacs-lisp/cl-generic-tests.el13
-rw-r--r--test/lisp/emacs-lisp/comp-cstr-tests.el413
-rw-r--r--test/lisp/emacs-lisp/edebug-tests.el22
-rw-r--r--test/lisp/emacs-lisp/eieio-tests/eieio-test-methodinvoke.el2
-rw-r--r--test/lisp/emacs-lisp/eieio-tests/eieio-tests.el28
-rw-r--r--test/lisp/emacs-lisp/ert-font-lock-resources/no-asserts.js2
-rw-r--r--test/lisp/emacs-lisp/ert-font-lock-tests.el153
-rw-r--r--test/lisp/emacs-lisp/ert-tests.el41
-rw-r--r--test/lisp/emacs-lisp/hierarchy-tests.el5
-rw-r--r--test/lisp/emacs-lisp/macroexp-resources/vk.el2
-rw-r--r--test/lisp/emacs-lisp/pcase-tests.el14
-rw-r--r--test/lisp/emacs-lisp/pp-tests.el49
-rw-r--r--test/lisp/emacs-lisp/tabulated-list-tests.el41
15 files changed, 516 insertions, 309 deletions
diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-defun.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-defun.el
index 94b0e80c979..571f7f6f095 100644
--- a/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-defun.el
+++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-defun.el
@@ -1,3 +1,4 @@
;;; -*- lexical-binding: t -*-
(defun foo ()
- "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx")
+ "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"
+ nil)
diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el
index 293d3025420..26408e8685a 100644
--- a/test/lisp/emacs-lisp/bytecomp-tests.el
+++ b/test/lisp/emacs-lisp/bytecomp-tests.el
@@ -800,6 +800,9 @@ inner loops respectively."
;; Aristotelian identity optimization
(let ((x (bytecomp-test-identity 1)))
(list (eq x x) (eql x x) (equal x x)))
+
+ ;; Legacy single-arg `apply' call
+ (apply '(* 2 3))
)
"List of expressions for cross-testing interpreted and compiled code.")
@@ -848,6 +851,22 @@ byte-compiled. Run with dynamic binding."
(should (equal (bytecomp-tests--eval-interpreted form)
(bytecomp-tests--eval-compiled form)))))))
+(ert-deftest bytecomp--fun-value-as-head ()
+ ;; Check that (FUN-VALUE ...) is a valid call, for compatibility (bug#68931).
+ ;; (There is also a warning but this test does not check that.)
+ (dolist (lb '(nil t))
+ (ert-info ((prin1-to-string lb) :prefix "lexical-binding: ")
+ (let* ((lexical-binding lb)
+ (s-int '(lambda (x) (1+ x)))
+ (s-comp (byte-compile s-int))
+ (v-int (lambda (x) (1+ x)))
+ (v-comp (byte-compile v-int))
+ (comp (lambda (f) (funcall (byte-compile `(lambda () (,f 3)))))))
+ (should (equal (funcall comp s-int) 4))
+ (should (equal (funcall comp s-comp) 4))
+ (should (equal (funcall comp v-int) 4))
+ (should (equal (funcall comp v-comp) 4))))))
+
(defmacro bytecomp-tests--with-fresh-warnings (&rest body)
`(let ((macroexp--warned ; oh dear
(make-hash-table :test #'equal :weakness 'key)))
@@ -2087,18 +2106,12 @@ EXPECTED-POINT BINDINGS (MODES \\='\\='(ruby-mode js-mode python-mode)) \
(defun bytecomp-tests--error-frame (fun args)
"Call FUN with ARGS. Return result or (ERROR . BACKTRACE-FRAME)."
- (let* ((debugger
- (lambda (&rest args)
- ;; Make sure Emacs doesn't think our debugger is buggy.
- (cl-incf num-nonmacro-input-events)
- (throw 'bytecomp-tests--backtrace
- (cons args (cadr (backtrace-get-frames debugger))))))
- (debug-on-error t)
- (backtrace-on-error-noninteractive nil)
- (debug-on-quit t)
- (debug-ignored-errors nil))
+ (letrec ((handler (lambda (e)
+ (throw 'bytecomp-tests--backtrace
+ (cons e (cadr (backtrace-get-frames handler)))))))
(catch 'bytecomp-tests--backtrace
- (apply fun args))))
+ (handler-bind ((error handler))
+ (apply fun args)))))
(defconst bytecomp-tests--byte-op-error-cases
'(((car a) (wrong-type-argument listp a))
@@ -2143,7 +2156,7 @@ EXPECTED-POINT BINDINGS (MODES \\='\\='(ruby-mode js-mode python-mode)) \
`(lambda ,formals (,fun-sym ,@formals)))))))
(error-frame (bytecomp-tests--error-frame fun actuals)))
(should (consp error-frame))
- (should (equal (car error-frame) (list 'error expected-error)))
+ (should (equal (car error-frame) expected-error))
(let ((frame (cdr error-frame)))
(should (equal (type-of frame) 'backtrace-frame))
(should (equal (cons (backtrace-frame-fun frame)
diff --git a/test/lisp/emacs-lisp/cl-generic-tests.el b/test/lisp/emacs-lisp/cl-generic-tests.el
index 086ac399352..1241d28ab74 100644
--- a/test/lisp/emacs-lisp/cl-generic-tests.el
+++ b/test/lisp/emacs-lisp/cl-generic-tests.el
@@ -319,5 +319,18 @@ Edebug symbols (Bug#42672)."
(and (eq 'error (car err))
(string-match "Stray.*declare" (cadr err)))))))
+(cl-defmethod cl-generic-tests--print-quoted-method ((function (eql '4)))
+ (+ function 1))
+
+(ert-deftest cl-generic-tests--print-quoted ()
+ (with-temp-buffer
+ (cl--generic-describe 'cl-generic-tests--print-quoted-method)
+ (goto-char (point-min))
+ ;; Bug#54628: We don't want (function (eql '4)) to turn into #'(eql '4)
+ (should-not (re-search-forward "#'" nil t))
+ (goto-char (point-min))
+ ;; But we don't want (eql '4) to turn into (eql (quote 4)) either.
+ (should (re-search-forward "(eql '4)" nil t))))
+
(provide 'cl-generic-tests)
;;; cl-generic-tests.el ends here
diff --git a/test/lisp/emacs-lisp/comp-cstr-tests.el b/test/lisp/emacs-lisp/comp-cstr-tests.el
index fb1770f1f4a..b823a190d5a 100644
--- a/test/lisp/emacs-lisp/comp-cstr-tests.el
+++ b/test/lisp/emacs-lisp/comp-cstr-tests.el
@@ -29,218 +29,211 @@
(require 'cl-lib)
(require 'comp-cstr)
-(cl-eval-when (compile eval load)
-
- (defun comp-cstr-test-ts (type-spec)
- "Create a constraint from TYPE-SPEC and convert it back to type specifier."
- (let ((comp-ctxt (make-comp-cstr-ctxt)))
- (comp-cstr-to-type-spec (comp-type-spec-to-cstr type-spec))))
-
- (defun comp-cstr-typespec-test (number type-spec expected-type-spec)
- `(ert-deftest ,(intern (concat "comp-cstr-test-" (int-to-string number))) ()
- (should (equal (comp-cstr-test-ts ',type-spec)
- ',expected-type-spec))))
-
- (defconst comp-cstr-typespec-tests-alist
- '(;; 1
- (symbol . symbol)
- ;; 2
- ((or string array) . array)
- ;; 3
- ((or symbol number) . (or number symbol))
- ;; 4
- ((or cons atom) . t) ;; SBCL return T
- ;; 5
- ((or integer number) . number)
- ;; 6
- ((or (or integer symbol) number) . (or number symbol))
- ;; 7
- ((or (or integer symbol) (or number list)) . (or list number symbol))
- ;; 8
- ((or (or integer number) nil) . number)
- ;; 9
- ((member foo) . (member foo))
- ;; 10
- ((member foo bar) . (member bar foo))
- ;; 11
- ((or (member foo) (member bar)) . (member bar foo))
- ;; 12
- ((or (member foo) symbol) . symbol) ;; SBCL return (OR SYMBOL (MEMBER FOO))
- ;; 13
- ((or (member foo) number) . (or (member foo) number))
- ;; 14
- ((or (integer 1 3) number) . number)
- ;; 15
- (integer . integer)
- ;; 16
- ((integer 1 2) . (integer 1 2))
- ;; 17
- ((or (integer -1 0) (integer 3 4)) . (or (integer -1 0) (integer 3 4)))
- ;; 18
- ((or (integer -1 2) (integer 3 4)) . (integer -1 4))
- ;; 19
- ((or (integer -1 3) (integer 3 4)) . (integer -1 4))
- ;; 20
- ((or (integer -1 4) (integer 3 4)) . (integer -1 4))
- ;; 21
- ((or (integer -1 5) (integer 3 4)) . (integer -1 5))
- ;; 22
- ((or (integer -1 *) (integer 3 4)) . (integer -1 *))
- ;; 23
- ((or (integer -1 2) (integer * 4)) . (integer * 4))
- ;; 24
- ((and string array) . string)
- ;; 25
- ((and cons atom) . nil)
- ;; 26
- ((and (member foo) (member foo bar baz)) . (member foo))
- ;; 27
- ((and (member foo) (member bar)) . nil)
- ;; 28
- ((and (member foo) symbol) . (member foo))
- ;; 29
- ((and (member foo) string) . nil)
- ;; 30
- ((and (member foo) (integer 1 2)) . nil)
- ;; 31
- ((and (member 1 2) (member 3 2)) . (integer 2 2))
- ;; 32
- ((and number (integer 1 2)) . (integer 1 2))
- ;; 33
- ((and integer (integer 1 2)) . (integer 1 2))
- ;; 34
- ((and (integer -1 0) (integer 3 5)) . nil)
- ;; 35
- ((and (integer -1 2) (integer 3 5)) . nil)
- ;; 36
- ((and (integer -1 3) (integer 3 5)) . (integer 3 3))
- ;; 37
- ((and (integer -1 4) (integer 3 5)) . (integer 3 4))
- ;; 38
- ((and (integer -1 5) nil) . nil)
- ;; 39
- ((not symbol) . (not symbol))
- ;; 40
- ((or (member foo) (not (member foo bar))) . (not (member bar)))
- ;; 41
- ((or (member foo bar) (not (member foo))) . t)
- ;; 42
- ((or symbol (not sequence)) . (not sequence))
- ;; 43
- ((or symbol (not symbol)) . t)
- ;; 44
- ((or symbol (not sequence)) . (not sequence))
- ;; 45 Conservative.
- ((or vector (not sequence)) . t)
- ;; 46
- ((or (integer 1 10) (not (integer * 5))) . (not (integer * 0)))
- ;; 47
- ((or symbol (integer 1 10) (not (integer * 5))) . (not (integer * 0)))
- ;; 48
- ((or (not symbol) (integer 1 10) (not (integer * 5))) . (not (or symbol (integer * 0))))
- ;; 49
- ((or symbol (not (member foo))) . (not (member foo)))
- ;; 50
- ((or (not symbol) (not (member foo))) . (not symbol))
- ;; 51 Conservative.
- ((or (not (member foo)) string) . (not (member foo)))
- ;; 52 Conservative.
- ((or (member foo) (not string)) . (not string))
- ;; 53
- ((or (not (integer 1 2)) integer) . t)
- ;; 54
- ((or (not (integer 1 2)) (not integer)) . (not integer))
- ;; 55
- ((or (integer 1 2) (not integer)) . (not (or (integer * 0) (integer 3 *))))
- ;; 56
- ((or number (not (integer 1 2))) . t)
- ;; 57
- ((or atom (not (integer 1 2))) . t)
- ;; 58
- ((or atom (not (member foo))) . t)
- ;; 59
- ((and symbol (not cons)) . symbol)
- ;; 60
- ((and symbol (not symbol)) . nil)
- ;; 61
- ((and atom (not symbol)) . atom)
- ;; 62
- ((and atom (not string)) . (or array sequence atom))
- ;; 63 Conservative
- ((and symbol (not (member foo))) . symbol)
- ;; 64 Conservative
- ((and symbol (not (member 3))) . symbol)
- ;; 65
- ((and (not (member foo)) (integer 1 10)) . (integer 1 10))
- ;; 66
- ((and (member foo) (not (integer 1 10))) . (member foo))
- ;; 67
- ((and t (not (member foo))) . (not (member foo)))
- ;; 68
- ((and integer (not (integer 3 4))) . (or (integer * 2) (integer 5 *)))
- ;; 69
- ((and (integer 0 20) (not (integer 5 10))) . (or (integer 0 4) (integer 11 20)))
- ;; 70
- ((and (not (member a)) (not (member b))) . (not (member a b)))
- ;; 71
- ((and (not boolean) (not (member b))) . (not (or (member b) boolean)))
- ;; 72
- ((and t (integer 1 1)) . (integer 1 1))
- ;; 73
- ((not (integer -1 5)) . (not (integer -1 5)))
- ;; 74
- ((and boolean (or number marker)) . nil)
- ;; 75
- ((and atom (or number marker)) . number-or-marker)
- ;; 76
- ((and symbol (or number marker)) . nil)
- ;; 77
- ((and (or symbol string) (or number marker)) . nil)
- ;; 78
- ((and t t) . t)
- ;; 79
- ((and (or marker number) (integer 0 0)) . (integer 0 0))
- ;; 80
- ((and t (not t)) . nil)
- ;; 81
- ((or (integer 1 1) (not (integer 1 1))) . t)
- ;; 82
- ((not t) . nil)
- ;; 83
- ((not nil) . t)
- ;; 84
- ((or (not string) t) . t)
- ;; 85
- ((or (not vector) sequence) . sequence)
- ;; 86
- ((or (not symbol) null) . t)
- ;; 87
- ((and (or null integer) (not (or null integer))) . nil)
- ;; 88
- ((and (or (member a b c)) (not (or (member a b)))) . (member c))
- ;; 89
- ((or cons symbol) . (or list symbol)) ;; FIXME: Why `list'?
- ;; 90
- ((or string char-table bool-vector vector) . array)
- ;; 91
- ((or string char-table bool-vector vector number) . (or array number))
- ;; 92
- ((or string char-table bool-vector vector cons symbol number) .
- (or number sequence symbol))
- ;; 93?
- ;; FIXME: I get `cons' rather than `list'?
- ;;((or null cons) . list)
- )
- "Alist type specifier -> expected type specifier."))
-
-(defmacro comp-cstr-synthesize-tests ()
- "Generate all tests from `comp-cstr-typespec-tests-alist'."
+(defun comp-cstr-test-ts (type-spec)
+ "Create a constraint from TYPE-SPEC and convert it back to type specifier."
+ (let ((comp-ctxt (make-comp-cstr-ctxt)))
+ (comp-cstr-to-type-spec (comp-type-spec-to-cstr type-spec))))
+
+(defmacro comp-cstr-synthesize-tests (typespec-tests-alist)
+ "Generate all tests from TYPESPEC-TESTS-ALIST.
+The arg is an alist of: type specifier -> expected type specifier."
`(progn
,@(cl-loop
for i from 1
- for (ts . exp-ts) in comp-cstr-typespec-tests-alist
- append (list (comp-cstr-typespec-test i ts exp-ts)))))
-
-(comp-cstr-synthesize-tests)
+ for (type-spec . expected-type-spec) in typespec-tests-alist
+ collect
+ `(ert-deftest ,(intern (format "comp-cstr-test-%d" i)) ()
+ (should (equal (comp-cstr-test-ts ',type-spec)
+ ',expected-type-spec))))))
+
+(comp-cstr-synthesize-tests
+ (;; 1
+ (symbol . symbol)
+ ;; 2
+ ((or string array) . array)
+ ;; 3
+ ((or symbol number) . (or number symbol))
+ ;; 4
+ ((or cons atom) . t) ;; Like SBCL
+ ;; 5
+ ((or integer number) . number)
+ ;; 6
+ ((or (or integer symbol) number) . (or number symbol))
+ ;; 7
+ ((or (or integer symbol) (or number list)) . (or list number symbol))
+ ;; 8
+ ((or (or integer number) nil) . number)
+ ;; 9
+ ((member foo) . (member foo))
+ ;; 10
+ ((member foo bar) . (member bar foo))
+ ;; 11
+ ((or (member foo) (member bar)) . (member bar foo))
+ ;; 12
+ ((or (member foo) symbol) . symbol) ;; SBCL return (OR SYMBOL (MEMBER FOO))
+ ;; 13
+ ((or (member foo) number) . (or (member foo) number))
+ ;; 14
+ ((or (integer 1 3) number) . number)
+ ;; 15
+ (integer . integer)
+ ;; 16
+ ((integer 1 2) . (integer 1 2))
+ ;; 17
+ ((or (integer -1 0) (integer 3 4)) . (or (integer -1 0) (integer 3 4)))
+ ;; 18
+ ((or (integer -1 2) (integer 3 4)) . (integer -1 4))
+ ;; 19
+ ((or (integer -1 3) (integer 3 4)) . (integer -1 4))
+ ;; 20
+ ((or (integer -1 4) (integer 3 4)) . (integer -1 4))
+ ;; 21
+ ((or (integer -1 5) (integer 3 4)) . (integer -1 5))
+ ;; 22
+ ((or (integer -1 *) (integer 3 4)) . (integer -1 *))
+ ;; 23
+ ((or (integer -1 2) (integer * 4)) . (integer * 4))
+ ;; 24
+ ((and string array) . string)
+ ;; 25
+ ((and cons atom) . nil)
+ ;; 26
+ ((and (member foo) (member foo bar baz)) . (member foo))
+ ;; 27
+ ((and (member foo) (member bar)) . nil)
+ ;; 28
+ ((and (member foo) symbol) . (member foo))
+ ;; 29
+ ((and (member foo) string) . nil)
+ ;; 30
+ ((and (member foo) (integer 1 2)) . nil)
+ ;; 31
+ ((and (member 1 2) (member 3 2)) . (integer 2 2))
+ ;; 32
+ ((and number (integer 1 2)) . (integer 1 2))
+ ;; 33
+ ((and integer (integer 1 2)) . (integer 1 2))
+ ;; 34
+ ((and (integer -1 0) (integer 3 5)) . nil)
+ ;; 35
+ ((and (integer -1 2) (integer 3 5)) . nil)
+ ;; 36
+ ((and (integer -1 3) (integer 3 5)) . (integer 3 3))
+ ;; 37
+ ((and (integer -1 4) (integer 3 5)) . (integer 3 4))
+ ;; 38
+ ((and (integer -1 5) nil) . nil)
+ ;; 39
+ ((not symbol) . (not symbol))
+ ;; 40
+ ((or (member foo) (not (member foo bar))) . (not (member bar)))
+ ;; 41
+ ((or (member foo bar) (not (member foo))) . t)
+ ;; 42
+ ((or symbol (not sequence)) . (not sequence))
+ ;; 43
+ ((or symbol (not symbol)) . t)
+ ;; 44
+ ((or symbol (not sequence)) . (not sequence))
+ ;; 45 Conservative.
+ ((or vector (not sequence)) . t)
+ ;; 46
+ ((or (integer 1 10) (not (integer * 5))) . (not (integer * 0)))
+ ;; 47
+ ((or symbol (integer 1 10) (not (integer * 5))) . (not (integer * 0)))
+ ;; 48
+ ((or (not symbol) (integer 1 10) (not (integer * 5))) . (not (or symbol (integer * 0))))
+ ;; 49
+ ((or symbol (not (member foo))) . (not (member foo)))
+ ;; 50
+ ((or (not symbol) (not (member foo))) . (not symbol))
+ ;; 51 Conservative.
+ ((or (not (member foo)) string) . (not (member foo)))
+ ;; 52 Conservative.
+ ((or (member foo) (not string)) . (not string))
+ ;; 53
+ ((or (not (integer 1 2)) integer) . t)
+ ;; 54
+ ((or (not (integer 1 2)) (not integer)) . (not integer))
+ ;; 55
+ ((or (integer 1 2) (not integer)) . (not (or (integer * 0) (integer 3 *))))
+ ;; 56
+ ((or number (not (integer 1 2))) . t)
+ ;; 57
+ ((or atom (not (integer 1 2))) . t)
+ ;; 58
+ ((or atom (not (member foo))) . t)
+ ;; 59
+ ((and symbol (not cons)) . symbol)
+ ;; 60
+ ((and symbol (not symbol)) . nil)
+ ;; 61
+ ((and atom (not symbol)) . atom)
+ ;; 62 Conservative FIXME
+ ((and atom (not string)) . (or array sequence atom))
+ ;; 63 Conservative
+ ((and symbol (not (member foo))) . symbol)
+ ;; 64 Conservative
+ ((and symbol (not (member 3))) . symbol)
+ ;; 65
+ ((and (not (member foo)) (integer 1 10)) . (integer 1 10))
+ ;; 66
+ ((and (member foo) (not (integer 1 10))) . (member foo))
+ ;; 67
+ ((and t (not (member foo))) . (not (member foo)))
+ ;; 68
+ ((and integer (not (integer 3 4))) . (or (integer * 2) (integer 5 *)))
+ ;; 69
+ ((and (integer 0 20) (not (integer 5 10))) . (or (integer 0 4) (integer 11 20)))
+ ;; 70
+ ((and (not (member a)) (not (member b))) . (not (member a b)))
+ ;; 71
+ ((and (not boolean) (not (member b))) . (not (or (member b) boolean)))
+ ;; 72
+ ((and t (integer 1 1)) . (integer 1 1))
+ ;; 73
+ ((not (integer -1 5)) . (not (integer -1 5)))
+ ;; 74
+ ((and boolean (or number marker)) . nil)
+ ;; 75
+ ((and atom (or number marker)) . number-or-marker)
+ ;; 76
+ ((and symbol (or number marker)) . nil)
+ ;; 77
+ ((and (or symbol string) (or number marker)) . nil)
+ ;; 78
+ ((and t t) . t)
+ ;; 79
+ ((and (or marker number) (integer 0 0)) . (integer 0 0))
+ ;; 80
+ ((and t (not t)) . nil)
+ ;; 81
+ ((or (integer 1 1) (not (integer 1 1))) . t)
+ ;; 82
+ ((not t) . nil)
+ ;; 83
+ ((not nil) . t)
+ ;; 84
+ ((or (not string) t) . t)
+ ;; 85
+ ((or (not vector) sequence) . sequence)
+ ;; 86
+ ((or (not symbol) null) . t)
+ ;; 87
+ ((and (or null integer) (not (or null integer))) . nil)
+ ;; 88
+ ((and (or (member a b c)) (not (or (member a b)))) . (member c))
+ ;; 89
+ ((or cons symbol) . (or list symbol)) ;; FIXME: Why `list'?
+ ;; 90
+ ((or string char-table bool-vector vector) . array)
+ ;; 91
+ ((or string char-table bool-vector vector number) . (or array number))
+ ;; 92
+ ((or string char-table bool-vector vector cons symbol number) .
+ (or number sequence symbol))
+ ;; 93
+ ((or list (not null)) . t)
+ ))
;;; comp-cstr-tests.el ends here
diff --git a/test/lisp/emacs-lisp/edebug-tests.el b/test/lisp/emacs-lisp/edebug-tests.el
index 8c0f729dc39..29adbcff947 100644
--- a/test/lisp/emacs-lisp/edebug-tests.el
+++ b/test/lisp/emacs-lisp/edebug-tests.el
@@ -860,8 +860,7 @@ test and possibly others should be updated."
(let ((inhibit-read-only t))
(delete-region (point-min) (point-max))
(insert "`1"))
- (with-suppressed-warnings ((obsolete edebug-eval-defun))
- (edebug-eval-defun nil))
+ (eval-defun nil)
;; `eval-defun' outputs its message to the echo area in a rather
;; funny way, so the "1" and the " (#o1, #x1, ?\C-a)" end up placed
;; there in separate pieces (via `print' rather than via `message').
@@ -871,18 +870,21 @@ test and possibly others should be updated."
(setq edebug-initial-mode 'go)
;; In Bug#23651 Edebug would hang reading `1.
- (with-suppressed-warnings ((obsolete edebug-eval-defun))
- (edebug-eval-defun t))))
+ (eval-defun t)
+ (should (string-match-p (regexp-quote " (#o1, #x1, ?\\C-a)")
+ edebug-tests-messages))))
(ert-deftest edebug-tests-trivial-comma ()
"Edebug can read a trivial comma expression (Bug#23651)."
(edebug-tests-with-normal-env
- (read-only-mode -1)
- (delete-region (point-min) (point-max))
- (insert ",1")
- (read-only-mode)
- (with-suppressed-warnings ((obsolete edebug-eval-defun))
- (should-error (edebug-eval-defun t)))))
+ (let ((inhibit-read-only t))
+ (delete-region (point-min) (point-max))
+ (insert ",1"))
+ ;; FIXME: This currently signals a "Source has changed" error, which is
+ ;; itself a bug (the source hasn't changed). All we're testing here
+ ;; is that the Edebug gets past the step of reading the sexp.
+ (should-error (let ((eval-expression-debug-on-error nil))
+ (eval-defun t)))))
(ert-deftest edebug-tests-circular-read-syntax ()
"Edebug can instrument code using circular read object syntax (Bug#23660)."
diff --git a/test/lisp/emacs-lisp/eieio-tests/eieio-test-methodinvoke.el b/test/lisp/emacs-lisp/eieio-tests/eieio-test-methodinvoke.el
index b244a56779a..fb2c6ea3b68 100644
--- a/test/lisp/emacs-lisp/eieio-tests/eieio-test-methodinvoke.el
+++ b/test/lisp/emacs-lisp/eieio-tests/eieio-test-methodinvoke.el
@@ -259,7 +259,7 @@
(ans '(
(:PRIMARY D)
(:PRIMARY D-base1)
- ;; (:PRIMARY D-base2)
+ (:PRIMARY D-base2)
(:PRIMARY D-base0)
)))
(eitest-F (D nil))
diff --git a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el
index 83fc476c911..bc226757ff2 100644
--- a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el
+++ b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el
@@ -1011,24 +1011,24 @@ Subclasses to override slot attributes."))
(B (clone A :b "bb"))
(C (clone B :a "aa")))
- (should (string= "aa" (oref C :a)))
- (should (string= "bb" (oref C :b)))
+ (should (string= "aa" (oref C a)))
+ (should (string= "bb" (oref C b)))
- (should (slot-boundp A :a))
- (should-not (slot-boundp A :b))
- (should-not (slot-boundp A :c))
+ (should (slot-boundp A 'a))
+ (should-not (slot-boundp A 'b))
+ (should-not (slot-boundp A 'c))
- (should-not (slot-boundp B :a))
- (should (slot-boundp B :b))
- (should-not (slot-boundp A :c))
+ (should-not (slot-boundp B 'a))
+ (should (slot-boundp B 'b))
+ (should-not (slot-boundp A 'c))
- (should (slot-boundp C :a))
- (should-not (slot-boundp C :b))
- (should-not (slot-boundp C :c))
+ (should (slot-boundp C 'a))
+ (should-not (slot-boundp C 'b))
+ (should-not (slot-boundp C 'c))
- (should (eieio-instance-inheritor-slot-boundp C :a))
- (should (eieio-instance-inheritor-slot-boundp C :b))
- (should-not (eieio-instance-inheritor-slot-boundp C :c))))
+ (should (eieio-instance-inheritor-slot-boundp C 'a))
+ (should (eieio-instance-inheritor-slot-boundp C 'b))
+ (should-not (eieio-instance-inheritor-slot-boundp C 'c))))
;;;; Interaction with defstruct
diff --git a/test/lisp/emacs-lisp/ert-font-lock-resources/no-asserts.js b/test/lisp/emacs-lisp/ert-font-lock-resources/no-asserts.js
new file mode 100644
index 00000000000..5eae9af212f
--- /dev/null
+++ b/test/lisp/emacs-lisp/ert-font-lock-resources/no-asserts.js
@@ -0,0 +1,2 @@
+var abc = function(d) {
+};
diff --git a/test/lisp/emacs-lisp/ert-font-lock-tests.el b/test/lisp/emacs-lisp/ert-font-lock-tests.el
index e0ba1e949b2..fa2e5dc4db7 100644
--- a/test/lisp/emacs-lisp/ert-font-lock-tests.el
+++ b/test/lisp/emacs-lisp/ert-font-lock-tests.el
@@ -138,13 +138,24 @@ print(\"Hello, world!\")"
(forward-line)
(should (ert-font-lock--line-comment-p))))
+(ert-deftest test-parse-comments--no-assertion-error ()
+ (let* ((str "
+not_an_assertion
+random_symbol
+"))
+ (with-temp-buffer
+ (insert str)
+ (javascript-mode)
+
+ (should-error (ert-font-lock--parse-comments) :type 'user-error))))
+
(ert-deftest test-parse-comments--single-line-error ()
(let* ((str "// ^ face.face1"))
(with-temp-buffer
(insert str)
(javascript-mode)
- (should-error (ert-font-lock--parse-comments)))))
+ (should-error (ert-font-lock--parse-comments) :type 'user-error))))
(ert-deftest test-parse-comments--single-line-single-caret ()
(let* ((str "
@@ -159,7 +170,46 @@ first
(setq asserts (ert-font-lock--parse-comments))
(should (eql (length asserts) 1))
(should (equal (car asserts)
- '(:line-checked 2 :line-assert 3 :column-checked 3 :face "face.face1" :negation nil))))))
+ '(:line-checked 2 :line-assert 3 :column-checked 3 :face face.face1 :negation nil))))))
+
+(ert-deftest test-parse-comments--single-line-many-carets ()
+ (let* ((str "
+multiplecarets
+//^^^ ^^ ^ face.face1
+")
+ asserts)
+ (with-temp-buffer
+ (insert str)
+ (javascript-mode)
+
+ (setq asserts (ert-font-lock--parse-comments))
+ (should (eql (length asserts) 6))
+ (should (equal asserts
+ '((:line-checked 2 :line-assert 3 :column-checked 2 :face face.face1 :negation nil)
+ (:line-checked 2 :line-assert 3 :column-checked 3 :face face.face1 :negation nil)
+ (:line-checked 2 :line-assert 3 :column-checked 4 :face face.face1 :negation nil)
+ (:line-checked 2 :line-assert 3 :column-checked 6 :face face.face1 :negation nil)
+ (:line-checked 2 :line-assert 3 :column-checked 7 :face face.face1 :negation nil)
+ (:line-checked 2 :line-assert 3 :column-checked 9 :face face.face1 :negation nil)))))))
+
+(ert-deftest test-parse-comments--face-list ()
+ (let* ((str "
+facelist
+// ^ (face1 face2)
+// ^ !(face3 face4)
+// ^ (face5)
+")
+ asserts)
+ (with-temp-buffer
+ (insert str)
+ (javascript-mode)
+
+ (setq asserts (ert-font-lock--parse-comments))
+ (should (eql (length asserts) 3))
+ (should (equal asserts
+ '((:line-checked 2 :line-assert 3 :column-checked 3 :face (face1 face2) :negation nil)
+ (:line-checked 2 :line-assert 4 :column-checked 3 :face (face3 face4) :negation t)
+ (:line-checked 2 :line-assert 5 :column-checked 3 :face (face5) :negation nil)))))))
(ert-deftest test-parse-comments--caret-negation ()
(let* ((str "
@@ -175,11 +225,11 @@ first
(setq asserts (ert-font-lock--parse-comments))
(should (eql (length asserts) 2))
(should (equal asserts
- '((:line-checked 2 :line-assert 3 :column-checked 3 :face "face" :negation t)
- (:line-checked 2 :line-assert 4 :column-checked 3 :face "face" :negation nil)))))))
+ '((:line-checked 2 :line-assert 3 :column-checked 3 :face face :negation t)
+ (:line-checked 2 :line-assert 4 :column-checked 3 :face face :negation nil)))))))
-(ert-deftest test-parse-comments--single-line-multiple-carets ()
+(ert-deftest test-parse-comments--single-line-multiple-assert-lines ()
(let* ((str "
first
// ^ face1
@@ -196,12 +246,12 @@ first
(setq asserts (ert-font-lock--parse-comments))
(should (eql (length asserts) 4))
(should (equal asserts
- '((:line-checked 2 :line-assert 3 :column-checked 3 :face "face1" :negation nil)
- (:line-checked 2 :line-assert 4 :column-checked 7 :face "face.face2" :negation nil)
- (:line-checked 2 :line-assert 5 :column-checked 7 :face "face-face.face3" :negation nil)
- (:line-checked 2 :line-assert 6 :column-checked 7 :face "face_face.face4" :negation nil)))))))
+ '((:line-checked 2 :line-assert 3 :column-checked 3 :face face1 :negation nil)
+ (:line-checked 2 :line-assert 4 :column-checked 7 :face face.face2 :negation nil)
+ (:line-checked 2 :line-assert 5 :column-checked 7 :face face-face.face3 :negation nil)
+ (:line-checked 2 :line-assert 6 :column-checked 7 :face face_face.face4 :negation nil)))))))
-(ert-deftest test-parse-comments--multiple-line-multiple-carets ()
+(ert-deftest test-parse-comments--multiple-line-multiple-assert-lines ()
(let* ((str "
first
// ^ face1
@@ -218,9 +268,9 @@ third
(setq asserts (ert-font-lock--parse-comments))
(should (eql (length asserts) 3))
(should (equal asserts
- '((:line-checked 2 :line-assert 3 :column-checked 3 :face "face1" :negation nil)
- (:line-checked 4 :line-assert 5 :column-checked 3 :face "face2" :negation nil)
- (:line-checked 4 :line-assert 6 :column-checked 5 :face "face3" :negation nil)))))))
+ '((:line-checked 2 :line-assert 3 :column-checked 3 :face face1 :negation nil)
+ (:line-checked 4 :line-assert 5 :column-checked 3 :face face2 :negation nil)
+ (:line-checked 4 :line-assert 6 :column-checked 5 :face face3 :negation nil)))))))
(ert-deftest test-parse-comments--arrow-single-line-single ()
@@ -236,7 +286,7 @@ first
(setq asserts (ert-font-lock--parse-comments))
(should (eql (length asserts) 1))
(should (equal (car asserts)
- '(:line-checked 2 :line-assert 3 :column-checked 0 :face "face1" :negation nil))))))
+ '(:line-checked 2 :line-assert 3 :column-checked 0 :face face1 :negation nil))))))
(ert-deftest test-parse-comments-arrow-multiple-line-single ()
@@ -254,9 +304,9 @@ first
(setq asserts (ert-font-lock--parse-comments))
(should (eql (length asserts) 3))
(should (equal asserts
- '((:line-checked 2 :line-assert 3 :column-checked 0 :face "face1" :negation nil)
- (:line-checked 2 :line-assert 4 :column-checked 2 :face "face2" :negation nil)
- (:line-checked 2 :line-assert 5 :column-checked 4 :face "face3" :negation nil)))))))
+ '((:line-checked 2 :line-assert 3 :column-checked 0 :face face1 :negation nil)
+ (:line-checked 2 :line-assert 4 :column-checked 2 :face face2 :negation nil)
+ (:line-checked 2 :line-assert 5 :column-checked 4 :face face3 :negation nil)))))))
(ert-deftest test-parse-comments--non-assert-comment-single ()
(let* ((str "
@@ -271,7 +321,7 @@ first
(setq asserts (ert-font-lock--parse-comments))
(should (eql (length asserts) 1))
(should (equal (car asserts)
- '(:line-checked 2 :line-assert 3 :column-checked 4 :face "comment-face" :negation nil))))))
+ '(:line-checked 2 :line-assert 3 :column-checked 4 :face comment-face :negation nil))))))
(ert-deftest test-parse-comments--non-assert-comment-multiple ()
(let* ((str "
@@ -288,9 +338,9 @@ first
(setq asserts (ert-font-lock--parse-comments))
(should (eql (length asserts) 3))
(should (equal asserts
- '((:line-checked 2 :line-assert 3 :column-checked 4 :face "comment-face" :negation nil)
- (:line-checked 2 :line-assert 4 :column-checked 10 :face "comment-face" :negation nil)
- (:line-checked 2 :line-assert 5 :column-checked 18 :face "comment-face" :negation nil)))))))
+ '((:line-checked 2 :line-assert 3 :column-checked 4 :face comment-face :negation nil)
+ (:line-checked 2 :line-assert 4 :column-checked 10 :face comment-face :negation nil)
+ (:line-checked 2 :line-assert 5 :column-checked 18 :face comment-face :negation nil)))))))
(ert-deftest test-parse-comments--multiline-comment-single ()
@@ -308,7 +358,7 @@ first
(setq asserts (ert-font-lock--parse-comments))
(should (eql (length asserts) 1))
(should (equal (car asserts)
- '(:line-checked 3 :line-assert 4 :column-checked 3 :face "comment-face" :negation nil))))))
+ '(:line-checked 3 :line-assert 4 :column-checked 3 :face comment-face :negation nil))))))
(ert-deftest test-parse-comments--multiline-comment-multiple ()
(let* ((str "
@@ -327,13 +377,47 @@ first
(setq asserts (ert-font-lock--parse-comments))
(should (eql (length asserts) 2))
(should (equal asserts
- '((:line-checked 3 :line-assert 4 :column-checked 3 :face "comment-face" :negation nil)
- (:line-checked 5 :line-assert 6 :column-checked 4 :face "comment-face" :negation nil)))))))
+ '((:line-checked 3 :line-assert 4 :column-checked 3 :face comment-face :negation nil)
+ (:line-checked 5 :line-assert 6 :column-checked 4 :face comment-face :negation nil)))))))
;;; Syntax highlighting assertion tests
;;
-(ert-deftest test-syntax-highlight-inline--caret-multiple-faces ()
+(ert-deftest test-syntax-highlight-inline--nil-list ()
+ (let ((str "
+var abc = function(d) {
+// ^ nil
+// ^ !nil
+};
+
+"))
+ (with-temp-buffer
+ (insert str)
+ (javascript-mode)
+ (font-lock-ensure)
+
+ (ert-font-lock--check-faces
+ (ert-font-lock--parse-comments)))))
+
+(ert-deftest test-syntax-highlight-inline--face-list ()
+ (let ((str "
+var abc = function(d) {
+// ^ (test-face-2 test-face-1 font-lock-variable-name-face)
+};
+
+"))
+ (with-temp-buffer
+ (insert str)
+ (javascript-mode)
+ (font-lock-ensure)
+
+ (add-face-text-property (point-min) (point-max) 'test-face-1)
+ (add-face-text-property (point-min) (point-max) 'test-face-2)
+
+ (ert-font-lock--check-faces
+ (ert-font-lock--parse-comments)))))
+
+(ert-deftest test-syntax-highlight-inline--caret-multiple-assertions ()
(let ((str "
var abc = function(d) {
// ^ font-lock-variable-name-face
@@ -364,6 +448,19 @@ var abc = function(d) {
(should-error (ert-font-lock--check-faces
(ert-font-lock--parse-comments))))))
+(ert-deftest test-syntax-highlight-inline--caret-negated-wrong-face ()
+ (let* ((str "
+var abc = function(d) {
+// ^ !not-a-face
+};
+"))
+ (with-temp-buffer
+ (insert str)
+ (javascript-mode)
+ (font-lock-ensure)
+
+ (ert-font-lock--check-faces
+ (ert-font-lock--parse-comments)))))
(ert-deftest test-syntax-highlight-inline--comment-face ()
(let* ((str "
@@ -455,6 +552,12 @@ var abc = function(d) {
javascript-mode
"correct.js")
+(ert-font-lock-deftest-file test-macro-test--file-no-asserts
+ "Check failing on files without assertions"
+ :expected-result :failed
+ javascript-mode
+ "no-asserts.js")
+
(ert-font-lock-deftest-file test-macro-test--file-failing
"Test reading wrong assertions from a file"
:expected-result :failed
diff --git a/test/lisp/emacs-lisp/ert-tests.el b/test/lisp/emacs-lisp/ert-tests.el
index 768a3a726aa..1aff73d66f6 100644
--- a/test/lisp/emacs-lisp/ert-tests.el
+++ b/test/lisp/emacs-lisp/ert-tests.el
@@ -1,6 +1,6 @@
;;; ert-tests.el --- ERT's self-tests -*- lexical-binding: t -*-
-;; Copyright (C) 2007-2008, 2010-2024 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2024 Free Software Foundation, Inc.
;; Author: Christian Ohler <ohler@gnu.org>
@@ -93,16 +93,6 @@ failed or if there was a problem."
'(ert-test-failed "failure message"))
t))))
-(ert-deftest ert-test-fail-debug-with-condition-case ()
- (let ((test (make-ert-test :body (lambda () (ert-fail "failure message")))))
- (condition-case condition
- (progn
- (let ((ert-debug-on-error t))
- (ert-run-test test))
- (cl-assert nil))
- ((error)
- (cl-assert (equal condition '(ert-test-failed "failure message")) t)))))
-
(ert-deftest ert-test-fail-debug-with-debugger-1 ()
(let ((test (make-ert-test :body (lambda () (ert-fail "failure message")))))
(let ((debugger (lambda (&rest _args)
@@ -146,16 +136,6 @@ failed or if there was a problem."
'(error "Error message"))
t))))
-(ert-deftest ert-test-error-debug ()
- (let ((test (make-ert-test :body (lambda () (error "Error message")))))
- (condition-case condition
- (progn
- (let ((ert-debug-on-error t))
- (ert-run-test test))
- (cl-assert nil))
- ((error)
- (cl-assert (equal condition '(error "Error message")) t)))))
-
;;; Test that `should' works.
(ert-deftest ert-test-should ()
@@ -359,14 +339,10 @@ This macro is used to test if macroexpansion in `should' works."
(,(lambda () (let ((_x t)) (should (error "Foo"))))
(error "Foo")))
do
- (let ((test (make-ert-test :body body)))
- (condition-case actual-condition
- (progn
- (let ((ert-debug-on-error t))
- (ert-run-test test))
- (cl-assert nil))
- ((error)
- (should (equal actual-condition expected-condition)))))))
+ (let* ((test (make-ert-test :body body))
+ (result (ert-run-test test)))
+ (should (ert-test-failed-p result))
+ (should (equal (ert-test-failed-condition result) expected-condition)))))
(defun ert-test--which-file ()
"Dummy function to help test `symbol-file' for tests.")
@@ -392,9 +368,9 @@ This macro is used to test if macroexpansion in `should' works."
(result (ert-run-test test)))
(should (ert-test-failed-p result))
(should (memq (backtrace-frame-fun (car (ert-test-failed-backtrace result)))
- ;;; This is `ert-fail' on nativecomp and `signal'
- ;;; otherwise. It's not clear whether that's a bug
- ;;; or not (bug#51308).
+ ;; This is `ert-fail' on nativecomp and `signal'
+ ;; otherwise. It's not clear whether that's a bug
+ ;; or not (bug#51308).
'(ert-fail signal)))))
(ert-deftest ert-test-messages ()
@@ -880,7 +856,6 @@ This macro is used to test if macroexpansion in `should' works."
(ert-deftest ert-test-with-demoted-errors ()
"Check that ERT correctly handles `with-demoted-errors'."
- :expected-result :failed ;; FIXME! Bug#11218
(should-not (with-demoted-errors "FOO: %S" (error "Foo"))))
(ert-deftest ert-test-fail-inside-should ()
diff --git a/test/lisp/emacs-lisp/hierarchy-tests.el b/test/lisp/emacs-lisp/hierarchy-tests.el
index 97a0f7ba52c..3333f4014e6 100644
--- a/test/lisp/emacs-lisp/hierarchy-tests.el
+++ b/test/lisp/emacs-lisp/hierarchy-tests.el
@@ -570,8 +570,9 @@ should fail as this function will crash."
(defun hierarchy-examples-delayed--childrenfn (hier-elem)
"Return the children of HIER-ELEM.
-Basially, feed the number, minus 1, to `hierarchy-examples-delayed--find-number'
-and then create a list of the number plus 0.0–0.9."
+Basically, feed the number, minus 1, to
+`hierarchy-examples-delayed--find-number' and then create a list of the
+number plus 0.0–0.9."
(when (> hier-elem 1)
(let ((next (hierarchy-examples-delayed--find-number (1- hier-elem))))
diff --git a/test/lisp/emacs-lisp/macroexp-resources/vk.el b/test/lisp/emacs-lisp/macroexp-resources/vk.el
index 460b7a8e516..5358bcaeb5c 100644
--- a/test/lisp/emacs-lisp/macroexp-resources/vk.el
+++ b/test/lisp/emacs-lisp/macroexp-resources/vk.el
@@ -25,7 +25,7 @@
(if (macroexp--dynamic-variable-p var) ''dyn ''lex))
(defvar vk-a 1)
-(defconst vk-b 2)
+(defvar vk-b 2)
(defvar vk-c)
(defun vk-f1 (x)
diff --git a/test/lisp/emacs-lisp/pcase-tests.el b/test/lisp/emacs-lisp/pcase-tests.el
index d062965952a..c79adcdfec5 100644
--- a/test/lisp/emacs-lisp/pcase-tests.el
+++ b/test/lisp/emacs-lisp/pcase-tests.el
@@ -160,4 +160,18 @@
(should-error (pcase-setq a)
:type '(wrong-number-of-arguments)))
+(ert-deftest pcase-tests-mutually-exclusive ()
+ (dolist (x '((functionp consp nil)
+ (functionp stringp t)
+ (compiled-function-p consp t)
+ (keywordp symbolp nil)
+ (keywordp symbol-with-pos-p nil)
+ (keywordp stringp t)))
+ (if (nth 2 x)
+ (should (pcase--mutually-exclusive-p (nth 0 x) (nth 1 x)))
+ (should-not (pcase--mutually-exclusive-p (nth 0 x) (nth 1 x))))
+ (if (nth 2 x)
+ (should (pcase--mutually-exclusive-p (nth 1 x) (nth 0 x)))
+ (should-not (pcase--mutually-exclusive-p (nth 1 x) (nth 0 x))))))
+
;;; pcase-tests.el ends here.
diff --git a/test/lisp/emacs-lisp/pp-tests.el b/test/lisp/emacs-lisp/pp-tests.el
index b663fb365a8..7606183d645 100644
--- a/test/lisp/emacs-lisp/pp-tests.el
+++ b/test/lisp/emacs-lisp/pp-tests.el
@@ -36,4 +36,53 @@
(ert-deftest test-indentation ()
(ert-test-erts-file (ert-resource-file "code-formats.erts")))
+(defun pp-tests--dimensions ()
+ (save-excursion
+ (let ((width 0)
+ (height 0))
+ (goto-char (point-min))
+ (while (not (eobp))
+ (end-of-line)
+ (setq height (1+ height))
+ (setq width (max width (current-column)))
+ (forward-char 1))
+ (cons width height))))
+
+(ert-deftest pp-tests--cut-before ()
+ (with-temp-buffer
+ (lisp-data-mode)
+ (pp '(1 (quite-a-long-package-name
+ . [(0 10 0) ((avy (0 5 0))) "Quickly switch windows." tar
+ ((:url . "https://github.com/abo-abo/ace-window")
+ (:maintainer "Oleh Krehel" . "ohwoeowho@gmail.com")
+ (:authors ("Oleh Krehel" . "ohwoeowho@gmail.com"))
+ (:keywords "window" "location"))]))
+ (current-buffer))
+ ;; (message "Filled:\n%s" (buffer-string))
+ (let ((dimensions (pp-tests--dimensions)))
+ (should (< (car dimensions) 80))
+ (should (< (cdr dimensions) 8)))
+ (goto-char (point-min))
+ (while (search-forward "." nil t)
+ (should (not (eolp))))))
+
+(ert-deftest pp-tests--sanity ()
+ (with-temp-buffer
+ (lisp-data-mode)
+ (let ((testdata "(a b c #1=#[0 \"\" [] 0] #s(foo #1# bar))"))
+ (let ((res (car (read-from-string testdata))))
+ (dotimes (i (length testdata))
+ (erase-buffer)
+ (insert testdata)
+ (let ((fill-column i))
+ (pp-fill (point-min) (point-max))
+ (goto-char (point-min))
+ (condition-case err
+ (should (equal (read (current-buffer)) res))
+ (invalid-read-syntax
+ (message "Invalid fill result with i=%d:\n%s"
+ i (buffer-string))
+ (signal (car err) (cdr err))
+ ))))))))
+
;;; pp-tests.el ends here.
diff --git a/test/lisp/emacs-lisp/tabulated-list-tests.el b/test/lisp/emacs-lisp/tabulated-list-tests.el
index 8be2be3139e..e53268b3f14 100644
--- a/test/lisp/emacs-lisp/tabulated-list-tests.el
+++ b/test/lisp/emacs-lisp/tabulated-list-tests.el
@@ -130,4 +130,45 @@
(should-error (tabulated-list-sort) :type 'user-error)
(should-error (tabulated-list-sort 4) :type 'user-error)))
+(ert-deftest tabulated-list-groups ()
+ (with-temp-buffer
+ (tabulated-list-mode)
+ (setq tabulated-list-groups
+ (reverse
+ (seq-group-by (lambda (b) (concat "* " (aref (cadr b) 3)))
+ tabulated-list--test-entries)))
+ (setq tabulated-list-format tabulated-list--test-format)
+ (setq tabulated-list-padding 7)
+ (tabulated-list-init-header)
+ (tabulated-list-print)
+ ;; Basic printing.
+ (should (string-equal
+ (buffer-substring-no-properties (point-min) (point-max))
+ "\
+* installed
+ zzzz-game zzzz-game 2113 installed play zzzz in Emacs
+ mode mode 1128 installed A simple mode for editing Actionscript 3 files
+* available
+ abc-mode abc-mode 944 available Major mode for editing abc music files
+* obsolete
+ 4clojure 4clojure 1507 obsolete Open and evaluate 4clojure.com questions
+"))
+ ;; Sort and preserve position.
+ (forward-line 2)
+ (let ((pos (thing-at-point 'line)))
+ (tabulated-list-next-column 2)
+ (tabulated-list-sort)
+ (should (equal (thing-at-point 'line) pos))
+ (should (string-equal
+ (buffer-substring-no-properties (point-min) (point-max))
+ "\
+* installed
+ mode mode 1128 installed A simple mode for editing Actionscript 3 files
+ zzzz-game zzzz-game 2113 installed play zzzz in Emacs
+* available
+ abc-mode abc-mode 944 available Major mode for editing abc music files
+* obsolete
+ 4clojure 4clojure 1507 obsolete Open and evaluate 4clojure.com questions
+")))))
+
;;; tabulated-list-tests.el ends here
generated by cgit v1.2.3 (git 2.39.1) at 2024-06-02 11:58:21 +0000