Create common tests for print.c and cl-print.el

* test/lisp/emacs-lisp/cl-print-tests.el
(cl-print--test, cl-print-tests-1, cl-print-tests-2)
(cl-print-tests-3, cl-print-tests-4, cl-print-tests-5)
(cl-print-tests-strings, cl-print-circle, cl-print-circle-2):
Remove.
* test/src/print-tests.el (print-tests--prin1-to-string): New
alias.
(print-tests--deftest): New macro.
(print-hex-backslash, print-read-roundtrip, print-bignum): Define with
print-tests--deftest and use print-tests--prin1-to-string.
(print-tests--prints-with-charset-p): Use
print-tests--prin1-to-string.
(print-tests--print-charset-text-property-nil)
(print-tests--print-charset-text-property-t)
(print-tests--print-charset-text-property-default): Define with
print-tests--deftest.
(print-tests-print-gensym)
(print-tests-continuous-numbering, print-tests-1, print-tests-2)
(print-tests-3, print-tests-4, print-tests-5)
(print-tests-strings, print-circle, print-circle-2): New tests.
(print--test, print-tests-struct): New cl-defstructs.

1 files changed, 3 insertions, 112 deletions

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))