Merge remote-tracking branch 'origin/master' into feature/android
This commit is contained in:
Po Lu
commit
8687f9309f
15 changed files with 143 additions and 109 deletions
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
6
etc/NEWS
6
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
|
||||
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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]))
|
||||
|
|
|
|||
|
|
@ -29,6 +29,7 @@
|
|||
|
||||
;;; Code:
|
||||
|
||||
(require 'ansi-color)
|
||||
(require 'auth-source)
|
||||
(require 'format-spec)
|
||||
(require 'ls-lisp) ;; Due to `tramp-handle-insert-directory'.
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
34
lisp/subr.el
34
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)))
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue