Merge remote-tracking branch 'origin/master' into feature/pgtk

14 files changed, 144 insertions, 46 deletions

diff --git a/test/lisp/emacs-lisp/backtrace-tests.el b/test/lisp/emacs-lisp/backtrace-tests.el
index 5c4e5305ecc..e35a7a729bc 100644
--- a/test/lisp/emacs-lisp/backtrace-tests.el
+++ b/test/lisp/emacs-lisp/backtrace-tests.el
@@ -49,7 +49,7 @@
            (setq backtrace-frames (seq-subseq backtrace-frames 0 (1+ this-index))))
          (backtrace-print))))
 
-  (eval backtrace-tests--uncompiled-functions))
+  (eval backtrace-tests--uncompiled-functions t))
 
 (defun backtrace-tests--backtrace-lines ()
   (if debugger-stack-frame-as-list
diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-ignore-substitutions.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-ignore-substitutions.el
new file mode 100644
index 00000000000..37cfe463bfe
--- /dev/null
+++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-ignore-substitutions.el
@@ -0,0 +1,17 @@
+;;; -*- lexical-binding: t -*-
+(defalias 'foo #'ignore
+  "None of this should be considered too wide.
+
+; this should be treated as 60 characters - no warning
+\\[quit-window]\\[quit-window]\\[quit-window]\\[quit-window]\\[quit-window]\\[quit-window]\\[quit-window]\\[quit-window]\\[quit-window]\\[quit-window]\\[quit-window]\\[quit-window]\\[quit-window]\\[quit-window]\\[quit-window]\\[quit-window]\\[quit-window]\\[quit-window]
+
+; 64 * 'x' does not warn
+\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'\\`x'
+
+; keymaps are just ignored
+\\<foo-bar-map>\\<foo-bar-map>\\<foo-bar-map>\\<foo-bar-map>\\<foo-bar-map>\\<foo-bar-map>\\<foo-bar-map>\\<foo-bar-map>\\<foo-bar-map>\\<foo-bar-map>\\<foo-bar-map>\\<foo-bar-map>\\<foo-bar-map>\\<foo-bar-map>\\<foo-bar-map>\\<foo-bar-map>\\<foo-bar-map>\\<foo-bar-map>\\<foo-bar-map>\\<foo-bar-map>\\<foo-bar-map>\\<foo-bar-map>\\<foo-bar-map>\\<foo-bar-map>\\<foo-bar-map>\\<foo-bar-map>\\<foo-bar-map>\\<foo-bar-map>\\<foo-bar-map>
+
+\\{foo-bar-map}\\{foo-bar-map}\\{foo-bar-map}\\{foo-bar-map}\\{foo-bar-map}\\{foo-bar-map}\\{foo-bar-map}\\{foo-bar-map}\\{foo-bar-map}\\{foo-bar-map}\\{foo-bar-map}\\{foo-bar-map}\\{foo-bar-map}\\{foo-bar-map}\\{foo-bar-map}\\{foo-bar-map}\\{foo-bar-map}\\{foo-bar-map}\\{foo-bar-map}\\{foo-bar-map}\\{foo-bar-map}\\{foo-bar-map}\\{foo-bar-map}\\{foo-bar-map}\\{foo-bar-map}\\{foo-bar-map}\\{foo-bar-map}\\{foo-bar-map}\\{foo-bar-map}\\{foo-bar-map}\\{foo-bar-map}\\{foo-bar-map}\\{foo-bar-map}\\{foo-bar-map}\\{foo-bar-map}\\{foo-bar-map}
+
+bar baz foo bar baz foo bar baz foo bar baz foo bar baz foo bar
+")
diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el
index dbc0aa3db42..816f14a18d5 100644
--- a/test/lisp/emacs-lisp/bytecomp-tests.el
+++ b/test/lisp/emacs-lisp/bytecomp-tests.el
@@ -956,6 +956,10 @@ byte-compiled.  Run with dynamic binding."
  "defvar .foo-bar. docstring wider than .* characters" 'reverse)
 
 (bytecomp--define-warning-file-test
+ "warn-wide-docstring-ignore-substitutions.el"
+ "defvar .foo-bar. docstring wider than .* characters" 'reverse)
+
+(bytecomp--define-warning-file-test
  "warn-wide-docstring-ignore.el"
  "defvar .foo-bar. docstring wider than .* characters" 'reverse)
 
diff --git a/test/lisp/emacs-lisp/cl-lib-tests.el b/test/lisp/emacs-lisp/cl-lib-tests.el
index a132d736383..854e371b32f 100644
--- a/test/lisp/emacs-lisp/cl-lib-tests.el
+++ b/test/lisp/emacs-lisp/cl-lib-tests.el
@@ -353,13 +353,6 @@
   (should (= 5 (cl-fifth '(1 2 3 4 5 6))))
   (should-error (cl-fifth "12345") :type 'wrong-type-argument))
 
-(ert-deftest cl-lib-test-fifth ()
-  (should (null (cl-fifth '())))
-  (should (null (cl-fifth '(1 2 3 4))))
-  (should (= 5 (cl-fifth '(1 2 3 4 5))))
-  (should (= 5 (cl-fifth '(1 2 3 4 5 6))))
-  (should-error (cl-fifth "12345") :type 'wrong-type-argument))
-
 (ert-deftest cl-lib-test-sixth ()
   (should (null (cl-sixth '())))
   (should (null (cl-sixth '(1 2 3 4 5))))
diff --git a/test/lisp/emacs-lisp/cl-macs-tests.el b/test/lisp/emacs-lisp/cl-macs-tests.el
index 033764a7f98..be2c0fa02b4 100644
--- a/test/lisp/emacs-lisp/cl-macs-tests.el
+++ b/test/lisp/emacs-lisp/cl-macs-tests.el
@@ -529,7 +529,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)))
diff --git a/test/lisp/emacs-lisp/ert-tests.el b/test/lisp/emacs-lisp/ert-tests.el
index 79576d24032..1a8c9bf4f08 100644
--- a/test/lisp/emacs-lisp/ert-tests.el
+++ b/test/lisp/emacs-lisp/ert-tests.el
@@ -39,10 +39,11 @@
 (defun ert-self-test ()
   "Run ERT's self-tests and make sure they actually ran."
   (let ((window-configuration (current-window-configuration)))
-    (let ((ert--test-body-was-run nil))
+    (let ((ert--test-body-was-run nil)
+          (ert--output-buffer-name " *ert self-tests*"))
       ;; The buffer name chosen here should not compete with the default
       ;; results buffer name for completion in `switch-to-buffer'.
-      (let ((stats (ert-run-tests-interactively "^ert-" " *ert self-tests*")))
+      (let ((stats (ert-run-tests-interactively "^ert-")))
         (cl-assert ert--test-body-was-run)
         (if (zerop (ert-stats-completed-unexpected stats))
             ;; Hide results window only when everything went well.
@@ -519,17 +520,18 @@ This macro is used to test if macroexpansion in `should' works."
                                      :body (lambda () (ert-skip
                                                        "skip message")))))
     (let ((ert-debug-on-error nil))
-      (let* ((buffer-name (generate-new-buffer-name " *ert-test-run-tests*"))
-             (messages nil)
-             (mock-message-fn
-              (lambda (format-string &rest args)
-                (push (apply #'format format-string args) messages))))
+      (cl-letf* ((buffer-name (generate-new-buffer-name
+                               " *ert-test-run-tests*"))
+                 (ert--output-buffer-name buffer-name)
+                 (messages nil)
+                 ((symbol-function 'message)
+                  (lambda (format-string &rest args)
+                    (push (apply #'format format-string args) messages))))
         (save-window-excursion
           (unwind-protect
               (let ((case-fold-search nil))
                 (ert-run-tests-interactively
-                 `(member ,passing-test ,failing-test, skipped-test) buffer-name
-                 mock-message-fn)
+                 `(member ,passing-test ,failing-test, skipped-test))
                 (should (equal messages `(,(concat
                                             "Ran 3 tests, 1 results were "
                                             "as expected, 1 unexpected, "
@@ -551,6 +553,68 @@ This macro is used to test if macroexpansion in `should' works."
             (when (get-buffer buffer-name)
               (kill-buffer buffer-name))))))))
 
+(ert-deftest ert-test-run-tests-batch ()
+  (let* ((complex-list '((:1 (:2 (:3 (:4 (:5 (:6 "abc"))))))))
+	 (long-list (make-list 11 1))
+	 (failing-test-1
+          (make-ert-test :name 'failing-test-1
+			 :body (lambda () (should (equal complex-list 1)))))
+	 (failing-test-2
+          (make-ert-test :name 'failing-test-2
+			 :body (lambda () (should (equal long-list 1))))))
+    (let ((ert-debug-on-error nil)
+          messages)
+      (cl-letf* (((symbol-function 'message)
+                  (lambda (format-string &rest args)
+                    (push (apply #'format format-string args) messages))))
+        (save-window-excursion
+          (unwind-protect
+              (let ((case-fold-search nil)
+                    (ert-batch-backtrace-right-margin nil)
+		    (ert-batch-print-level 10)
+		    (ert-batch-print-length 11))
+                (ert-run-tests-batch
+                 `(member ,failing-test-1 ,failing-test-2))))))
+      (let ((long-text "(different-types[ \t\n]+(1 1 1 1 1 1 1 1 1 1 1)[ \t\n]+1)))[ \t\n]*$")
+	    (complex-text "(different-types[ \t\n]+((:1[ \t\n]+(:2[ \t\n]+(:3[ \t\n]+(:4[ \t\n]+(:5[ \t\n]+(:6[ \t\n]+\"abc\")))))))[ \t\n]+1)))[ \t\n]*$")
+            found-long
+	    found-complex)
+	(cl-loop for msg in (reverse messages)
+		 do
+		 (unless found-long
+		   (setq found-long (string-match long-text msg)))
+		 (unless found-complex
+		   (setq found-complex (string-match complex-text msg))))
+	(should found-long)
+	(should found-complex)))))
+
+(ert-deftest ert-test-run-tests-batch-expensive ()
+  (let* ((complex-list '((:1 (:2 (:3 (:4 (:5 (:6 "abc"))))))))
+	 (failing-test-1
+          (make-ert-test :name 'failing-test-1
+			 :body (lambda () (should (equal complex-list 1))))))
+    (let ((ert-debug-on-error nil)
+          messages)
+      (cl-letf* (((symbol-function 'message)
+                  (lambda (format-string &rest args)
+                    (push (apply #'format format-string args) messages))))
+        (save-window-excursion
+          (unwind-protect
+              (let ((case-fold-search nil)
+                    (ert-batch-backtrace-right-margin nil)
+                    (ert-batch-backtrace-line-length nil)
+		    (ert-batch-print-level 6)
+		    (ert-batch-print-length 11))
+                (ert-run-tests-batch
+                 `(member ,failing-test-1))))))
+      (let ((frame "ert-fail(((should (equal complex-list 1)) :form (equal ((:1 (:2 (:3 (:4 (:5 (:6 \"abc\"))))))) 1) :value nil :explanation (different-types ((:1 (:2 (:3 (:4 (:5 (:6 \"abc\"))))))) 1)))")
+            found-frame)
+	(cl-loop for msg in (reverse messages)
+		 do
+		 (unless found-frame
+		   (setq found-frame (cl-search frame msg :test 'equal))))
+        (should found-frame)))))
+
 (ert-deftest ert-test-special-operator-p ()
   (should (ert--special-operator-p 'if))
   (should-not (ert--special-operator-p 'car))
diff --git a/test/lisp/emacs-lisp/ert-x-tests.el b/test/lisp/emacs-lisp/ert-x-tests.el
index 9baa9941586..7106b7abc0c 100644
--- a/test/lisp/emacs-lisp/ert-x-tests.el
+++ b/test/lisp/emacs-lisp/ert-x-tests.el
@@ -103,23 +103,27 @@
 
 (ert-deftest ert-test-run-tests-interactively-2 ()
   :tags '(:causes-redisplay)
-  (let* ((passing-test (make-ert-test :name 'passing-test
-                                      :body (lambda () (ert-pass))))
-         (failing-test (make-ert-test :name 'failing-test
-                                      :body (lambda ()
-                                              (ert-info ((propertize "foo\nbar"
-                                                                     'a 'b))
-                                                (ert-fail
-                                                 "failure message")))))
-         (skipped-test (make-ert-test :name 'skipped-test
-                                      :body (lambda () (ert-skip
-							"skip message"))))
-         (ert-debug-on-error nil)
-         (buffer-name (generate-new-buffer-name "*ert-test-run-tests*"))
-         (messages nil)
-         (mock-message-fn
-          (lambda (format-string &rest args)
-            (push (apply #'format format-string args) messages))))
+  (cl-letf* ((passing-test (make-ert-test
+                            :name 'passing-test
+                            :body (lambda () (ert-pass))))
+             (failing-test (make-ert-test
+                            :name 'failing-test
+                            :body (lambda ()
+                                    (ert-info ((propertize "foo\nbar"
+                                                           'a 'b))
+                                              (ert-fail
+                                               "failure message")))))
+             (skipped-test (make-ert-test
+                            :name 'skipped-test
+                            :body (lambda () (ert-skip
+					      "skip message"))))
+             (ert-debug-on-error nil)
+             (messages nil)
+             (buffer-name (generate-new-buffer-name "*ert-test-run-tests*"))
+             ((symbol-function 'message)
+              (lambda (format-string &rest args)
+                (push (apply #'format format-string args) messages)))
+             (ert--output-buffer-name buffer-name))
     (cl-flet ((expected-string (with-font-lock-p)
                 (ert-propertized-string
                  "Selector: (member <passing-test> <failing-test> "
@@ -152,14 +156,12 @@
                  "failing-test"
                  nil "\n    Info: " '(a b) "foo\n"
                  nil "          " '(a b) "bar"
-                 nil "\n    (ert-test-failed \"failure message\")\n\n\n"
-                 )))
+                 nil "\n    (ert-test-failed \"failure message\")\n\n\n")))
       (save-window-excursion
         (unwind-protect
             (let ((case-fold-search nil))
               (ert-run-tests-interactively
-               `(member ,passing-test ,failing-test ,skipped-test) buffer-name
-               mock-message-fn)
+               `(member ,passing-test ,failing-test ,skipped-test))
               (should (equal messages `(,(concat
                                           "Ran 3 tests, 1 results were "
                                           "as expected, 1 unexpected, "
diff --git a/test/lisp/emacs-lisp/generator-tests.el b/test/lisp/emacs-lisp/generator-tests.el
index c81d3d09e7d..50b8cc53a28 100644
--- a/test/lisp/emacs-lisp/generator-tests.el
+++ b/test/lisp/emacs-lisp/generator-tests.el
@@ -219,7 +219,7 @@ identical output."
     (should (eql (iter-next it -1) 42))
     (should (eql (iter-next it -1) -1))))
 
-(ert-deftest cps-loop ()
+(ert-deftest cps-loop-2 ()
   (should
    (equal (cl-loop for x iter-by (mygenerator 42)
              collect x)
diff --git a/test/lisp/emacs-lisp/let-alist-tests.el b/test/lisp/emacs-lisp/let-alist-tests.el
index 88e689c80b8..bbceb04b49d 100644
--- a/test/lisp/emacs-lisp/let-alist-tests.el
+++ b/test/lisp/emacs-lisp/let-alist-tests.el
@@ -82,7 +82,7 @@
 
 (ert-deftest let-alist-list-to-sexp ()
   "Check that multiple dots are handled correctly."
-  (should (= 1 (eval (let-alist--list-to-sexp '(a b c d) ''((d (c (b (a . 1)))))))))
+  (should (= 1 (eval (let-alist--list-to-sexp '(a b c d) ''((d (c (b (a . 1)))))) t)))
   (should (equal (let-alist--access-sexp '.foo.bar.baz 'var)
                  '(cdr (assq 'baz (cdr (assq 'bar (cdr (assq 'foo var))))))))
   (should (equal (let-alist--access-sexp '..foo.bar.baz 'var) '.foo.bar.baz)))
diff --git a/test/lisp/emacs-lisp/lisp-tests.el b/test/lisp/emacs-lisp/lisp-tests.el
index 78ecf3ff03d..8301d9906a2 100644
--- a/test/lisp/emacs-lisp/lisp-tests.el
+++ b/test/lisp/emacs-lisp/lisp-tests.el
@@ -235,7 +235,7 @@
     (should (or (not mark-active) (mark)))))
 
 (ert-deftest core-elisp-tests-3-backquote ()
-  (should (eq 3 (eval ``,,'(+ 1 2)))))
+  (should (eq 3 (eval ``,,'(+ 1 2) t))))
 
 ;; Test up-list and backward-up-list.
 (defun lisp-run-up-list-test (fn data start instructions)
@@ -324,7 +324,7 @@ start."
   (declare (indent 1) (debug (def-form body)))
   (let* ((var-pos nil)
          (text (with-temp-buffer
-                 (insert (eval contents))
+                 (insert (eval contents t))
                  (goto-char (point-min))
                  (while (re-search-forward elisp-test-point-position-regex nil t)
                    (push (list (intern (match-string-no-properties 1))
diff --git a/test/lisp/emacs-lisp/package-tests.el b/test/lisp/emacs-lisp/package-tests.el
index 3b12f57e5ce..efa9f834110 100644
--- a/test/lisp/emacs-lisp/package-tests.el
+++ b/test/lisp/emacs-lisp/package-tests.el
@@ -383,7 +383,7 @@ but with a different end of line convention (bug#48137)."
         (mapc #'delete-file
               (directory-files-recursively dir "\\`[^\\.].*\\.elc\\'"))
         (mapc (lambda (f) (call-process "gunzip" nil nil nil f))
-              (directory-files-recursively dir "\\`[^\\.].*\\.el.gz\\'"))))))
+              (directory-files-recursively dir "\\`[^\\.].*\\.el\\.gz\\'"))))))
 
 (ert-deftest package-test-install-two-dependencies ()
   "Install a package which includes a dependency."
diff --git a/test/lisp/emacs-lisp/ring-tests.el b/test/lisp/emacs-lisp/ring-tests.el
index 55df4f36685..3ec20a1e8ef 100644
--- a/test/lisp/emacs-lisp/ring-tests.el
+++ b/test/lisp/emacs-lisp/ring-tests.el
@@ -199,7 +199,7 @@
     (should (= (ring-size ring) 3))
     (should (equal (ring-elements ring) '(5 4 3)))))
 
-(ert-deftest ring-tests-insert ()
+(ert-deftest ring-tests-insert-2 ()
   (let ((ring (make-ring 2)))
     (ring-insert+extend ring :a)
     (ring-insert+extend ring :b)
diff --git a/test/lisp/emacs-lisp/subr-x-tests.el b/test/lisp/emacs-lisp/subr-x-tests.el
index f9cfea888c7..69d59e84f6d 100644
--- a/test/lisp/emacs-lisp/subr-x-tests.el
+++ b/test/lisp/emacs-lisp/subr-x-tests.el
@@ -676,5 +676,23 @@
       (buffer-string))
     "foo\n")))
 
+(ert-deftest test-add-display-text-property ()
+  (with-temp-buffer
+    (insert "Foo bar zot gazonk")
+    (add-display-text-property 4 8 'height 2.0)
+    (add-display-text-property 2 12 'raise 0.5)
+    (should (equal (get-text-property 2 'display) '(raise 0.5)))
+    (should (equal (get-text-property 5 'display)
+                   '((raise 0.5) (height 2.0))))
+    (should (equal (get-text-property 9 'display) '(raise 0.5))))
+  (with-temp-buffer
+    (insert "Foo bar zot gazonk")
+    (put-text-property 4 8 'display [(height 2.0)])
+    (add-display-text-property 2 12 'raise 0.5)
+    (should (equal (get-text-property 2 'display) '(raise 0.5)))
+    (should (equal (get-text-property 5 'display)
+                   [(raise 0.5) (height 2.0)]))
+    (should (equal (get-text-property 9 'display) '(raise 0.5)))))
+
 (provide 'subr-x-tests)
 ;;; subr-x-tests.el ends here
diff --git a/test/lisp/emacs-lisp/testcover-resources/testcases.el b/test/lisp/emacs-lisp/testcover-resources/testcases.el
index 29094526d7e..4d49e5ae70c 100644
--- a/test/lisp/emacs-lisp/testcover-resources/testcases.el
+++ b/test/lisp/emacs-lisp/testcover-resources/testcases.el
@@ -424,7 +424,7 @@
 (defmacro testcover-testcase-nth-case (arg vec)
   (declare (indent 1)
            (debug (form (vector &rest form))))
-  `(eval (aref ,vec%%% ,arg%%%))%%%)
+  `(eval (aref ,vec%%% ,arg%%%) t)%%%)
 
 (defun testcover-testcase-use-nth-case (choice val)
   (testcover-testcase-nth-case choice