Merge commit '107ce3050fc37b9a13d8304ae1bb73fac9de5f61'

7 files changed, 145 insertions, 131 deletions

diff --git a/test/lisp/emacs-lisp/backquote-tests.el b/test/lisp/emacs-lisp/backquote-tests.el
new file mode 100644
index 00000000000..01f2c4a897e
--- /dev/null
+++ b/test/lisp/emacs-lisp/backquote-tests.el
@@ -0,0 +1,47 @@
+;;; backquote-tests.el --- Tests for backquote.el -*- lexical-binding: t -*-
+
+;; Copyright (C) 2019 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; 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 GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'ert)
+
+(ert-deftest backquote-test-basic ()
+  (let ((lst '(ba bb bc))
+        (vec [ba bb bc]))
+    (should (equal 3 `,(eval '(+ x y) '((x . 1) (y . 2)))))
+    (should (equal vec `[,@lst]))
+    (should (equal `(a lst c) '(a lst c)))
+    (should (equal `(a ,lst c) '(a (ba bb bc) c)))
+    (should (equal `(a ,@lst c) '(a ba bb bc c)))
+    ;; Vectors work just like lists.
+    (should (equal `(a vec c) '(a vec c)))
+    (should (equal `(a ,vec c) '(a [ba bb bc] c)))
+    (should (equal `(a ,@vec c) '(a ba bb bc c)))))
+
+(ert-deftest backquote-test-nested ()
+  "Test nested backquotes."
+  (let ((lst '(ba bb bc))
+        (vec [ba bb bc]))
+    (should (equal `(a ,`(,@lst) c) `(a ,lst c)))
+    (should (equal `(a ,`[,@lst] c) `(a ,vec c)))
+    (should (equal `(a ,@`[,@lst] c) `(a ,@lst c)))))
+
+;;; backquote-tests.el ends here
diff --git a/test/lisp/emacs-lisp/backtrace-tests.el b/test/lisp/emacs-lisp/backtrace-tests.el
index ce827e0166f..be154953423 100644
--- a/test/lisp/emacs-lisp/backtrace-tests.el
+++ b/test/lisp/emacs-lisp/backtrace-tests.el
@@ -335,6 +335,55 @@ line contains the strings \"lambda\" and \"number\"."
       (should (string-match-p results
                               (backtrace-tests--get-substring (point-min) (point-max)))))))
 
+(ert-deftest backtrace-tests--print-gensym ()
+  "Backtrace buffers can toggle `print-gensym' syntax."
+  (ert-with-test-buffer (:name "print-gensym")
+    (let* ((print-gensym nil)
+           (arg (list (gensym "first") (gensym) (gensym "last")))
+           (results (backtrace-tests--make-regexp
+                     (backtrace-tests--result arg)))
+           (results-gensym (regexp-quote (let ((print-gensym t))
+                                           (backtrace-tests--result arg))))
+           (last-frame (backtrace-tests--make-regexp
+                        (format (nth (1- backtrace-tests--line-count)
+                                     (backtrace-tests--backtrace-lines))
+                                arg)))
+           (last-frame-gensym (regexp-quote
+                               (let ((print-gensym t))
+                                 (format (nth (1- backtrace-tests--line-count)
+                                              (backtrace-tests--backtrace-lines))
+                                         arg)))))
+      (backtrace-tests--make-backtrace arg)
+      (backtrace-print)
+      (should (string-match-p results
+                              (backtrace-tests--get-substring (point-min) (point-max))))
+      ;; Go to the last frame.
+      (goto-char (point-max))
+      (forward-line -1)
+      ;; Turn on print-gensym for that frame.
+      (backtrace-toggle-print-gensym)
+      (should (string-match-p last-frame-gensym
+                              (backtrace-tests--get-substring (point) (point-max))))
+      ;; Turn off print-gensym for the frame.
+      (backtrace-toggle-print-gensym)
+      (should (string-match-p last-frame
+                              (backtrace-tests--get-substring (point) (point-max))))
+      (should (string-match-p results
+                              (backtrace-tests--get-substring (point-min) (point-max))))
+      ;; Turn print-gensym on for the buffer.
+      (backtrace-toggle-print-gensym '(4))
+      (should (string-match-p last-frame-gensym
+                              (backtrace-tests--get-substring (point) (point-max))))
+      (should (string-match-p results-gensym
+                              (backtrace-tests--get-substring (point-min) (point-max))))
+      ;; Turn print-gensym off.
+      (backtrace-toggle-print-gensym '(4))
+      (should (string-match-p last-frame
+                              (backtrace-tests--get-substring
+                               (point) (+ (point) (length last-frame)))))
+      (should (string-match-p results
+                              (backtrace-tests--get-substring (point-min) (point-max)))))))
+
 (defun backtrace-tests--make-regexp (str)
   "Make regexp from STR for `backtrace-tests--print-circle'.
 Used for results of printing circular objects without
diff --git a/test/lisp/emacs-lisp/cl-print-tests.el b/test/lisp/emacs-lisp/cl-print-tests.el
index 406c528dce5..31d79df71b5 100644
--- a/test/lisp/emacs-lisp/cl-print-tests.el
+++ b/test/lisp/emacs-lisp/cl-print-tests.el
@@ -19,109 +19,17 @@
 
 ;;; Commentary:
 
+;; See test/src/print-tests.el for tests which apply to both
+;; cl-print.el and src/print.c.
+
 ;;; Code:
 
 (require 'ert)
 
-(cl-defstruct cl-print--test a b)
-
-(ert-deftest cl-print-tests-1 ()
-  "Test cl-print code."
-  (let ((x (make-cl-print--test :a 1 :b 2)))
-    (let ((print-circle nil))
-      (should (equal (cl-prin1-to-string `((x . ,x) (y . ,x)))
-                     "((x . #s(cl-print--test :a 1 :b 2)) (y . #s(cl-print--test :a 1 :b 2)))")))
-    (let ((print-circle t))
-      (should (equal (cl-prin1-to-string `((x . ,x) (y . ,x)))
-                     "((x . #1=#s(cl-print--test :a 1 :b 2)) (y . #1#))")))
-    (should (string-match "\\`#f(compiled-function (x) \"[^\"]+\" [^)]*)\\'"
-                          (cl-prin1-to-string (symbol-function #'caar))))))
-
-(ert-deftest cl-print-tests-2 ()
-  (let ((x (record 'foo 1 2 3)))
-    (should (equal
-             x
-             (car (read-from-string (with-output-to-string (prin1 x))))))
-    (let ((print-circle t))
-      (should (string-match
-               "\\`(#1=#s(foo 1 2 3) #1#)\\'"
-               (cl-prin1-to-string (list x x)))))))
-
 (cl-defstruct (cl-print-tests-struct
                (:constructor cl-print-tests-con))
   a b c d e)
 
-(ert-deftest cl-print-tests-3 ()
-  "CL printing observes `print-length'."
-  (let ((long-list (make-list 5 'a))
-        (long-vec (make-vector 5 'b))
-        (long-struct (cl-print-tests-con))
-        (long-string (make-string 5 ?a))
-        (print-length 4))
-    (should (equal "(a a a a ...)" (cl-prin1-to-string long-list)))
-    (should (equal "[b b b b ...]" (cl-prin1-to-string long-vec)))
-    (should (equal "#s(cl-print-tests-struct :a nil :b nil :c nil :d nil ...)"
-                   (cl-prin1-to-string long-struct)))
-    (should (equal "\"aaaa...\"" (cl-prin1-to-string long-string)))))
-
-(ert-deftest cl-print-tests-4 ()
-  "CL printing observes `print-level'."
-  (let* ((deep-list '(a (b (c (d (e))))))
-         (buried-vector '(a (b (c (d [e])))))
-         (deep-struct (cl-print-tests-con))
-         (buried-struct `(a (b (c (d ,deep-struct)))))
-         (buried-string '(a (b (c (d #("hello" 0 5 (cl-print-test t)))))))
-         (buried-simple-string '(a (b (c (d "hello")))))
-         (print-level 4))
-    (setf (cl-print-tests-struct-a deep-struct) deep-list)
-    (should (equal "(a (b (c (d ...))))" (cl-prin1-to-string deep-list)))
-    (should (equal "(a (b (c (d ...))))" (cl-prin1-to-string buried-vector)))
-    (should (equal "(a (b (c (d ...))))" (cl-prin1-to-string buried-struct)))
-    (should (equal "(a (b (c (d ...))))" (cl-prin1-to-string buried-string)))
-    (should (equal "(a (b (c (d \"hello\"))))"
-                   (cl-prin1-to-string buried-simple-string)))
-    (should (equal "#s(cl-print-tests-struct :a (a (b (c ...))) :b nil :c nil :d nil :e nil)"
-                   (cl-prin1-to-string deep-struct)))))
-
-(ert-deftest cl-print-tests-5 ()
-  "CL printing observes `print-quoted'."
-  (let ((quoted-stuff '('a #'b `(,c ,@d))))
-    (let ((print-quoted t))
-      (should (equal "('a #'b `(,c ,@d))"
-                     (cl-prin1-to-string quoted-stuff))))
-    (let ((print-quoted nil))
-      (should (equal "((quote a) (function b) (\\` ((\\, c) (\\,@ d))))"
-                     (cl-prin1-to-string quoted-stuff))))))
-
-(ert-deftest cl-print-tests-strings ()
-  "CL printing prints strings and propertized strings."
-  (let* ((str1 "abcdefghij")
-         (str2 #("abcdefghij" 3 6 (bold t) 7 9 (italic t)))
-         (str3 #("abcdefghij" 0 10 (test t)))
-         (obj '(a b))
-         ;; Since the byte compiler reuses string literals,
-         ;; and the put-text-property call is destructive, use
-         ;; copy-sequence to make a new string.
-         (str4 (copy-sequence "abcdefghij")))
-    (put-text-property 0 5 'test obj str4)
-    (put-text-property 7 10 'test obj str4)
-
-    (should (equal "\"abcdefghij\"" (cl-prin1-to-string str1)))
-    (should (equal "#(\"abcdefghij\" 3 6 (bold t) 7 9 (italic t))"
-                   (cl-prin1-to-string str2)))
-    (should (equal "#(\"abcdefghij\" 0 10 (test t))"
-                   (cl-prin1-to-string str3)))
-    (let ((print-circle nil))
-      (should
-       (equal
-        "#(\"abcdefghij\" 0 5 (test (a b)) 7 10 (test (a b)))"
-        (cl-prin1-to-string str4))))
-    (let ((print-circle t))
-      (should
-       (equal
-        "#(\"abcdefghij\" 0 5 (test #1=(a b)) 7 10 (test #1#))"
-        (cl-prin1-to-string str4))))))
-
 (ert-deftest cl-print-tests-ellipsis-cons ()
   "Ellipsis expansion works in conses."
   (let ((print-length 4)
@@ -216,23 +124,6 @@
     (should (string-match expanded (with-output-to-string
                                      (cl-print-expand-ellipsis value nil))))))
 
-(ert-deftest cl-print-circle ()
-  (let ((x '(#1=(a . #1#) #1#)))
-    (let ((print-circle nil))
-      (should (string-match "\\`((a . #[0-9]) (a . #[0-9]))\\'"
-                            (cl-prin1-to-string x))))
-    (let ((print-circle t))
-      (should (equal "(#1=(a . #1#) #1#)" (cl-prin1-to-string x))))))
-
-(ert-deftest cl-print-circle-2 ()
-  ;; Bug#31146.
-  (let ((x '(0 . #1=(0 . #1#))))
-    (let ((print-circle nil))
-      (should (string-match "\\`(0 0 . #[0-9])\\'"
-                            (cl-prin1-to-string x))))
-    (let ((print-circle t))
-      (should (equal "(0 . #1=(0 . #1#))" (cl-prin1-to-string x))))))
-
 (ert-deftest cl-print-tests-print-to-string-with-limit ()
   (let* ((thing10 (make-list 10 'a))
          (thing100 (make-list 100 'a))
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index dd6b9edd000..d7e0a045106 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -2412,9 +2412,7 @@ This checks also `file-name-as-directory', `file-name-directory',
           (unwind-protect
               ;; FIXME: This fails on my QNAP server, see
               ;; /share/Web/owncloud/data/owncloud.log
-              (unless (and (tramp--test-nextcloud-p)
-                           (or (not (file-remote-p source))
-                               (not (file-remote-p target))))
+              (unless (tramp--test-nextcloud-p)
                 (make-directory source)
                 (should (file-directory-p source))
                 (write-region "foo" nil (expand-file-name "foo" source))
@@ -2437,8 +2435,7 @@ This checks also `file-name-as-directory', `file-name-directory',
           (unwind-protect
               ;; FIXME: This fails on my QNAP server, see
               ;; /share/Web/owncloud/data/owncloud.log
-              (unless
-                  (and (tramp--test-nextcloud-p) (not (file-remote-p source)))
+              (unless (tramp--test-nextcloud-p)
                 (make-directory source)
                 (should (file-directory-p source))
                 (write-region "foo" nil (expand-file-name "foo" source))
@@ -4407,7 +4404,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
               "foo"
               (funcall
                this-shell-command-to-string
-               (format "echo -n ${%s:?bla}" envvar))))))
+               (format "echo -n ${%s:-bla}" envvar))))))
 
       (unwind-protect
           ;; Set the empty value.
@@ -4419,7 +4416,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
               "bla"
               (funcall
                this-shell-command-to-string
-               (format "echo -n ${%s:?bla}" envvar))))
+               (format "echo -n ${%s:-bla}" envvar))))
             ;; Variable is set.
             (should
              (string-match
@@ -4441,7 +4438,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
               "foo"
               (funcall
                this-shell-command-to-string
-               (format "echo -n ${%s:?bla}" envvar))))
+               (format "echo -n ${%s:-bla}" envvar))))
             (let ((process-environment
                    (cons envvar process-environment)))
               ;; Variable is unset.
@@ -4450,12 +4447,14 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
                 "bla"
                 (funcall
                  this-shell-command-to-string
-                 (format "echo -n ${%s:?bla}" envvar))))
+                 (format "echo -n ${%s:-bla}" envvar))))
               ;; Variable is unset.
               (should-not
                (string-match
                 (regexp-quote envvar)
-                (funcall this-shell-command-to-string "env")))))))))
+                ;; We must remove PS1, the output is truncated otherwise.
+                (funcall
+                 this-shell-command-to-string "printenv | grep -v PS1")))))))))
 
 ;; This test is inspired by Bug#27009.
 (ert-deftest tramp-test33-environment-variables-and-port-numbers ()
@@ -5303,7 +5302,7 @@ This requires restrictions of file name syntax."
                   ;; of process output.  So we unset it temporarily.
                   (setenv "PS1")
                   (with-temp-buffer
-                    (should (zerop (process-file "env" nil t nil)))
+                    (should (zerop (process-file "printenv" nil t nil)))
                     (goto-char (point-min))
                     (should
                      (re-search-forward
diff --git a/test/lisp/progmodes/python-tests.el b/test/lisp/progmodes/python-tests.el
index b1cf7e8806a..c5ad1dfb862 100644
--- a/test/lisp/progmodes/python-tests.el
+++ b/test/lisp/progmodes/python-tests.el
@@ -1351,7 +1351,7 @@ this is an arbitrarily
                       expected)))))
 
 
-;;; Autofill
+;;; Filling
 
 (ert-deftest python-auto-fill-docstring ()
   (python-tests-with-temp-buffer
@@ -1368,6 +1368,17 @@ def some_function(arg1,
      (forward-line 1)
      (should (= docindent (current-indentation))))))
 
+(ert-deftest python-fill-docstring ()
+  (python-tests-with-temp-buffer
+   "\
+r'''aaa
+
+this is a test this is a test this is a test this is a test this is a test this is a test.
+'''"
+   (search-forward "test.")
+   (fill-paragraph)
+   (should (= (current-indentation) 0))))
+
 
 ;;; Mark
 
diff --git a/test/lisp/replace-tests.el b/test/lisp/replace-tests.el
index f7bf2d93658..f42d47c2bfb 100644
--- a/test/lisp/replace-tests.el
+++ b/test/lisp/replace-tests.el
@@ -514,7 +514,9 @@ Return the last evalled form in BODY."
     (should
      (replace-tests-with-undo
          input "theorem \\([0-9]+\\)"
-         "theorem \\\\ref{theo_\\1}"
+         '(replace-eval-replacement
+           replace-quote
+           (format "theorem \\\\ref{theo_%d}" (1+ (string-to-number (match-string 1)))))
          ((?\s . (1 2)) (?U . (3)))
          ?q
        (string= input (buffer-string)))))
@@ -530,4 +532,18 @@ Return the last evalled form in BODY."
          ?q
        (string= expected (buffer-string))))))
 
+(ert-deftest query-replace-undo-bug37287 ()
+  "Test for https://debbugs.gnu.org/37287 ."
+  (let ((input "foo-1\nfoo-2\nfoo-3")
+        (expected "foo-2\nfoo-2\nfoo-3"))
+    (should
+     (replace-tests-with-undo
+      input "\\([0-9]\\)"
+      '(replace-eval-replacement
+        replace-quote
+        (format "%d" (1+ (string-to-number (match-string 1)))))
+      ((?\s . (1 2 4)) (?U . (3)))
+      ?q
+      (string= expected (buffer-string))))))
+
 ;;; replace-tests.el ends here
diff --git a/test/lisp/shadowfile-tests.el b/test/lisp/shadowfile-tests.el
index a93664f6536..7caddc53d75 100644
--- a/test/lisp/shadowfile-tests.el
+++ b/test/lisp/shadowfile-tests.el
@@ -64,9 +64,14 @@
   "Temporary directory for Tramp tests.")
 
 (setq password-cache-expiry nil
-      shadow-debug t
+      shadow-debug nil
       tramp-verbose 0
-      tramp-message-show-message nil)
+      tramp-message-show-message nil
+      ;; On macOS, `temporary-file-directory' is a symlinked directory.
+      temporary-file-directory (file-truename temporary-file-directory)
+      shadow-test-remote-temporary-file-directory
+      (ignore-errors
+        (file-truename shadow-test-remote-temporary-file-directory)))
 
 ;; This should happen on hydra only.
 (when (getenv "EMACS_HYDRA_CI")
@@ -718,8 +723,6 @@ guaranteed by the originator of a cluster definition."
         (shadow-info-file shadow-test-info-file)
         (shadow-todo-file shadow-test-todo-file)
         (shadow-inhibit-message t)
-        (shadow-test-remote-temporary-file-directory
-         (file-truename shadow-test-remote-temporary-file-directory))
         shadow-clusters shadow-literal-groups shadow-regexp-groups
         shadow-files-to-copy
         cluster1 cluster2 primary regexp file)
@@ -858,8 +861,6 @@ guaranteed by the originator of a cluster definition."
         (shadow-info-file shadow-test-info-file)
         (shadow-todo-file shadow-test-todo-file)
         (shadow-inhibit-message t)
-        (shadow-test-remote-temporary-file-directory
-         (file-truename shadow-test-remote-temporary-file-directory))
         (shadow-noquery t)
         shadow-clusters shadow-files-to-copy
         cluster1 cluster2 primary regexp file mocked-input)