More error checks in Tramp's make-directory

* lisp/net/tramp-adb.el (tramp-adb-handle-make-directory):
* lisp/net/tramp-gvfs.el (tramp-gvfs-handle-make-directory):
* lisp/net/tramp-sh.el (tramp-sh-handle-make-directory):
* lisp/net/tramp-smb.el (tramp-smb-handle-make-directory):
* lisp/net/tramp-sudoedit.el (tramp-sudoedit-handle-make-directory):
Signal `file-already-exists' if DIR exists.

* test/lisp/net/tramp-tests.el (tramp-test04-substitute-in-file-name):
Fix thinko.
(tramp-test13-make-directory, tramp-test14-delete-directory)
(tramp-test15-copy-directory): Extend tests.

7 files changed, 29 insertions, 8 deletions

diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index a4f5760f72e..cfbda0824e7 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -514,6 +514,8 @@ Emacs dired can't find files."
   "Like `make-directory' for Tramp files."
   (setq dir (expand-file-name dir))
   (with-parsed-tramp-file-name dir nil
+    (when (and (null parents) (file-exists-p dir))
+      (tramp-error v 'file-already-exists "Directory already exists %s" dir))
     (when parents
       (let ((par (expand-file-name ".." dir)))
         (unless (file-directory-p par)
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index dbda24b9ac1..f13564c544e 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -1310,6 +1310,8 @@ file-notify events."
   "Like `make-directory' for Tramp files."
   (setq dir (directory-file-name (expand-file-name dir)))
   (with-parsed-tramp-file-name dir nil
+    (when (and (null parents) (file-exists-p dir))
+      (tramp-error v 'file-already-exists "Directory already exists %s" dir))
     (tramp-flush-directory-properties v localname)
     (save-match-data
       (let ((ldir (file-name-directory dir)))
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index be531ed3192..76bb10a277f 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -2513,6 +2513,8 @@ The method used must be an out-of-band method."
   "Like `make-directory' for Tramp files."
   (setq dir (expand-file-name dir))
   (with-parsed-tramp-file-name dir nil
+    (when (and (null parents) (file-exists-p dir))
+      (tramp-error v 'file-already-exists "Directory already exists %s" dir))
     ;; When PARENTS is non-nil, DIR could be a chain of non-existent
     ;; directories a/b/c/...  Instead of checking, we simply flush the
     ;; whole cache.
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index f87d4becfe0..95cdb4cbffe 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -1139,6 +1139,8 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
   (unless (file-name-absolute-p dir)
     (setq dir (expand-file-name dir default-directory)))
   (with-parsed-tramp-file-name dir nil
+    (when (and (null parents) (file-exists-p dir))
+      (tramp-error v 'file-already-exists "Directory already exists %s" dir))
     (let* ((ldir (file-name-directory dir)))
       ;; Make missing directory parts.
       (when (and parents
diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el
index e7a892c7465..43ac6ff66b3 100644
--- a/lisp/net/tramp-sudoedit.el
+++ b/lisp/net/tramp-sudoedit.el
@@ -587,6 +587,8 @@ the result will be a local, non-Tramp, file name."
   "Like `make-directory' for Tramp files."
   (setq dir (expand-file-name dir))
   (with-parsed-tramp-file-name dir nil
+    (when (and (null parents) (file-exists-p dir))
+      (tramp-error v 'file-already-exists "Directory already exists %s" dir))
     ;; When PARENTS is non-nil, DIR could be a chain of non-existent
     ;; directories a/b/c/...  Instead of checking, we simply flush the
     ;; whole cache.
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index acb5a93687c..09d125945a1 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -3019,8 +3019,8 @@ User is always nil."
 (defun tramp-handle-copy-directory
   (directory newname &optional keep-date parents copy-contents)
   "Like `copy-directory' for Tramp files."
-  ;; `directory-files' creates `newname' before running this check.
-  ;; So we do it ourselves.
+  ;; `copy-directory' creates NEWNAME before running this check.  So
+  ;; we do it ourselves.
   (unless (file-exists-p directory)
     (tramp-error
      (tramp-dissect-file-name directory) tramp-file-missing
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index ec9cda0bbdd..9b73f7ca28e 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -1958,7 +1958,7 @@ properly.  BODY shall not contain a timeout."
 
     ;; Forwhatever reasons, the following tests let Emacs crash for
     ;; Emacs 24 and Emacs 25, occasionally. No idea what's up.
-    (when (or (tramp--test-emacs26-p) (tramp--test-emacs27-p))
+    (when (tramp--test-emacs26-p)
       (should
        (string-equal (substitute-in-file-name "/method:host://~foo") "/~foo"))
       (should
@@ -2593,9 +2593,14 @@ This tests also `file-directory-p' and `file-accessible-directory-p'."
       (unwind-protect
           (progn
             (make-directory tmp-name1)
+            (should-error
+             (make-directory tmp-name1)
+             :type 'file-already-exists)
             (should (file-directory-p tmp-name1))
             (should (file-accessible-directory-p tmp-name1))
-            (should-error (make-directory tmp-name2) :type 'file-error)
+            (should-error
+             (make-directory tmp-name2)
+             :type 'file-error)
             (make-directory tmp-name2 'parents)
             (should (file-directory-p tmp-name2))
             (should (file-accessible-directory-p tmp-name2))
@@ -2627,7 +2632,9 @@ This tests also `file-directory-p' and `file-accessible-directory-p'."
       (should (file-directory-p tmp-name2))
       (write-region "foo" nil (expand-file-name "bla" tmp-name2))
       (should (file-exists-p (expand-file-name "bla" tmp-name2)))
-      (should-error (delete-directory tmp-name1) :type 'file-error)
+      (should-error
+       (delete-directory tmp-name1)
+       :type 'file-error)
       (delete-directory tmp-name1 'recursive)
       (should-not (file-directory-p tmp-name1)))))
 
@@ -2663,7 +2670,7 @@ This tests also `file-directory-p' and `file-accessible-directory-p'."
             (when (tramp--test-emacs26-p)
               (should-error
                (copy-directory tmp-name1 tmp-name2)
-               :type 'file-error))
+               :type 'file-already-exists))
             (copy-directory tmp-name1 (file-name-as-directory tmp-name2))
             (should (file-directory-p tmp-name3))
             (should (file-exists-p tmp-name6)))
@@ -3523,7 +3530,9 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
                   :type 'file-error)
                (make-symbolic-link tmp-name1 tmp-name2)
                (should (file-symlink-p tmp-name2))
-               (should-error (file-truename tmp-name1) :type 'file-error))))
+               (should-error
+                (file-truename tmp-name1)
+                :type 'file-error))))
 
         ;; Cleanup.
         (ignore-errors
@@ -4276,7 +4285,9 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
             (while (accept-process-output proc nil nil 0)))
           (should-not (process-live-p proc))
           ;; An interrupted process cannot be interrupted, again.
-          (should-error (interrupt-process proc) :type 'error))
+          (should-error
+           (interrupt-process proc)
+           :type 'error))
 
       ;; Cleanup.
       (ignore-errors (delete-process proc)))))