Merge remote-tracking branch 'origin/master' into scratch/tsdh-vc-list-filesscratch/tsdh-vc-list-files

8 files changed, 392 insertions, 143 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)
diff --git a/test/src/print-tests.el b/test/src/print-tests.el
index 8e377d71808..26d49a5ffba 100644
--- a/test/src/print-tests.el
+++ b/test/src/print-tests.el
@@ -21,42 +21,86 @@
 
 (require 'ert)
 
-(ert-deftest print-hex-backslash ()
+;; Support sharing test code with cl-print-tests.
+
+(defalias 'print-tests--prin1-to-string #'identity
+  "The function to print to a string which is under test.")
+
+(defmacro print-tests--deftest (name arg &rest docstring-keys-and-body)
+  "Test both print.c and cl-print.el at once."
+  (declare (debug ert-deftest)
+           (doc-string 3)
+           (indent 2))
+  (let ((clname (intern (concat (symbol-name name) "-cl-print")))
+        (doc (when (stringp (car-safe docstring-keys-and-body))
+               (list (pop docstring-keys-and-body))))
+        (keys-and-values nil))
+    (while (keywordp (car-safe docstring-keys-and-body))
+      (let ((key (pop docstring-keys-and-body))
+            (val (pop docstring-keys-and-body)))
+        (push val keys-and-values)
+        (push key keys-and-values)))
+    `(progn
+       ;; Set print-tests--prin1-to-string at both declaration and
+       ;; runtime, so that it can be used by the :expected-result
+       ;; keyword.
+       (cl-letf (((symbol-function #'print-tests--prin1-to-string)
+                  #'prin1-to-string))
+         (ert-deftest ,name ,arg
+           ,@doc
+           ,@keys-and-values
+           (cl-letf (((symbol-function #'print-tests--prin1-to-string)
+                      #'prin1-to-string))
+             ,@docstring-keys-and-body)))
+       (cl-letf (((symbol-function #'print-tests--prin1-to-string)
+                  #'cl-prin1-to-string))
+         (ert-deftest ,clname ,arg
+           ,@doc
+           ,@keys-and-values
+           (cl-letf (((symbol-function #'print-tests--prin1-to-string)
+                      #'cl-prin1-to-string))
+             ,@docstring-keys-and-body))))))
+
+(print-tests--deftest print-hex-backslash ()
   (should (string= (let ((print-escape-multibyte t)
                          (print-escape-newlines t))
-                     (prin1-to-string "\u00A2\ff"))
+                     (print-tests--prin1-to-string "\u00A2\ff"))
                    "\"\\x00a2\\ff\"")))
 
 (defun print-tests--prints-with-charset-p (ch odd-charset)
-  "Return t if `prin1-to-string' prints CH with the `charset' property.
+  "Return t if print function being tested prints CH with the `charset' property.
 CH is propertized with a `charset' value according to
 ODD-CHARSET: if nil, then use the one returned by `char-charset',
 otherwise, use a different charset."
   (integerp
    (string-match
     "charset"
-    (prin1-to-string
+    (print-tests--prin1-to-string
      (propertize (string ch)
                  'charset
                  (if odd-charset
                      (cl-find (char-charset ch) charset-list :test-not #'eq)
                    (char-charset ch)))))))
 
-(ert-deftest print-charset-text-property-nil ()
+(print-tests--deftest print-charset-text-property-nil ()
+  :expected-result (if (eq (symbol-function #'print-tests--prin1-to-string)
+                           #'cl-prin1-to-string) :failed :passed)
   (let ((print-charset-text-property nil))
     (should-not (print-tests--prints-with-charset-p ?\xf6 t)) ; Bug#31376.
     (should-not (print-tests--prints-with-charset-p ?a t))
     (should-not (print-tests--prints-with-charset-p ?\xf6 nil))
     (should-not (print-tests--prints-with-charset-p ?a nil))))
 
-(ert-deftest print-charset-text-property-default ()
+(print-tests--deftest print-charset-text-property-default ()
+  :expected-result (if (eq (symbol-function #'print-tests--prin1-to-string)
+                           #'cl-prin1-to-string) :failed :passed)
   (let ((print-charset-text-property 'default))
     (should (print-tests--prints-with-charset-p ?\xf6 t))
     (should-not (print-tests--prints-with-charset-p ?a t))
     (should-not (print-tests--prints-with-charset-p ?\xf6 nil))
     (should-not (print-tests--prints-with-charset-p ?a nil))))
 
-(ert-deftest print-charset-text-property-t ()
+(print-tests--deftest print-charset-text-property-t ()
   (let ((print-charset-text-property t))
     (should (print-tests--prints-with-charset-p ?\xf6 t))
     (should (print-tests--prints-with-charset-p ?a t))
@@ -94,7 +138,7 @@ otherwise, use a different charset."
                        (buffer-string))
                      "--------\n"))))
 
-(ert-deftest print-read-roundtrip ()
+(print-tests--deftest print-read-roundtrip ()
   (let ((syms (list '## '& '* '+ '- '/ '0E '0e '< '= '> 'E 'E0 'NaN '\"
                     '\# '\#x0 '\' '\'\' '\( '\) '\+00 '\, '\-0 '\. '\.0
                     '\0 '\0.0 '\0E0 '\0e0 '\1E+ '\1E+NaN '\1e+ '\1e+NaN
@@ -105,16 +149,207 @@ otherwise, use a different charset."
                     (intern "\N{ZERO WIDTH SPACE}")
                     (intern "\0"))))
     (dolist (sym syms)
-      (should (eq (read (prin1-to-string sym)) sym))
+      (should (eq (read (print-tests--prin1-to-string sym)) sym))
       (dolist (sym1 syms)
         (let ((sym2 (intern (concat (symbol-name sym) (symbol-name sym1)))))
-          (should (eq (read (prin1-to-string sym2)) sym2)))))))
+          (should (eq (read (print-tests--prin1-to-string sym2)) sym2)))))))
 
-(ert-deftest print-bignum ()
+(print-tests--deftest print-bignum ()
   (let* ((str "999999999999999999999999999999999")
          (val (read str)))
     (should (> val most-positive-fixnum))
-    (should (equal (prin1-to-string val) str))))
+    (should (equal (print-tests--prin1-to-string val) str))))
+
+(print-tests--deftest print-tests-print-gensym ()
+  "Printing observes `print-gensym'."
+  (let* ((sym1 (gensym))
+         (syms (list sym1 (gensym "x") (make-symbol "y") sym1)))
+    (let* ((print-circle nil)
+           (printed-with (let ((print-gensym t))
+                           (print-tests--prin1-to-string syms)))
+           (printed-without (let ((print-gensym nil))
+                              (print-tests--prin1-to-string syms))))
+      (should (string-match
+               "(#:\\(g[[:digit:]]+\\) #:x[[:digit:]]+ #:y #:\\(g[[:digit:]]+\\))$"
+               printed-with))
+      (should (string= (match-string 1 printed-with)
+                       (match-string 2 printed-with)))
+      (should (string-match "(g[[:digit:]]+ x[[:digit:]]+ y g[[:digit:]]+)$"
+                            printed-without)))
+    (let* ((print-circle t)
+           (printed-with (let ((print-gensym t))
+                           (print-tests--prin1-to-string syms)))
+           (printed-without (let ((print-gensym nil))
+                              (print-tests--prin1-to-string syms))))
+      (should (string-match "(#1=#:g[[:digit:]]+ #:x[[:digit:]]+ #:y #1#)$"
+                            printed-with))
+      (should (string-match "(g[[:digit:]]+ x[[:digit:]]+ y g[[:digit:]]+)$"
+                            printed-without)))))
+
+(print-tests--deftest print-tests-continuous-numbering ()
+  "Printing observes `print-continuous-numbering'."
+  ;; cl-print does not support print-continuous-numbering.
+  :expected-result (if (eq (symbol-function #'print-tests--prin1-to-string)
+                           #'cl-prin1-to-string) :failed :passed)
+  (let* ((x (list 1))
+         (y "hello")
+         (g (gensym))
+         (g2 (gensym))
+         (print-circle t)
+         (print-gensym t))
+    (let ((print-continuous-numbering t)
+          (print-number-table nil))
+      (should (string-match
+               "(#1=(1) #1# #2=\"hello\" #2#)(#3=#:g[[:digit:]]+ #3#)(#1# #2# #3#)#2#$"
+               (mapconcat #'print-tests--prin1-to-string `((,x ,x ,y ,y) (,g ,g) (,x ,y ,g) ,y) ""))))
+
+    ;; This is the special case for byte-compile-output-docform
+    ;; mentioned in a comment in print_preprocess.  When
+    ;; print-continuous-numbering and print-circle and print-gensym
+    ;; are all non-nil, print all gensyms with numbers even if they
+    ;; only occur once.
+    (let ((print-continuous-numbering t)
+          (print-number-table nil))
+      (should (string-match
+               "(#1=#:g[[:digit:]]+ #2=#:g[[:digit:]]+)$"
+               (print-tests--prin1-to-string (list g g2)))))))
+
+(cl-defstruct print--test a b)
+
+(print-tests--deftest print-tests-1 ()
+  "Test print code."
+  (let ((x (make-print--test :a 1 :b 2))
+        (rec (cond
+              ((eq (symbol-function #'print-tests--prin1-to-string) 'prin1-to-string)
+               "#s(print--test 1 2)")
+              ((eq (symbol-function #'print-tests--prin1-to-string) 'cl-prin1-to-string)
+               "#s(print--test :a 1 :b 2)")
+              (t (cl-assert nil)))))
+
+    (let ((print-circle nil))
+      (should (equal (print-tests--prin1-to-string `((x . ,x) (y . ,x)))
+                     (format "((x . %s) (y . %s))" rec rec))))
+    (let ((print-circle t))
+      (should (equal (print-tests--prin1-to-string `((x . ,x) (y . ,x)))
+                     (format "((x . #1=%s) (y . #1#))" rec))))))
+
+(print-tests--deftest 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#)\\'"
+               (print-tests--prin1-to-string (list x x)))))))
+
+(cl-defstruct (print-tests-struct
+               (:constructor print-tests-con))
+  a b c d e)
+
+(print-tests--deftest print-tests-3 ()
+  "Printing observes `print-length'."
+  (let ((long-list (make-list 5 'a))
+        (long-vec (make-vector 5 'b))
+        ;; (long-struct (print-tests-con))
+        ;; (long-string (make-string 5 ?a))
+        (print-length 4))
+    (should (equal "(a a a a ...)" (print-tests--prin1-to-string long-list)))
+    (should (equal "[b b b b ...]" (print-tests--prin1-to-string long-vec)))
+    ;; This one only prints 3 nils. Should it print 4?
+    ;; (should (equal "#s(print-tests-struct nil nil nil nil ...)"
+    ;;                (print-tests--prin1-to-string long-struct)))
+    ;; This one is only supported by cl-print
+    ;; (should (equal "\"aaaa...\"" (cl-print-tests--prin1-to-string long-string)))
+    ))
+
+(print-tests--deftest print-tests-4 ()
+  "Printing observes `print-level'."
+  (let* ((deep-list '(a (b (c (d (e))))))
+         (buried-vector '(a (b (c (d [e])))))
+         (deep-struct (print-tests-con))
+         (buried-struct `(a (b (c (d ,deep-struct)))))
+         (buried-string '(a (b (c (d #("hello" 0 5 (print-test t)))))))
+         (buried-simple-string '(a (b (c (d "hello")))))
+         (print-level 4))
+    (setf (print-tests-struct-a deep-struct) deep-list)
+    (should (equal "(a (b (c (d ...))))" (print-tests--prin1-to-string deep-list)))
+    (should (equal "(a (b (c (d \"hello\"))))"
+                   (print-tests--prin1-to-string buried-simple-string)))
+    (cond
+     ((eq (symbol-function #'print-tests--prin1-to-string) #'prin1-to-string)
+      (should (equal "(a (b (c (d [e]))))" (print-tests--prin1-to-string buried-vector)))
+      (should (equal "(a (b (c (d #s(print-tests-struct ... nil nil nil nil)))))"
+                     (print-tests--prin1-to-string buried-struct)))
+      (should (equal "(a (b (c (d #(\"hello\" 0 5 ...)))))"
+                     (print-tests--prin1-to-string buried-string)))
+      (should (equal "#s(print-tests-struct (a (b (c ...))) nil nil nil nil)"
+                     (print-tests--prin1-to-string deep-struct))))
+
+     ((eq (symbol-function #'print-tests--prin1-to-string) #'cl-prin1-to-string)
+      (should (equal "(a (b (c (d ...))))" (print-tests--prin1-to-string buried-vector)))
+      (should (equal "(a (b (c (d ...))))" (print-tests--prin1-to-string buried-struct)))
+      (should (equal "(a (b (c (d ...))))" (print-tests--prin1-to-string buried-string)))
+      (should (equal "#s(print-tests-struct :a (a (b (c ...))) :b nil :c nil :d nil :e nil)"
+                     (print-tests--prin1-to-string deep-struct))))
+     (t (cl-assert nil)))))
+
+(print-tests--deftest print-tests-5 ()
+  "Printing observes `print-quoted'."
+  (let ((quoted-stuff '('a #'b `(,c ,@d))))
+    (let ((print-quoted t))
+      (should (equal "('a #'b `(,c ,@d))"
+                     (print-tests--prin1-to-string quoted-stuff))))
+    (let ((print-quoted nil))
+      (should (equal "((quote a) (function b) (\\` ((\\, c) (\\,@ d))))"
+                     (print-tests--prin1-to-string quoted-stuff))))))
+
+(print-tests--deftest print-tests-strings ()
+  "Can print 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\"" (print-tests--prin1-to-string str1)))
+    (should (equal "#(\"abcdefghij\" 3 6 (bold t) 7 9 (italic t))"
+                   (print-tests--prin1-to-string str2)))
+    (should (equal "#(\"abcdefghij\" 0 10 (test t))"
+                   (print-tests--prin1-to-string str3)))
+    (let ((print-circle nil))
+      (should
+       (equal
+        "#(\"abcdefghij\" 0 5 (test (a b)) 7 10 (test (a b)))"
+        (print-tests--prin1-to-string str4))))
+    (let ((print-circle t))
+      (should
+       (equal
+        "#(\"abcdefghij\" 0 5 (test #1=(a b)) 7 10 (test #1#))"
+        (print-tests--prin1-to-string str4))))))
+
+(print-tests--deftest print-circle ()
+  (let ((x '(#1=(a . #1#) #1#)))
+    (let ((print-circle nil))
+      (should (string-match "\\`((a . #[0-9]) (a . #[0-9]))\\'"
+                            (print-tests--prin1-to-string x))))
+    (let ((print-circle t))
+      (should (equal "(#1=(a . #1#) #1#)" (print-tests--prin1-to-string x))))))
+
+(print-tests--deftest print-circle-2 ()
+   ;; Bug#31146.
+  (let ((x '(0 . #1=(0 . #1#))))
+    (let ((print-circle nil))
+      (should (string-match "\\`(0 0 . #[0-9])\\'"
+                            (print-tests--prin1-to-string x))))
+    (let ((print-circle t))
+      (should (equal "(0 . #1=(0 . #1#))" (print-tests--prin1-to-string x))))))
+
 
 (provide 'print-tests)
 ;;; print-tests.el ends here