Improved copy-tree documentation and test (bug#63509)

* etc/NEWS: Move entry since it's an incompatible change.
* lisp/emacs-lisp/shortdoc.el (vector): Make the example relevant.
* lisp/subr.el (copy-tree): Rename second argument,
since 'vector-like' is a term with a specific meaning in Emacs
but not the one intended here.
* doc/lispref/lists.texi (Building Lists): Rename second argument,
and make it clear that the input must be acyclic.
* doc/lispref/records.texi (Record Functions):
Be more precise: `copy-sequence` is used to copy records,
`copy-tree` copies trees made of records etc.
* test/lisp/subr-tests.el (subr--copy-tree): Extend and strengthen the
test considerably, using the print-circle trick to detect structure
sharing precisely.

1 files changed, 48 insertions, 29 deletions

diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el
index 4ebb68556be..1c220b1da18 100644
--- a/test/lisp/subr-tests.el
+++ b/test/lisp/subr-tests.el
@@ -1207,35 +1207,54 @@ final or penultimate step during initialization."))
     (should (eq a a-dedup))))
 
 (ert-deftest subr--copy-tree ()
-  (should (eq (copy-tree nil) nil))
-  (let* ((a (list (list "a") "b" (list "c") "g"))
-         (copy1 (copy-tree a))
-         (copy2 (copy-tree a t)))
-    (should (equal a copy1))
-    (should (equal a copy2))
-    (should-not (eq a copy1))
-    (should-not (eq a copy2)))
-  (let* ((a (list (list "a") "b" (list "c" (record 'foo "d")) (list ["e" "f"]) "g"))
-         (copy1 (copy-tree a))
-         (copy2 (copy-tree a t)))
-    (should (equal a copy1))
-    (should (equal a copy2))
-    (should-not (eq a copy1))
-    (should-not (eq a copy2)))
-  (let* ((a (record 'foo "a" (record 'bar "b")))
-         (copy1 (copy-tree a))
-         (copy2 (copy-tree a t)))
-    (should (equal a copy1))
-    (should (equal a copy2))
-    (should (eq a copy1))
-    (should-not (eq a copy2)))
-  (let* ((a ["a" "b" ["c" ["d"]]])
-         (copy1 (copy-tree a))
-         (copy2 (copy-tree a t)))
-    (should (equal a copy1))
-    (should (equal a copy2))
-    (should (eq a copy1))
-    (should-not (eq a copy2))))
+  ;; Check that values other than conses, vectors and records are
+  ;; neither copied nor traversed.
+  (let ((s (propertize "abc" 'prop (list 11 12)))
+        (h (make-hash-table :test #'equal)))
+    (puthash (list 1 2) (list 3 4) h)
+    (dolist (x (list nil 'a "abc" s h))
+      (should (eq (copy-tree x) x))
+      (should (eq (copy-tree x t) x))))
+
+  ;; Use the printer to detect common parts of Lisp values.
+  (let ((print-circle t))
+    (cl-labels ((prn3 (x y z) (prin1-to-string (list x y z)))
+                (cat3 (x y z) (concat "(" x " " y " " z ")")))
+      (let ((x '(a (b ((c) . d) e) (f))))
+        (should (equal (prn3 x (copy-tree x) (copy-tree x t))
+                       (cat3 "(a (b ((c) . d) e) (f))"
+                             "(a (b ((c) . d) e) (f))"
+                             "(a (b ((c) . d) e) (f))"))))
+      (let ((x '(a [b (c d)] #s(e (f [g])))))
+        (should (equal (prn3 x (copy-tree x) (copy-tree x t))
+                       (cat3 "(a #1=[b (c d)] #2=#s(e (f [g])))"
+                             "(a #1# #2#)"
+                             "(a [b (c d)] #s(e (f [g])))"))))
+      (let ((x [a (b #s(c d))]))
+        (should (equal (prn3 x (copy-tree x) (copy-tree x t))
+                       (cat3 "#1=[a (b #s(c d))]"
+                             "#1#"
+                             "[a (b #s(c d))]"))))
+      (let ((x #s(a (b [c d]))))
+        (should (equal (prn3 x (copy-tree x) (copy-tree x t))
+                       (cat3 "#1=#s(a (b [c d]))"
+                             "#1#"
+                             "#s(a (b [c d]))"))))
+      ;; Check cdr recursion.
+      (let ((x '(a b . [(c . #s(d))])))
+        (should (equal (prn3 x (copy-tree x) (copy-tree x t))
+                       (cat3 "(a b . #1=[(c . #s(d))])"
+                             "(a b . #1#)"
+                             "(a b . [(c . #s(d))])"))))
+      ;; Check that we can copy DAGs (the result is a tree).
+      (let ((x (list '(a b) nil [c d] nil #s(e f) nil)))
+        (setf (nth 1 x) (nth 0 x))
+        (setf (nth 3 x) (nth 2 x))
+        (setf (nth 5 x) (nth 4 x))
+        (should (equal (prn3 x (copy-tree x) (copy-tree x t))
+                       (cat3 "(#1=(a b) #1# #2=[c d] #2# #3=#s(e f) #3#)"
+                             "((a b) (a b) #2# #2# #3# #3#)"
+                             "((a b) (a b) [c d] [c d] #s(e f) #s(e f))")))))))
 
 (provide 'subr-tests)
 ;;; subr-tests.el ends here