* test/src/data-tests.el (data-tests-ash-lsh): Test for bug#79876.

* lisp/time-stamp.el (time-stamp-once): Do not look for additional
templates once we have displayed the warning about being disabled.
Move earlier the check for arguments being the correct type.
* test/lisp/time-stamp-tests.el (time-stamp-custom-messages): New test.

doc/misc/efaq.texi

@@ -4016,7 +4016,7 @@ Various spell-checkers are compatible with Emacs, including:
 @uref{http://aspell.net/}
 
 @item Ispell
-@uref{http://fmg-www.cs.ucla.edu/geoff/ispell.html}
+@uref{https://www.cs.hmc.edu/~geoff/ispell.html}
 
 @item Enchant
 @uref{https://abiword.github.io/enchant/}

lisp/cus-start.el

@@ -945,6 +945,9 @@ since it could result in memory overflow and make Emacs crash."
 		       (fboundp 'new-fontset))
                       ((string-match "xwidget-" (symbol-name symbol))
                        (boundp 'xwidget-internal))
+                      ((string-match "treesit-" (symbol-name symbol))
+                       ;; Any function from treesit.c will do.
+                       (fboundp 'treesit-language-available-p))
 		      (t t))))
     (if (not (boundp symbol))
 	;; If variables are removed from C code, give an error here!

lisp/emacs-lisp/cl-seq.el

@@ -134,7 +134,7 @@ the result of calling FUNCTION with zero arguments.  This is the
 only case where FUNCTION is called with fewer than two arguments.
 
 If SEQ contains exactly one element and no :INITIAL-VALUE is
-specified, then return that element and FUNCTION is not called.
+specified, then just return that element wihout calling FUNCTION.
 
 If :FROM-END is non-nil, the reduction occurs from the back of
 the SEQ moving forward, and the order of arguments to the

lisp/emacs-lisp/seq.el

@@ -385,8 +385,7 @@ third element of SEQUENCE, etc.  FUNCTION will be called with
 INITIAL-VALUE (and then the accumulated value) as the first
 argument, and the elements from SEQUENCE as the second argument.
 
-If SEQUENCE is empty, return INITIAL-VALUE and FUNCTION is not called.
-
+If SEQUENCE is empty, return INITIAL-VALUE without calling FUNCTION.
 This does not modify SEQUENCE."
   (if (seq-empty-p sequence)
       initial-value

lisp/face-remap.el

@@ -122,6 +122,10 @@ of face attribute/value pairs.  If more than one face is listed,
 that specifies an aggregate face, in the same way as in a `face'
 text property, except for possible priority changes noted below.
 
+If a face property list specifies `:font', the value should be
+either a font-spec object or the return value of `font-face-attributes'
+called with a font object, font spec, or font entity.
+
 The face remapping specified by SPECS takes effect alongside the
 remappings from other calls to `face-remap-add-relative' for the
 same FACE, as well as the normal definition of FACE (at lowest
@@ -192,6 +196,10 @@ The remaining arguments, SPECS, specify the base of the remapping.
 Each one of SPECS should be either a face name or a property list
 of face attribute/value pairs, like in a `face' text property.
 
+If a face property list specifies `:font', the value should be
+either a font-spec object or the return value of `font-face-attributes'
+called with a font object, font spec, or font entity.
+
 If SPECS is empty or a single face `eq' to FACE, call `face-remap-reset-base'
 to use the normal definition of FACE as the base remapping; note that
 this is different from SPECS containing a single value nil, which means
@@ -572,6 +580,10 @@ one face is listed, that specifies an aggregate face, like in a
 `face' text property.  If SPECS is nil or omitted, disable
 `buffer-face-mode'.
 
+If a face property list specifies `:font', the value should be
+either a font-spec object or the return value of `font-face-attributes'
+called with a font object, font spec, or font entity.
+
 This function makes the variable `buffer-face-mode-face' buffer
 local, and sets it to FACE."
   (interactive (list (read-face-name "Set buffer face" (face-at-point t))))
@@ -590,6 +602,10 @@ or a property list of face attributes and values.  If more than
 one face is listed, that specifies an aggregate face, like in a
 `face' text property.
 
+If a face property list specifies `:font', the value should be
+either a font-spec object or the return value of `font-face-attributes'
+called with a font object, font spec, or font entity.
+
 If `buffer-face-mode' is already enabled, and is currently using
 the face specs SPECS, then it is disabled; if `buffer-face-mode'
 is disabled, or is enabled and currently displaying some other
@@ -615,6 +631,10 @@ SPECS can be any value suitable for a `face' text property,
 including a face name, a plist of face attributes and values,
 or a list of faces.
 
+If a face property list specifies `:font', the value should be
+either a font-spec object or the return value of `font-face-attributes'
+called with a font object, font spec, or font entity.
+
 If INTERACTIVE is non-nil, display a message describing the
 result.
 

lisp/progmodes/eglot.el

@@ -251,6 +251,7 @@ automatically)."
          '("pylsp" "pyls" ("basedpyright-langserver" "--stdio")
            ("pyright-langserver" "--stdio")
            ("pyrefly" "lsp")
+           ("ty" "server")
            "jedi-language-server" ("ruff" "server") "ruff-lsp")))
     ((js-json-mode json-mode json-ts-mode jsonc-mode)
      . ,(eglot-alternatives '(("vscode-json-language-server" "--stdio")

lisp/time-stamp.el

@@ -392,6 +392,12 @@ to customize the information in the time stamp and where it is written."
 	(let ((nl-start 0))
 	  (while (string-match "\n" ts-format nl-start)
 	    (setq format-lines (1+ format-lines) nl-start (match-end 0)))))
+    (cond
+     ((not (and (stringp ts-start)
+                (stringp ts-end)))
+      (message "time-stamp-start or time-stamp-end is not a string")
+      (sit-for 1))
+     (t
       (let ((nl-start 0))
         (while (string-match "\n" ts-end nl-start)
           (setq end-lines (1+ end-lines) nl-start (match-end 0))))
@@ -416,7 +422,7 @@ to customize the information in the time stamp and where it is written."
         (setq start (time-stamp-once start search-limit ts-start ts-end
                                      ts-format format-lines end-lines))
         (setq ts-count (1- ts-count)))
-    (set-marker search-limit nil))
+      (set-marker search-limit nil))))
   nil)
 
 (defun time-stamp-once (start search-limit ts-start ts-end
@@ -463,11 +469,8 @@ Returns the end point, which is where `time-stamp' begins the next search."
 		;; don't signal an error in a hook
 		(progn
 		  (message "Warning: time-stamp-active is off; did not time-stamp buffer.")
-		  (sit-for 1))))
-	   ((not (and (stringp ts-start)
-		      (stringp ts-end)))
-	    (message "time-stamp-start or time-stamp-end is not a string")
-	    (sit-for 1))
+                  (sit-for 1)))
+            nil)
 	   (t
 	    (let ((new-time-stamp (time-stamp-string ts-format)))
 	      (if (and (stringp new-time-stamp)
@@ -484,10 +487,9 @@ Returns the end point, which is where `time-stamp' begins the next search."
 		      (if (search-backward "\t" start t)
 			  (progn
 			    (untabify start end)
-			    (setq end (point))))))))))))
-    ;; return the location after this time stamp, if there was one
-    (and end end-length
-         (+ end (max advance-nudge end-length)))))
+                            (setq end (point))))))))
+            ;; return the location after this time stamp
+            (+ end (max advance-nudge end-length))))))))
 
 
 ;;;###autoload

lisp/treesit.el

@@ -126,7 +126,8 @@ in a Emacs not built with tree-sitter library."
      (declare-function treesit-available-p "treesit.c")
 
      (defvar treesit-thing-settings)
-     (defvar treesit-major-mode-remap-alist)))
+     (defvar treesit-major-mode-remap-alist)
+     (defvar treesit-extra-load-path)))
 
 (treesit-declare-unavailable-functions)
 

lisp/vc/diff-mode.el

@@ -980,14 +980,17 @@ data such as \"Index: ...\" and such."
       (goto-char orig)
       (signal (car err) (cdr err)))))
 
-(defun diff-file-kill ()
-  "Kill current file's hunks."
+(defun diff-file-kill (&optional delete)
+  "Kill current file's hunks.
+When called from Lisp with optional argument DELETE non-nil, delete
+them, instead."
   (interactive)
   (if (not (diff--some-hunks-p))
       (error "No hunks")
     (diff-beginning-of-hunk t)
     (let ((inhibit-read-only t))
-      (apply #'kill-region (diff-bounds-of-file)))
+      (apply (if delete #'delete-region #'kill-region)
+             (diff-bounds-of-file)))
     (ignore-errors (diff-beginning-of-hunk t))))
 
 (defun diff-kill-junk ()
@@ -1052,7 +1055,7 @@ data such as \"Index: ...\" and such."
 (defvar diff-remembered-defdir nil)
 
 (defun diff-filename-drop-dir (file)
-  (when (string-match "/" file) (substring file (match-end 0))))
+  (and (string-match "[/\\]" file) (substring file (match-end 0))))
 
 (defun diff-merge-strings (ancestor from to)
   "Merge the diff between ANCESTOR and FROM into TO.
@@ -1209,6 +1212,21 @@ Optional arguments OLD and NOPROMPT are passed on to
                          (ignore-errors (diff-file-next)))
                        (point)))))
 
+(defun diff-kill-creations-deletions (&optional delete)
+  "Kill all hunks for file creations and deletions.
+Optional argument DELETE is passed on to `diff-file-kill'."
+  (save-excursion
+    (cl-loop initially
+             (goto-char (point-min))
+             (ignore-errors (diff-file-next))
+             for (name1 name2) = (diff-hunk-file-names)
+             if (or (equal name1 null-device)
+                    (equal name2 null-device))
+             do (diff-file-kill delete)
+             else if (eq (prog1 (point)
+                           (ignore-errors (diff-file-next)))
+                         (point))
+             do (cl-return))))
 
 (defun diff-ediff-patch ()
   "Call `ediff-patch-file' on the current buffer."

lisp/vc/vc-git.el

@@ -2340,10 +2340,10 @@ It is an error if REV is not on the current branch."
   (vc-git-command nil 0 nil "reset" "--hard" rev))
 
 (defun vc-git-uncommit-revisions-from-end (rev)
-  "Soft reset back to REV.
+  "Mixed reset back to REV.
 It is an error if REV is not on the current branch."
   (vc-git--assert-revision-on-branch rev (vc-git--current-branch))
-  (vc-git-command nil 0 nil "reset" "--soft" rev))
+  (vc-git-command nil 0 nil "reset" "--mixed" rev))
 
 (defvar vc-git-extra-menu-map
   (let ((map (make-sparse-keymap)))

lisp/vc/vc-svn.el

@@ -175,7 +175,8 @@ A value of `default' means to use the value of `vc-resolve-conflicts'."
   "SVN-specific version of `vc-state'."
   (let (process-file-side-effects)
     (with-temp-buffer
-      (cd (file-name-directory file))
+      (when-let* ((d (file-name-directory file)))
+        (cd d))
       (vc-svn-command t 0 file "status" "-v")
       (vc-svn-parse-status file))))
 

lisp/vc/vc.el

@@ -5268,6 +5268,34 @@ option to non-nil to skip the prompting."
   :group 'vc
   :version "31.1")
 
+(defun vc--fileset-by-state (fileset)
+  "Return alist of VC states of all files in FILESET.
+The keys into the alist are VC states, and the values are file names.
+For directories in FILESET, the alist includes values for all
+non-ignored, non-up-to-date files within those directories."
+  (let ((backend (car fileset))
+        (remaining (cadr fileset))
+        ret-val)
+    (while remaining
+      (cond* ((bind* (next (pop remaining))))
+             ((atom next)
+              (push next (alist-get (vc-state next backend) ret-val)))
+             ((bind* (file (car next))))
+             ((file-directory-p file)
+              (setq remaining
+                    (nconc (vc-dir-status-files file nil backend)
+                           remaining)))
+             (t
+              (push file (alist-get (cadr next) ret-val)))))
+    ret-val))
+
+(declare-function diff-kill-creations-deletions "diff-mode")
+(declare-function diff-filename-drop-dir "diff-mode")
+(declare-function diff-hunk-file-names "diff-mode")
+(declare-function diff-file-next "diff-mode")
+(defvar diff-hunk-header-re)
+(declare-function vc-dir-resynch-file "vc-dir")
+
 (defun vc--apply-to-other-working-tree
     (directory mirror-dir fileset patch-string move)
   "Workhorse routine for copying/moving changes to other working trees.
@@ -5285,15 +5313,79 @@ MOVE non-nil means to move instead of copy."
                        (propertize "move" 'face 'bold))))
     (user-error "Aborted"))
   (vc-buffer-sync-fileset fileset nil)
+  (let* ((fileset (cl-list* (car fileset)
+                            (mapcar #'file-relative-name (cadr fileset))
+                            (cddr fileset)))
+         (backend (car fileset))
+         (by-state (vc--fileset-by-state fileset))
+         (copies (append (alist-get 'added by-state)
+                         (alist-get 'unregistered by-state)))
+         (deletions (append (alist-get 'removed by-state)
+                            (alist-get 'missing by-state)))
+         (whole-files (append copies deletions))
+         (orig-dd default-directory)
+         non-empty-patch-p)
     (with-temp-buffer
-    (if (not patch-string)
-        (let ((display-buffer-overriding-action '(display-buffer-no-window
-                                                  (allow-no-window . t))))
-          (vc-diff-internal nil fileset nil nil nil (current-buffer)))
+      (cond* (patch-string
               (diff-mode)
               (insert patch-string))
+             ;; Some backends don't tolerate unregistered files
+             ;; appearing in the fileset for a diff operation.
+             ((bind* (diff-fileset
+                      `(,backend ,(cl-set-difference
+                                   (cadr fileset)
+                                   (alist-get 'unregistered by-state))))))
+             ;; An empty files list makes `vc-diff-internal' diff the
+             ;; whole of `default-directory'.
+             ((cadr diff-fileset)
+              (cl-letf ((display-buffer-overriding-action
+                         '(display-buffer-no-window (allow-no-window . t)))
+                        ;; Try to disable, e.g., Git's rename detection.
+                        ((symbol-value (vc-make-backend-sym backend
+                                                            'diff-switches))
+                         t))
+                (vc-diff-internal nil diff-fileset nil nil nil
+                                  (current-buffer))))
+             (t (require 'diff-mode)))
+      ;; We'll handle any `added', `removed', `missing' and
+      ;; `unregistered' files in FILESET by copying or moving whole
+      ;; files, so remove any of them that show up in the diff
+      ;; (only `added' and `removed' should actually show up).
+      (diff-kill-creations-deletions t)
+      (goto-char (point-min))
+      (if (not (setq non-empty-patch-p
+                     (re-search-forward diff-hunk-header-re nil t)))
+          ;; No hunks, so just sync WHOLE-FILES and skip over testing
+          ;; reverse-application to the source working tree.
           (let ((default-directory mirror-dir))
-      (vc-buffer-sync-fileset (diff-vc-deduce-fileset) nil))
+            (vc-buffer-sync-fileset `(,backend ,whole-files) nil))
+        ;; We cannot deal with renames, copies, and combinations of
+        ;; renames and copies with ordinary changes detected by the VCS.
+        ;; If we called `vc-diff-internal' just above then there shouldn't
+        ;; be any, but check to make sure.  And if PATCH-STRING is non-nil
+        ;; then we definitely need to check there aren't any.
+        ;;
+        ;; In order to be able to support these kinds of things, then
+        ;; rather than do it entirely ad hoc here, we probably want new
+        ;; VC states representing renames and copies.
+        ;; There is an old FIXME about this in `vc-state'.  --spwhitton
+        (cl-loop initially
+                 (goto-char (point-min))
+                 (ignore-errors (diff-file-next))
+                 for (name1 name2) = (diff-hunk-file-names)
+                 for name1* = (or (diff-filename-drop-dir name1) name1)
+                 and name2* = (or (diff-filename-drop-dir name2) name2)
+                 unless (equal name1* name2*)
+                 do (funcall (if patch-string #'user-error #'error)
+                             (format "Cannot %s renames and/or copies"
+                                     (if move "move" "apply")))
+                 until (eq (prog1 (point)
+                             (ignore-errors (diff-file-next)))
+                           (point)))
+        (let* ((default-directory mirror-dir)
+               (sync-fileset (diff-vc-deduce-fileset)))
+          (rplacd (last (cadr sync-fileset)) whole-files)
+          (vc-buffer-sync-fileset sync-fileset nil))
         (when-let* (move
                     (failed (diff-apply-buffer nil nil 'reverse 'test)))
           ;; If PATCH-STRING is non-nil and this fails, the user called us
@@ -5301,21 +5393,56 @@ MOVE non-nil means to move instead of copy."
           ;; a `user-error'.
           ;; If PATCH-STRING is nil and this fails, `vc-diff-internal'
           ;; generated a nonsense diff -- not the user's fault.
-      (funcall (if patch-string #'user-error #'error)
+          (funcall
+           (if patch-string #'user-error #'error)
            (ngettext "%d hunk does not reverse-apply to this working tree"
                      "%d hunks do not reverse-apply to this working tree"
                      failed)
-               failed))
-    (let ((default-directory mirror-dir))
-      (when-let* ((failed (diff-apply-buffer)))
+           failed)))
+      (let ((default-directory mirror-dir)
+            (mirror-states (make-hash-table :test #'equal)))
+        (pcase-dolist (`(,file ,state . ,_)
+                       (vc-dir-status-files mirror-dir nil backend))
+          (puthash file state mirror-states))
+        (dolist (copy copies)
+          (when (file-exists-p copy)
+            (user-error "`%s' already exists in `%s'"
+                        copy mirror-dir)))
+        (dolist (deletion deletions)
+          (when (memq (gethash deletion mirror-states)
+                      '(edited needs-merge unlocked-changes added
+                               conflict unregistered))
+            (user-error "`%s' in `%s' has incompatible state `%s'"
+                        deletion mirror-dir
+                        (gethash deletion mirror-states))))
+        (when-let* (non-empty-patch-p
+                    (failed (diff-apply-buffer)))
           (user-error (ngettext "%d hunk does not apply to `%s'"
                                 "%d hunks do not apply to `%s'"
                                 failed)
-                    failed directory)))
+                      failed directory))
+        ;; For both `added' & `unregistered' files we leave them
+        ;; unregistered in the target working tree, and for `removed' &
+        ;; `missing' files we leave them missing.  This means that if
+        ;; the user wants to throw away their copied changes it's less
+        ;; effort to do so.  If the user does want to check in the
+        ;; copied changes then VC-Dir will implicitly handle registering
+        ;; the additions and deletions as part of `vc-checkin'.
+        (dolist (copy copies)
+          (copy-file (expand-file-name copy orig-dd) copy))
+        (mapc #'delete-file deletions)
+        (when vc-dir-buffers
+          (mapc #'vc-dir-resynch-file whole-files)))
       (when move
-      (diff-apply-buffer nil nil 'reverse))
+        (diff-apply-buffer nil nil 'reverse)
+        (mapc (lambda (f) (vc-call-backend backend 'unregister f))
+              (alist-get 'added by-state))
+        (mapc #'delete-file copies)
+        (when vc-dir-buffers
+          (mapc #'vc-dir-resynch-file copies))
+        (vc-revert-files backend deletions))
       (message "Changes %s to `%s'"
-             (if move "moved" "applied") directory)))
+               (if move "moved" "applied") directory))))
 
 ;;;###autoload
 (defun vc-kill-other-working-tree-buffers (backend)

test/lisp/time-stamp-tests.el

@@ -34,11 +34,20 @@
          (ref-time1 '(17337 16613))    ;Monday, Jan 2, 2006, 3:04:05 PM
          (ref-time2 '(22574 61591))    ;Friday, Nov 18, 2016, 12:14:15 PM
          (ref-time3 '(21377 34956))    ;Sunday, May 25, 2014, 06:07:08 AM
+         (time-stamp-active t)         ;default, but user may have changed it
          (time-stamp-time-zone t))     ;use UTC
      (cl-letf (((symbol-function 'time-stamp-conv-warn)
                 (lambda (old-format _new &optional _newer)
                   (ert-fail
-                   (format "Unexpected format warning for '%s'" old-format)))))
+                   (format "Unexpected format warning for '%s'" old-format))))
+               ((symbol-function 'message)
+                (lambda (format-string &rest args)
+                  (ert-fail (format "Unexpected message: %s"
+                                    (apply #'format format-string args)))))
+               ((symbol-function 'sit-for)
+                (lambda (&rest _args)
+                  ;; do not wait during tests
+                  )))
        ;; Not all reference times are used in all tests;
        ;; suppress the byte compiler's "unused" warning.
        (list ref-time1 ref-time2 ref-time3)
@@ -62,17 +71,32 @@
               (lambda () ,name)))
      ,@body))
 
+
+(defmacro time-stamp-test--count-function-calls (fn errmsg &rest forms)
+  "Return a form verifying that FN is called while FORMS are evaluated."
+  (declare (debug t) (indent 2))
+  (cl-with-gensyms (g-warning-count)
+    `(let ((,g-warning-count 0))
+       (cl-letf (((symbol-function ',fn)
+                  (lambda (&rest _args)
+                    (incf ,g-warning-count))))
+         ,@forms
+         (unless (= ,g-warning-count 1)
+           (ert-fail (format "Should have warned about %s" ,errmsg)))))))
+
 (defmacro time-stamp-should-warn (form)
   "Similar to `should' and also verify that FORM generates a format warning."
   (declare (debug t))
-  (cl-with-gensyms (g-warning-count)
-    `(let ((,g-warning-count 0))
-       (cl-letf (((symbol-function 'time-stamp-conv-warn)
-                  (lambda (_old _new &optional _newer)
-                    (incf ,g-warning-count))))
-         (should ,form)
-         (unless (= ,g-warning-count 1)
-           (ert-fail (format "Should have warned about format: %S" ',form)))))))
+  `(time-stamp-test--count-function-calls
+       time-stamp-conv-warn (format "format: %S" ',form)
+     (should ,form)))
+
+(defmacro time-stamp-should-message (variable &rest body)
+  "Output a message about VARIABLE if `message' is not called by BODY."
+  (declare (indent 1) (debug t))
+  `(time-stamp-test--count-function-calls
+       message (format "variable %s" ',variable)
+     ,@body))
 
 ;;; Tests:
 
@@ -331,6 +355,31 @@
           (time-stamp)
           (should (equal (buffer-string) expected-2)))))))
 
+(ert-deftest time-stamp-custom-messages ()
+  "Test that various incorrect variable values warn and do not crash."
+  (with-time-stamp-test-env
+    (let ((time-stamp-line-limit 8.5))
+      (time-stamp-should-message time-stamp-line-limit
+        (time-stamp)))
+    (let ((time-stamp-count 1.5))
+      (time-stamp-should-message time-stamp-count
+        (time-stamp)))
+    (let ((time-stamp-start 17))
+      (time-stamp-should-message time-stamp-start
+        (time-stamp)))
+    (let ((time-stamp-end 17))
+      (time-stamp-should-message time-stamp-end
+        (time-stamp)))
+    (let ((time-stamp-active nil)
+          (buffer-original-contents "Time-stamp: <>"))
+      (with-temp-buffer
+        (time-stamp)                    ;with no template, no message
+        (insert buffer-original-contents)
+        (time-stamp-should-message time-stamp-active
+          (time-stamp))
+        (should (equal (buffer-string) buffer-original-contents))))
+    ))
+
 ;;; Tests of time-stamp-string formatting
 
 (eval-and-compile                       ;utility functions used by macros
@@ -1213,6 +1262,7 @@ Return non-nil if the definition is found."
 ;; eval: (put 'with-time-stamp-test-env 'lisp-indent-function 0)
 ;; eval: (put 'with-time-stamp-test-time 'lisp-indent-function 1)
 ;; eval: (put 'with-time-stamp-system-name 'lisp-indent-function 1)
+;; eval: (put 'time-stamp-should-message 'lisp-indent-function 1)
 ;; eval: (put 'define-formatz-tests 'lisp-indent-function 1)
 ;; End:
 

test/lisp/vc/vc-tests/vc-tests.el

@@ -3,6 +3,7 @@
 ;; Copyright (C) 2014-2025 Free Software Foundation, Inc.
 
 ;; Author: Michael Albinus <michael.albinus@gmx.de>
+;; Author: Sean Whitton <spwhitton@spwhitton.name>
 
 ;; This file is part of GNU Emacs.
 ;;
@@ -902,6 +903,108 @@ This checks also `vc-backend' and `vc-responsible-backend'."
           (ignore-errors
             (run-hooks 'vc-test--cleanup-hook)))))))
 
+(defun vc-test--apply-to-other-working-tree (backend)
+  "Test `vc--apply-to-other-working-tree'."
+  (ert-with-temp-directory _tempdir
+    (let ((vc-handled-backends `(,backend))
+          (default-directory
+           (file-name-as-directory
+            (expand-file-name
+             (make-temp-name "vc-test") temporary-file-directory)))
+          vc-test--cleanup-hook)
+      (vc-test--with-author-identity backend
+        (unwind-protect
+            (let ((first (file-truename
+                          (file-name-as-directory
+                           (expand-file-name "first" default-directory))))
+                  (second (file-truename
+                           (file-name-as-directory
+                            (expand-file-name "second" default-directory)))))
+              ;; Cleanup.
+              (add-hook 'vc-test--cleanup-hook
+                        (let ((dir default-directory))
+                          (lambda ()
+                            (delete-directory dir 'recursive))))
+
+              ;; Set up the two working trees.
+              (make-directory first 'parents)
+              (let ((default-directory first)
+                    (names '("foo" "bar" "baz")))
+                (vc-test--create-repo-function backend)
+                (dolist (str names)
+                  (write-region (concat str "\n") nil str nil 'nomessage)
+                  (vc-register `(,backend (,str))))
+                (vc-checkin names backend "Test files"))
+              ;; For the purposes of this test just copying the tree is
+              ;; enough.  FIRST and SECOND don't have to actually share
+              ;; a backing revisions store.
+              (copy-directory first (directory-file-name second))
+
+              ;; Make modifications that we will try to move.
+              (let ((default-directory first))
+                (write-region "qux\n" nil "qux" nil 'nomessage)
+                (vc-register `(,backend ("qux")))
+                (write-region "quux\n" nil "quux" nil 'nomessage)
+                (cl-letf (((symbol-function 'y-or-n-p) #'always))
+                  (vc-delete-file "bar"))
+                (delete-file "baz")
+                (write-region "foobar\n" nil "foo" nil 'nomessage)
+                (should (eq (vc-state "foo"  backend) 'edited))
+                (should (eq (vc-state "baz"  backend) 'missing))
+                (should (eq (vc-state "bar"  backend) 'removed))
+                (should (eq (vc-state "qux"  backend) 'added))
+                (should (eq (vc-state "quux" backend) 'unregistered)))
+
+              (cl-flet ((go ()
+                          (let ((default-directory first)
+                                (vc-no-confirm-moving-changes t))
+                            (vc--apply-to-other-working-tree
+                             second second `(,backend
+                                             ("foo" "bar" "baz" "qux" "quux"))
+                             nil t))))
+                (let ((default-directory second))
+                  ;; Set up a series of incompatibilities, one-by-one, and
+                  ;; try to move.  In each case the problem should block the
+                  ;; move from proceeding.
+
+                  ;; User refuses to sync destination fileset.
+                  (with-current-buffer (find-file-noselect "bar")
+                    (set-buffer-modified-p t)
+                    (cl-letf (((symbol-function 'y-or-n-p) #'ignore))
+                      (should-error (go)))
+                    (set-buffer-modified-p nil))
+
+                  ;; New file to be copied already exists.
+                  (with-temp-file "qux")
+                  (should-error (go))
+                  (delete-file "qux")
+
+                  ;; File to be deleted has changes.
+                  (write-region "foobar\n" nil "bar" nil 'nomessage)
+                  (should-error (go))
+                  (vc-revert-file "bar")
+
+                  ;; Finally, a move that should succeed.  Check that
+                  ;; everything we expected to happen did happen.
+                  (go)
+                  (with-current-buffer (find-file-noselect "foo")
+                    (should (equal (buffer-string) "foobar\n")))
+                  (should-not (file-exists-p "bar"))
+                  (should-not (file-exists-p "baz"))
+                  (should (file-exists-p "qux"))
+                  (should (file-exists-p "quux"))
+                  (let ((default-directory first))
+                    (with-current-buffer (find-file-noselect "foo")
+                      (should (equal (buffer-string) "foo\n")))
+                    (should (file-exists-p "bar"))
+                    (should (file-exists-p "baz"))
+                    (should-not (file-exists-p "qux"))
+                    (should-not (file-exists-p "quux"))))))
+
+          ;; Save exit.
+          (ignore-errors
+            (run-hooks 'vc-test--cleanup-hook)))))))
+
 ;; Create the test cases.
 
 (defun vc-test--rcs-enabled ()
@@ -1066,7 +1169,19 @@ This checks also `vc-backend' and `vc-responsible-backend'."
             (vc-test--other-working-trees ',backend)))
 
         (ert-deftest
-            ,(intern (format "vc-test-%s08-checkin-patch" backend-string)) ()
+            ,(intern (format "vc-test-%s08-apply-to-other-working-tree" backend-string)) ()
+          ,(format "Test `vc--apply-to-other-working-tree' with the %s backend."
+                   backend-string)
+          (skip-when
+	   (ert-test-skipped-p
+	    (ert-test-most-recent-result
+	     (ert-get-test
+	      ',(intern
+	         (format "vc-test-%s07-other-working-trees" backend-string))))))
+          (vc-test--apply-to-other-working-tree ',backend))
+
+        (ert-deftest
+            ,(intern (format "vc-test-%s09-checkin-patch" backend-string)) ()
           ,(format "Check preparing and checking in patches with the %s backend."
                    backend-string)
           (skip-unless

test/src/data-tests.el

@@ -797,6 +797,8 @@ comparing the subr with a much slower Lisp implementation."
   (should (= (ash (* 2 most-negative-fixnum) (* 2 most-negative-fixnum)) -1))
   (should (= (ash (* 2 most-negative-fixnum) -1)
 	     most-negative-fixnum))
+  (should (= (ash 1 48) #x1000000000000))
+  (should (= (ash 1 72) #x1000000000000000000))
   (with-suppressed-warnings ((suspicious lsh))
     (should (= (lsh most-negative-fixnum 1)
                (* most-negative-fixnum 2)))