diff --git a/doc/lispref/lists.texi b/doc/lispref/lists.texi
index 16ed0358974..6a00f2887e7 100644
--- a/doc/lispref/lists.texi
+++ b/doc/lispref/lists.texi
@@ -696,7 +696,7 @@ not a list, the sequence's elements do not become elements of the
 resulting list.  Instead, the sequence becomes the final @sc{cdr}, like
 any other non-list final argument.
 
-@defun copy-tree tree &optional vector-like-p
+@defun copy-tree tree &optional vectors-and-records
 This function returns a copy of the tree @var{tree}.  If @var{tree} is a
 cons cell, this makes a new cons cell with the same @sc{car} and
 @sc{cdr}, then recursively copies the @sc{car} and @sc{cdr} in the
@@ -704,9 +704,9 @@ same way.
 
 Normally, when @var{tree} is anything other than a cons cell,
 @code{copy-tree} simply returns @var{tree}.  However, if
-@var{vector-like-p} is non-@code{nil}, it copies vectors and records
-too (and operates recursively on their elements).  This function
-cannot cope with circular lists.
+@var{vectors-and-records} is non-@code{nil}, it copies vectors and records
+too (and operates recursively on their elements).  The @var{tree}
+argument must not contain cycles.
 @end defun
 
 @defun flatten-tree tree
diff --git a/doc/lispref/records.texi b/doc/lispref/records.texi
index ebc4569c388..287ad869297 100644
--- a/doc/lispref/records.texi
+++ b/doc/lispref/records.texi
@@ -81,8 +81,9 @@ This function returns a new record with type @var{type} and
 @end example
 @end defun
 
-To copy records, use @code{copy-tree} with its optional second argument
-non-@code{nil}.  @xref{Building Lists, copy-tree}.
+To copy trees consisting of records, vectors and conses (lists), use
+@code{copy-tree} with its optional second argument non-@code{nil}.
+@xref{Building Lists, copy-tree}.
 
 @node Backward Compatibility
 @section Backward Compatibility
diff --git a/etc/NEWS b/etc/NEWS
index 614b4b9169a..71d20e9da82 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -406,6 +406,9 @@ These hooks were named incorrectly, and so they never actually ran
 when unloading the correspending feature.  Instead, you should use
 hooks named after the feature name, like 'esh-mode-unload-hook'.
 
++++
+** 'copy-tree' now copies records when its optional 2nd argument is non-nil.
+
 
 * Lisp Changes in Emacs 30.1
 
@@ -621,9 +624,6 @@ Since circular alias chains now cannot occur, 'function-alias-p',
 'indirect-function' and 'indirect-variable' will never signal an error.
 Their 'noerror' arguments have no effect and are therefore obsolete.
 
-+++
-** 'copy-tree' now copies records when its optional 2nd argument is non-nil.
-
 
 * Changes in Emacs 30.1 on Non-Free Operating Systems
 
diff --git a/lisp/calc/calc-graph.el b/lisp/calc/calc-graph.el
index 3de761e19f8..1b9d25daf3b 100644
--- a/lisp/calc/calc-graph.el
+++ b/lisp/calc/calc-graph.el
@@ -598,9 +598,10 @@
 					(math-build-var-name (car math-arglist))
 					'(var DUMMY var-DUMMY)))))
     (setq calc-graph-ycache (assoc calc-graph-yvalue calc-graph-data-cache))
