emacs-29 b875c9bf67e: Fix file-regular-p in Tramp

[Michael Albinus]

branch: emacs-29
commit b875c9bf67ebf858648a00307c370d7a196aab56
Author: Michael Albinus <michael.albinus@gmx.de>
Commit: Michael Albinus <michael.albinus@gmx.de>

    Fix file-regular-p in Tramp
    
    * test/lisp/net/tramp-archive-tests.el
    (tramp-archive-test18-file-attributes)
    (tramp-archive-test21-file-links):
    * test/lisp/net/tramp-tests.el (tramp-test18-file-attributes)
    (tramp-test21-file-links): Adapt tests.
    
    * lisp/net/tramp.el (tramp-handle-file-regular-p): Fix symlink
    case.  (Bug#60943)
---
 lisp/net/tramp.el                    | 12 +++++++++---
 test/lisp/net/tramp-archive-tests.el |  3 +++
 test/lisp/net/tramp-tests.el         | 22 +++++++++++++++++++++-
 3 files changed, 33 insertions(+), 4 deletions(-)

diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index f0b17ef3934..123d01c747d 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -4031,9 +4031,15 @@ Let-bind it when necessary.")
   "Like `file-regular-p' for Tramp files."
   (and (file-exists-p filename)
        ;; Sometimes, `file-attributes' does not return a proper value
-       ;; even if `file-exists-p' does.
-       (when-let ((attr (file-attributes filename)))
-        (eq ?- (aref (file-attribute-modes attr) 0)))))
+       ;; even if `file-exists-p' does.  Protect by `ignore-errors',
+       ;; because `file-truename' could raise an error for cyclic
+       ;; symlinks.
+       (ignore-errors
+        (when-let ((attr (file-attributes filename)))
+          (cond
+           ((eq ?- (aref (file-attribute-modes attr) 0)))
+           ((eq ?l (aref (file-attribute-modes attr) 0))
+            (file-regular-p (file-truename filename))))))))
 
 (defun tramp-handle-file-remote-p (filename &optional identification connected)
   "Like `file-remote-p' for Tramp files."