-    (delq calc-graph-ycache calc-graph-data-cache)
-    (nconc calc-graph-data-cache
-	   (list (or calc-graph-ycache (setq calc-graph-ycache (list calc-graph-yvalue)))))
+    (setq calc-graph-data-cache
+          (nconc (delq calc-graph-ycache calc-graph-data-cache)
+                 (list (or calc-graph-ycache
+                           (setq calc-graph-ycache (list calc-graph-yvalue))))))
     (if (and (not (setq calc-graph-xvec (eq (car-safe calc-graph-xvalue) 'vec)))
 	     calc-graph-refine (cdr (cdr calc-graph-ycache)))
 	(calc-graph-refine-2d)
diff --git a/lisp/calendar/appt.el b/lisp/calendar/appt.el
index 49597739446..11beee94e64 100644
--- a/lisp/calendar/appt.el
+++ b/lisp/calendar/appt.el
@@ -707,7 +707,7 @@ ARG is positive, otherwise off."
                         (not appt-active)))
     (remove-hook 'write-file-functions #'appt-update-list)
     (or global-mode-string (setq global-mode-string '("")))
-    (delq 'appt-mode-string global-mode-string)
+    (setq global-mode-string (delq 'appt-mode-string global-mode-string))
     (when appt-timer
       (cancel-timer appt-timer)
       (setq appt-timer nil))
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index 96ac9da4508..a07406e4c0d 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -957,7 +957,7 @@ Also see the `dired-confirm-shell-command' variable."
          ;; "&" instead.
          (cmd-sep (if (and (or (not w32-shell) file-remote)
 			   (not parallel-in-background))
-		      ";" "&"))
+		      "; " "& "))
 	 (stuff-it
 	  (if (dired--star-or-qmark-p command nil 'keep)
 	      (lambda (x)
@@ -988,7 +988,7 @@ Also see the `dired-confirm-shell-command' variable."
                ;; Add 'wait' to force those POSIX shells to wait until
                ;; all commands finish.
                (or (and parallel-in-background (not w32-shell)
-                        " &wait")
+                        " & wait")
                    "")))
       (t
        (let ((files (mapconcat #'shell-quote-argument
@@ -1000,9 +1000,9 @@ Also see the `dired-confirm-shell-command' variable."
           ;; Be consistent in how we treat inputs to commands -- do
           ;; the same here as in the `on-each' case.
           (if (and in-background (not w32-shell))
-              " &wait"
+              " & wait"
             "")))))
-     (or (and in-background "&")
+     (or (and in-background "& ")
          ""))))
 
 ;; This is an extra function so that it can be redefined by ange-ftp.
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index deda4573229..b8d7b63a81a 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -3561,7 +3561,7 @@ lambda-expression."
          ;; These functions are side-effect-free except for the
          ;; behaviour of functions passed as argument.
          mapcar mapcan mapconcat
-         assoc plist-get plist-member
+         assoc assoc-string plist-get plist-member
 
          ;; It's safe to ignore the value of `sort' and `nreverse'
          ;; when used on arrays, but most calls pass lists.
diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el
index 6580e0e4e0c..1e8ab4ad46d 100644
--- a/lisp/emacs-lisp/shortdoc.el
+++ b/lisp/emacs-lisp/shortdoc.el
@@ -834,7 +834,7 @@ A FUNC form can have any number of `:no-eval' (or `:no-value'),
    :eval (seq-subseq [1 2 3 4 5] 1 3)
    :eval (seq-subseq [1 2 3 4 5] 1))
   (copy-tree
-   :eval (copy-tree [1 2 3 4]))
+   :eval (copy-tree [1 (2 3) [4 5]] t))
   "Mapping Over Vectors"
   (mapcar
    :eval (mapcar #'identity [1 2 3]))
diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el
index 43544ae327e..40ea47ede40 100644
--- a/lisp/net/tramp-compat.el
+++ b/lisp/net/tramp-compat.el
@@ -29,6 +29,7 @@
 
 ;;; Code:
 
+(require 'ansi-color)
 (require 'auth-source)
 (require 'format-spec)
 (require 'ls-lisp) ;; Due to `tramp-handle-insert-directory'.
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 49e6d2d7aa9..d4933ad7ba6 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -80,13 +80,6 @@ the default storage location, e.g. \"$HOME/.sh_history\"."
                  (const :tag "Unset HISTFILE" t)
                  (string :tag "Redirect to a file")))
 
-;;;###tramp-autoload
-(defconst tramp-display-escape-sequence-regexp (rx "\e" (+ (any ";[" digit)) "m")
-  "Terminal control escape sequences for display attributes.")
-
-(defconst tramp-device-escape-sequence-regexp (rx "\e" (+ (any "[" digit)) "n")
-  "Terminal control escape sequences for device status.")
-
 ;; ksh on OpenBSD 4.5 requires that $PS1 contains a `#' character for
 ;; root users.  It uses the `$' character for other users.  In order
 ;; to guarantee a proper prompt, we use "#$ " for the prompt.
@@ -2654,7 +2647,7 @@ The method used must be an out-of-band method."
 	  (unless (tramp-compat-string-search
 		   "color" (tramp-get-connection-property v "ls" ""))
 	    (goto-char (point-min))
-	    (while (re-search-forward tramp-display-escape-sequence-regexp nil t)
+	    (while (re-search-forward ansi-color-control-seq-regexp nil t)
 	      (replace-match "")))
 
           ;; Now decode what read if necessary.  Stolen from `insert-directory'.
@@ -4323,6 +4316,7 @@ seconds.  If not, it produces an error message with the given ERROR-ARGS."
 	 proc timeout
 	 (rx
 	  (| (regexp shell-prompt-pattern) (regexp tramp-shell-prompt-pattern))
+	  (? (regexp ansi-color-control-seq-regexp))
 	  eos))
       (error
        (delete-process proc)
@@ -4831,6 +4825,7 @@ Goes through the list `tramp-inline-compress-commands'."
   "Check, whether local ssh OPTION is applicable."
   ;; We don't want to cache it persistently.
   (with-tramp-connection-property nil option
+    ;; "ssh -G" is introduced in OpenSSH 6.7.
     ;; We use a non-existing IP address for check, in order to avoid
     ;; useless connections, and DNS timeouts.
     (zerop
@@ -5306,7 +5301,7 @@ function waits for output unless NOOUTPUT is set."
 	   (regexp (rx
 		    (* (not (any "#$\n")))
 		    (literal tramp-end-of-output)
-		    (? (regexp tramp-device-escape-sequence-regexp))
+		    (? (regexp ansi-color-control-seq-regexp))
 		    (? "\r") eol))
 	   ;; Sometimes, the commands do not return a newline but a
 	   ;; null byte before the shell prompt, for example "git
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 910d534330c..f986d65d944 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -624,9 +624,7 @@ Sometimes the prompt is reported to look like \"login as:\"."
   ;; connection initialization; Tramp redefines the prompt afterwards.
   (rx (| bol "\r")
       (* (not (any "\n#$%>]")))
-      (? "#") (any "#$%>]") (* blank)
-      ;; Escape characters.
-      (* "[" (* (any ";" digit)) alpha (* blank)))
+      (? "#") (any "#$%>]") (* blank))
   "Regexp to match prompts from remote shell.
 Normally, Tramp expects you to configure `shell-prompt-pattern'
 correctly, but sometimes it happens that you are connecting to a
@@ -5711,6 +5709,12 @@ Wait, until the connection buffer changes."
   "Wait for output from the shell and perform one action.
 See `tramp-process-actions' for the format of ACTIONS."
   (let ((case-fold-search t)
+	(shell-prompt-pattern
+	 (rx (regexp shell-prompt-pattern)
+	     (? (regexp ansi-color-control-seq-regexp))))
+	(tramp-shell-prompt-pattern
+	 (rx (regexp tramp-shell-prompt-pattern)
+	     (? (regexp ansi-color-control-seq-regexp))))
 	tramp-process-action-regexp
 	found todo item pattern action)
     (while (not found)
@@ -5721,7 +5725,7 @@ See `tramp-process-actions' for the format of ACTIONS."
       (while todo
 	(setq item (pop todo)
 	      tramp-process-action-regexp (symbol-value (nth 0 item))
-	      pattern (format "\\(%s\\)\\'" tramp-process-action-regexp)
+	      pattern (rx (group (regexp tramp-process-action-regexp)) eos)
 	      action (nth 1 item))
 	(tramp-message
 	 vec 5 "Looking for regexp \"%s\" from remote shell" pattern)
@@ -6278,8 +6282,7 @@ to cache the result.  Return the modified ATTR."
 	       (save-match-data
 		 ;; Remove color escape sequences from symlink.
 		 (when (stringp (car attr))
-		   (while (string-match
-			   tramp-display-escape-sequence-regexp (car attr))
+		   (while (string-match ansi-color-control-seq-regexp (car attr))
 		     (setcar attr (replace-match "" nil nil (car attr)))))
 		 ;; Convert uid and gid.  Use `tramp-unknown-id-integer'
 		 ;; as indication of unusable value.
diff --git a/lisp/progmodes/cc-styles.el b/lisp/progmodes/cc-styles.el
index fc4f723915c..e412a52cfb8 100644
--- a/lisp/progmodes/cc-styles.el
+++ b/lisp/progmodes/cc-styles.el
@@ -658,8 +658,9 @@ any reason to call this function directly."
   (let ((func (if this-buf-only-p
 		  'make-local-variable
 		'make-variable-buffer-local))
-	(varsyms (cons 'c-indentation-style (copy-alist c-style-variables))))
-    (delq 'c-special-indent-hook varsyms)
+	(varsyms (cons 'c-indentation-style
+		       (delq 'c-special-indent-hook
+			     (copy-alist c-style-variables)))))
     (mapc func varsyms)
     ;; Hooks must be handled specially
     (if this-buf-only-p
diff --git a/lisp/subr.el b/lisp/subr.el
index b67d881c969..73f3cd4a28e 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -824,26 +824,31 @@ of course, also replace TO with a slightly larger value
                 next (+ from (* n inc)))))
       (nreverse seq))))
 
-(defun copy-tree (tree &optional vector-like-p)
+(defun copy-tree (tree &optional vectors-and-records)
   "Make a copy of TREE.
 If TREE is a cons cell, this recursively copies both its car and its cdr.
-Contrast to `copy-sequence', which copies only along the cdrs.  With second
-argument VECTOR-LIKE-P, this copies vectors and records as well as conses."
+Contrast to `copy-sequence', which copies only along the cdrs.
+With the second argument VECTORS-AND-RECORDS non-nil, this
+traverses and copies vectors and records as well as conses."
   (declare (side-effect-free error-free))
   (if (consp tree)
       (let (result)
 	(while (consp tree)
 	  (let ((newcar (car tree)))
-	    (if (or (consp (car tree)) (and vector-like-p (or (vectorp (car tree)) (recordp (car tree)))))
-		(setq newcar (copy-tree (car tree) vector-like-p)))
+	    (if (or (consp (car tree))
+                    (and vectors-and-records
+                         (or (vectorp (car tree)) (recordp (car tree)))))
+		(setq newcar (copy-tree (car tree) vectors-and-records)))
 	    (push newcar result))
 	  (setq tree (cdr tree)))
 	(nconc (nreverse result)
-               (if (and vector-like-p (or (vectorp tree) (recordp tree))) (copy-tree tree vector-like-p) tree)))
-    (if (and vector-like-p (or (vectorp tree) (recordp tree)))
+               (if (and vectors-and-records (or (vectorp tree) (recordp tree)))
+                   (copy-tree tree vectors-and-records)
+                 tree)))
+    (if (and vectors-and-records (or (vectorp tree) (recordp tree)))
 	(let ((i (length (setq tree (copy-sequence tree)))))
 	  (while (>= (setq i (1- i)) 0)
-	    (aset tree i (copy-tree (aref tree i) vector-like-p)))
+	    (aset tree i (copy-tree (aref tree i) vectors-and-records)))
 	  tree)
       tree)))
 
@@ -888,6 +893,7 @@ Non-strings in LIST are ignored."
 Compare keys with TEST.  Defaults to `equal'.
 Return the modified alist.
 Elements of ALIST that are not conses are ignored."
+  (declare (important-return-value t))
   (unless test (setq test #'equal))
   (while (and (consp (car alist))
 	      (funcall test (caar alist) key))
@@ -904,12 +910,14 @@ Elements of ALIST that are not conses are ignored."
   "Delete from ALIST all elements whose car is `eq' to KEY.
 Return the modified alist.
 Elements of ALIST that are not conses are ignored."
+  (declare (important-return-value t))
   (assoc-delete-all key alist #'eq))
 
 (defun rassq-delete-all (value alist)
   "Delete from ALIST all elements whose cdr is `eq' to VALUE.
 Return the modified alist.
 Elements of ALIST that are not conses are ignored."
+  (declare (important-return-value t))
   (while (and (consp (car alist))
 	      (eq (cdr (car alist)) value))
     (setq alist (cdr alist)))
@@ -952,6 +960,7 @@ Example:
   (setf (alist-get \\='b foo nil \\='remove) nil)
 
   foo => ((a . 1))"
+  (declare (important-return-value t))
   (ignore remove) ;;Silence byte-compiler.
   (let ((x (if (not testfn)
                (assq key alist)
@@ -6973,7 +6982,10 @@ returned list are in the same order as in TREE.
   "Trim STRING of leading string matching REGEXP.
 
 REGEXP defaults to \"[ \\t\\n\\r]+\"."
-  (if (string-match (concat "\\`\\(?:" (or regexp "[ \t\n\r]+") "\\)") string)
+  (if (string-match (if regexp
+                        (concat "\\`\\(?:" regexp "\\)")
+                      "\\`[ \t\n\r]+")
+                    string)
       (substring string (match-end 0))
     string))
 
@@ -6982,7 +6994,9 @@ REGEXP defaults to \"[ \\t\\n\\r]+\"."
 
 REGEXP defaults to  \"[ \\t\\n\\r]+\"."
   (declare (side-effect-free t))
-  (let ((i (string-match-p (concat "\\(?:" (or regexp "[ \t\n\r]+") "\\)\\'")
+  (let ((i (string-match-p (if regexp
+                               (concat "\\(?:" regexp "\\)\\'")
+                             "[ \t\n\r]+\\'")
                            string)))
     (if i (substring string 0 i) string)))
 
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 6c773908e26..eec4a66a329 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -66,7 +66,6 @@
 (defvar ange-ftp-make-backup-files)
 (defvar tramp-connection-properties)
 (defvar tramp-copy-size-limit)
-(defvar tramp-display-escape-sequence-regexp)
 (defvar tramp-fuse-remove-hidden-files)
 (defvar tramp-fuse-unmount-on-cleanup)
 (defvar tramp-inline-compress-start-size)
@@ -4941,8 +4940,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
 		    (if (bufferp destination) destination (current-buffer))
 		  ;; "ls" could produce colorized output.
 		  (goto-char (point-min))
-		  (while (re-search-forward
-			  tramp-display-escape-sequence-regexp nil t)
+		  (while (re-search-forward ansi-color-control-seq-regexp nil t)
 		    (replace-match "" nil nil))
 		  (should
 		   (string-equal (if destination (format "%s\n" fnnd) "")
@@ -4956,8 +4954,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
 		    (if (bufferp destination) destination (current-buffer))
 		  ;; "ls" could produce colorized output.
 		  (goto-char (point-min))
-		  (while (re-search-forward
-			  tramp-display-escape-sequence-regexp nil t)
+		  (while (re-search-forward ansi-color-control-seq-regexp nil t)
 		    (replace-match "" nil nil))
 		  (should
 		   (string-equal
@@ -5671,8 +5668,7 @@ INPUT, if non-nil, is a string sent to the process."
 	       (current-buffer))
 	      ;; "ls" could produce colorized output.
 	      (goto-char (point-min))
-	      (while
-		  (re-search-forward tramp-display-escape-sequence-regexp nil t)
+	      (while (re-search-forward ansi-color-control-seq-regexp nil t)
 		(replace-match "" nil nil))
 	      (should
 	       (string-equal
@@ -7589,34 +7585,37 @@ process sentinels.  They shall not disturb each other."
 
             ;; Send a string to the processes.  Use a random order of
             ;; the buffers.  Mix with regular operation.
-            (let ((buffers (copy-sequence buffers)))
+            (let ((buffers (copy-sequence buffers))
+		  buf)
               (while buffers
-                (let* ((buf (seq-random-elt buffers))
-                       (proc (get-buffer-process buf))
-                       (file (process-get proc 'foo))
-                       (count (process-get proc 'bar)))
-                  (tramp--test-message
-                   "Start action %d %s %s" count buf (current-time-string))
-                  ;; Regular operation prior process action.
-		  (dired-uncache file)
-                  (if (= count 0)
-                      (should-not (file-attributes file))
-                    (should (file-attributes file)))
-                  ;; Send string to process.
-                  (process-send-string proc (format "%s\n" (buffer-name buf)))
-                  (while (accept-process-output nil 0))
-                  (tramp--test-message
-                   "Continue action %d %s %s" count buf (current-time-string))
-                  ;; Regular operation post process action.
-		  (dired-uncache file)
-                  (if (= count 2)
-                      (should-not (file-attributes file))
-                    (should (file-attributes file)))
-                  (tramp--test-message
-                   "Stop action %d %s %s" count buf (current-time-string))
-                  (process-put proc 'bar (1+ count))
-                  (unless (process-live-p proc)
-                    (setq buffers (delq buf buffers))))))
+		(setq buf (seq-random-elt buffers))
+                (if-let ((proc (get-buffer-process buf))
+			 (file (process-get proc 'foo))
+			 (count (process-get proc 'bar)))
+		    (progn
+                      (tramp--test-message
+                       "Start action %d %s %s" count buf (current-time-string))
+                      ;; Regular operation prior process action.
+		      (dired-uncache file)
+                      (if (= count 0)
+			  (should-not (file-attributes file))
+			(should (file-attributes file)))
+                      ;; Send string to process.
+                      (process-send-string proc (format "%s\n" (buffer-name buf)))
+                      (while (accept-process-output nil 0))
+                      (tramp--test-message
+                       "Continue action %d %s %s" count buf (current-time-string))
+                      ;; Regular operation post process action.
+		      (dired-uncache file)
+                      (if (= count 2)
+			  (should-not (file-attributes file))
+			(should (file-attributes file)))
+                      (tramp--test-message
+                       "Stop action %d %s %s" count buf (current-time-string))
+                      (process-put proc 'bar (1+ count))
+                      (unless (process-live-p proc)
+			(setq buffers (delq buf buffers))))
+		  (setq buffers (delq buf buffers)))))
 
             ;; Checks.  All process output shall exist in the
             ;; respective buffers.  All created files shall be
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