diff --git a/test/lisp/net/tramp-archive-tests.el 
b/test/lisp/net/tramp-archive-tests.el
index 96c1e78e37a..b28b32bc7d3 100644
--- a/test/lisp/net/tramp-archive-tests.el
+++ b/test/lisp/net/tramp-archive-tests.el
@@ -694,6 +694,7 @@ This tests also `access-file', `file-readable-p' and 
`file-regular-p'."
          ;; Symlink.
          (should (file-exists-p tmp-name2))
          (should (file-symlink-p tmp-name2))
+         (should (file-regular-p tmp-name2))
          (setq attr (file-attributes tmp-name2))
          (should (string-equal (car attr) (file-name-nondirectory tmp-name1)))
 
@@ -784,12 +785,14 @@ This tests also `file-executable-p', `file-writable-p' 
and `set-file-modes'."
     (unwind-protect
        (progn
          (should (file-exists-p tmp-name1))
+         (should (file-regular-p tmp-name1))
          (should (string-equal tmp-name1 (file-truename tmp-name1)))
          ;; `make-symbolic-link' is not implemented.
          (should-error
           (make-symbolic-link tmp-name1 tmp-name2)
           :type 'file-error)
          (should (file-symlink-p tmp-name2))
+         (should (file-regular-p tmp-name2))
          (should
           (string-equal
            ;; This is "/foo.txt".
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 0f21e3a45eb..ff0fc56043e 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -3495,6 +3495,9 @@ This tests also `access-file', `file-readable-p',
             (access-file tmp-name1 "error")
             :type 'file-missing)
 
+           (should-not (file-exists-p tmp-name1))
+           (should-not (file-readable-p tmp-name1))
+           (should-not (file-regular-p tmp-name1))
            ;; `file-ownership-preserved-p' should return t for
            ;; non-existing files.
            (when test-file-ownership-preserved-p
@@ -3579,7 +3582,7 @@ This tests also `access-file', `file-readable-p',
            (should (file-exists-p tmp-name1))
            (should (file-readable-p tmp-name1))
            (should-not (file-regular-p tmp-name1))
-           (should-not (access-file tmp-name1 ""))
+           (should-not (access-file tmp-name1 "error"))
            (when test-file-ownership-preserved-p
              (should (file-ownership-preserved-p tmp-name1 'group)))
            (setq attr (file-attributes tmp-name1))
@@ -3927,7 +3930,10 @@ This tests also `make-symbolic-link', `file-truename' 
and `add-name-to-file'."
          (tramp--test-ignore-make-symbolic-link-error
            (write-region "foo" nil tmp-name1)
            (should (file-exists-p tmp-name1))
+           (should (file-regular-p tmp-name1))
            (make-symbolic-link tmp-name1 tmp-name2)
+           (should (file-exists-p tmp-name2))
+           (should (file-regular-p tmp-name2))
            (should
             (string-equal
              (funcall
@@ -3978,6 +3984,8 @@ This tests also `make-symbolic-link', `file-truename' and 
`add-name-to-file'."
               (string-equal tmp-name1 (file-symlink-p tmp-name3))))
            ;; Check directory as newname.
            (make-directory tmp-name4)
+           (should (file-directory-p tmp-name4))
+           (should-not (file-regular-p tmp-name4))
            (when (tramp--test-expensive-test-p)
              (should-error
               (make-symbolic-link tmp-name1 tmp-name4)
@@ -3991,6 +3999,8 @@ This tests also `make-symbolic-link', `file-truename' and 
`add-name-to-file'."
              (file-symlink-p tmp-name5)))
            ;; Check, that files in symlinked directories still work.
            (make-symbolic-link tmp-name4 tmp-name6)
+           (should (file-symlink-p tmp-name6))
+           (should-not (file-regular-p tmp-name6))
            (write-region "foo" nil (expand-file-name "foo" tmp-name6))
            (delete-file (expand-file-name "foo" tmp-name6))
            (should-not (file-exists-p (expand-file-name "foo" tmp-name4)))
@@ -4052,9 +4062,11 @@ This tests also `make-symbolic-link', `file-truename' 
and `add-name-to-file'."
          (tramp--test-ignore-make-symbolic-link-error
            (write-region "foo" nil tmp-name1)
            (should (file-exists-p tmp-name1))
+           (should (file-regular-p tmp-name1))
            (should (string-equal tmp-name1 (file-truename tmp-name1)))
            (make-symbolic-link tmp-name1 tmp-name2)
            (should (file-symlink-p tmp-name2))
+           (should (file-regular-p tmp-name2))
            (should-not (string-equal tmp-name2 (file-truename tmp-name2)))
            (should
             (string-equal (file-truename tmp-name1) (file-truename tmp-name2)))
@@ -4064,6 +4076,7 @@ This tests also `make-symbolic-link', `file-truename' and 
`add-name-to-file'."
            (let ((default-directory ert-remote-temporary-file-directory))
              (make-symbolic-link (file-name-nondirectory tmp-name1) tmp-name2))
            (should (file-symlink-p tmp-name2))
+           (should (file-regular-p tmp-name2))
            (should-not (string-equal tmp-name2 (file-truename tmp-name2)))
            (should
             (string-equal (file-truename tmp-name1) (file-truename tmp-name2)))
@@ -4079,6 +4092,7 @@ This tests also `make-symbolic-link', `file-truename' and 
`add-name-to-file'."
                (if quoted #'tramp-compat-file-name-unquote #'identity) penguin)
               tmp-name2)
              (should (file-symlink-p tmp-name2))
+             (should-not (file-regular-p tmp-name2))
              (should
               (string-equal
                (file-truename tmp-name2)
@@ -4089,6 +4103,7 @@ This tests also `make-symbolic-link', `file-truename' and 
`add-name-to-file'."
            (unless (tramp--test-windows-nt-p)
              (make-symbolic-link tmp-name1 tmp-name3)
              (should (file-symlink-p tmp-name3))
+             (should-not (file-regular-p tmp-name3))
               (should-not (string-equal tmp-name3 (file-truename tmp-name3)))
              ;; `file-truename' returns a quoted file name for `tmp-name3'.
              ;; We must unquote it.
@@ -4117,6 +4132,8 @@ This tests also `make-symbolic-link', `file-truename' and 
`add-name-to-file'."
                (make-symbolic-link
                 tmp-name3
                 (setq tmp-name3 (tramp--test-make-temp-name nil quoted))))
+             (should-not (file-regular-p tmp-name2))
+             (should-not (file-regular-p tmp-name3))
              (should
               (string-equal
                (file-truename tmp-name2)
@@ -4147,6 +4164,8 @@ This tests also `make-symbolic-link', `file-truename' and 
`add-name-to-file'."
            (tramp--test-ignore-make-symbolic-link-error
             (make-symbolic-link tmp-name2 tmp-name1)
             (should (file-symlink-p tmp-name1))
+            (should-not (file-regular-p tmp-name1))
+            (should-not (file-regular-p tmp-name2))
             (if (tramp--test-smb-p)
                 ;; The symlink command of "smbclient" detects the
                 ;; cycle already.
@@ -4155,6 +4174,7 @@ 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-not (file-regular-p tmp-name2))
               (should-error
                (file-truename tmp-name1)
                :type 'file-error))))