aboutsummaryrefslogtreecommitdiffstats
path: root/test/lisp
diff options
context:
space:
mode:
authorMichael Albinus2023-01-21 12:04:50 +0100
committerMichael Albinus2023-01-21 12:04:50 +0100
commitb875c9bf67ebf858648a00307c370d7a196aab56 (patch)
tree2e87ba14f0d61696d90d916ace737d468e6d818f /test/lisp
parent63fa225d443409038e531fb9843e6d22a2efc94a (diff)
downloademacs-b875c9bf67ebf858648a00307c370d7a196aab56.tar.gz
emacs-b875c9bf67ebf858648a00307c370d7a196aab56.zip
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)
Diffstat (limited to 'test/lisp')
-rw-r--r--test/lisp/net/tramp-archive-tests.el3
-rw-r--r--test/lisp/net/tramp-tests.el22
2 files changed, 24 insertions, 1 deletions
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'."
694 ;; Symlink. 694 ;; Symlink.
695 (should (file-exists-p tmp-name2)) 695 (should (file-exists-p tmp-name2))
696 (should (file-symlink-p tmp-name2)) 696 (should (file-symlink-p tmp-name2))
697 (should (file-regular-p tmp-name2))
697 (setq attr (file-attributes tmp-name2)) 698 (setq attr (file-attributes tmp-name2))
698 (should (string-equal (car attr) (file-name-nondirectory tmp-name1))) 699 (should (string-equal (car attr) (file-name-nondirectory tmp-name1)))
699 700
@@ -784,12 +785,14 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'."
784 (unwind-protect 785 (unwind-protect
785 (progn 786 (progn
786 (should (file-exists-p tmp-name1)) 787 (should (file-exists-p tmp-name1))
788 (should (file-regular-p tmp-name1))
787 (should (string-equal tmp-name1 (file-truename tmp-name1))) 789 (should (string-equal tmp-name1 (file-truename tmp-name1)))
788 ;; `make-symbolic-link' is not implemented. 790 ;; `make-symbolic-link' is not implemented.
789 (should-error 791 (should-error
790 (make-symbolic-link tmp-name1 tmp-name2) 792 (make-symbolic-link tmp-name1 tmp-name2)
791 :type 'file-error) 793 :type 'file-error)
792 (should (file-symlink-p tmp-name2)) 794 (should (file-symlink-p tmp-name2))
795 (should (file-regular-p tmp-name2))
793 (should 796 (should
794 (string-equal 797 (string-equal
795 ;; This is "/foo.txt". 798 ;; 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',
3495 (access-file tmp-name1 "error") 3495 (access-file tmp-name1 "error")
3496 :type 'file-missing) 3496 :type 'file-missing)
3497 3497
3498 (should-not (file-exists-p tmp-name1))
3499 (should-not (file-readable-p tmp-name1))
3500 (should-not (file-regular-p tmp-name1))
3498 ;; `file-ownership-preserved-p' should return t for 3501 ;; `file-ownership-preserved-p' should return t for
3499 ;; non-existing files. 3502 ;; non-existing files.
3500 (when test-file-ownership-preserved-p 3503 (when test-file-ownership-preserved-p
@@ -3579,7 +3582,7 @@ This tests also `access-file', `file-readable-p',
3579 (should (file-exists-p tmp-name1)) 3582 (should (file-exists-p tmp-name1))
3580 (should (file-readable-p tmp-name1)) 3583 (should (file-readable-p tmp-name1))
3581 (should-not (file-regular-p tmp-name1)) 3584 (should-not (file-regular-p tmp-name1))
3582 (should-not (access-file tmp-name1 "")) 3585 (should-not (access-file tmp-name1 "error"))
3583 (when test-file-ownership-preserved-p 3586 (when test-file-ownership-preserved-p
3584 (should (file-ownership-preserved-p tmp-name1 'group))) 3587 (should (file-ownership-preserved-p tmp-name1 'group)))
3585 (setq attr (file-attributes tmp-name1)) 3588 (setq attr (file-attributes tmp-name1))
@@ -3927,7 +3930,10 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
3927 (tramp--test-ignore-make-symbolic-link-error 3930 (tramp--test-ignore-make-symbolic-link-error
3928 (write-region "foo" nil tmp-name1) 3931 (write-region "foo" nil tmp-name1)
3929 (should (file-exists-p tmp-name1)) 3932 (should (file-exists-p tmp-name1))
3933 (should (file-regular-p tmp-name1))
3930 (make-symbolic-link tmp-name1 tmp-name2) 3934 (make-symbolic-link tmp-name1 tmp-name2)
3935 (should (file-exists-p tmp-name2))
3936 (should (file-regular-p tmp-name2))
3931 (should 3937 (should
3932 (string-equal 3938 (string-equal
3933 (funcall 3939 (funcall
@@ -3978,6 +3984,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
3978 (string-equal tmp-name1 (file-symlink-p tmp-name3)))) 3984 (string-equal tmp-name1 (file-symlink-p tmp-name3))))
3979 ;; Check directory as newname. 3985 ;; Check directory as newname.
3980 (make-directory tmp-name4) 3986 (make-directory tmp-name4)
3987 (should (file-directory-p tmp-name4))
3988 (should-not (file-regular-p tmp-name4))
3981 (when (tramp--test-expensive-test-p) 3989 (when (tramp--test-expensive-test-p)
3982 (should-error 3990 (should-error
3983 (make-symbolic-link tmp-name1 tmp-name4) 3991 (make-symbolic-link tmp-name1 tmp-name4)
@@ -3991,6 +3999,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
3991 (file-symlink-p tmp-name5))) 3999 (file-symlink-p tmp-name5)))
3992 ;; Check, that files in symlinked directories still work. 4000 ;; Check, that files in symlinked directories still work.
3993 (make-symbolic-link tmp-name4 tmp-name6) 4001 (make-symbolic-link tmp-name4 tmp-name6)
4002 (should (file-symlink-p tmp-name6))
4003 (should-not (file-regular-p tmp-name6))
3994 (write-region "foo" nil (expand-file-name "foo" tmp-name6)) 4004 (write-region "foo" nil (expand-file-name "foo" tmp-name6))
3995 (delete-file (expand-file-name "foo" tmp-name6)) 4005 (delete-file (expand-file-name "foo" tmp-name6))
3996 (should-not (file-exists-p (expand-file-name "foo" tmp-name4))) 4006 (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'."
4052 (tramp--test-ignore-make-symbolic-link-error 4062 (tramp--test-ignore-make-symbolic-link-error
4053 (write-region "foo" nil tmp-name1) 4063 (write-region "foo" nil tmp-name1)
4054 (should (file-exists-p tmp-name1)) 4064 (should (file-exists-p tmp-name1))
4065 (should (file-regular-p tmp-name1))
4055 (should (string-equal tmp-name1 (file-truename tmp-name1))) 4066 (should (string-equal tmp-name1 (file-truename tmp-name1)))
4056 (make-symbolic-link tmp-name1 tmp-name2) 4067 (make-symbolic-link tmp-name1 tmp-name2)
4057 (should (file-symlink-p tmp-name2)) 4068 (should (file-symlink-p tmp-name2))
4069 (should (file-regular-p tmp-name2))
4058 (should-not (string-equal tmp-name2 (file-truename tmp-name2))) 4070 (should-not (string-equal tmp-name2 (file-truename tmp-name2)))
4059 (should 4071 (should
4060 (string-equal (file-truename tmp-name1) (file-truename tmp-name2))) 4072 (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'."
4064 (let ((default-directory ert-remote-temporary-file-directory)) 4076 (let ((default-directory ert-remote-temporary-file-directory))
4065 (make-symbolic-link (file-name-nondirectory tmp-name1) tmp-name2)) 4077 (make-symbolic-link (file-name-nondirectory tmp-name1) tmp-name2))
4066 (should (file-symlink-p tmp-name2)) 4078 (should (file-symlink-p tmp-name2))
4079 (should (file-regular-p tmp-name2))
4067 (should-not (string-equal tmp-name2 (file-truename tmp-name2))) 4080 (should-not (string-equal tmp-name2 (file-truename tmp-name2)))
4068 (should 4081 (should
4069 (string-equal (file-truename tmp-name1) (file-truename tmp-name2))) 4082 (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'."
4079 (if quoted #'tramp-compat-file-name-unquote #'identity) penguin) 4092 (if quoted #'tramp-compat-file-name-unquote #'identity) penguin)
4080 tmp-name2) 4093 tmp-name2)
4081 (should (file-symlink-p tmp-name2)) 4094 (should (file-symlink-p tmp-name2))
4095 (should-not (file-regular-p tmp-name2))
4082 (should 4096 (should
4083 (string-equal 4097 (string-equal
4084 (file-truename tmp-name2) 4098 (file-truename tmp-name2)
@@ -4089,6 +4103,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
4089 (unless (tramp--test-windows-nt-p) 4103 (unless (tramp--test-windows-nt-p)
4090 (make-symbolic-link tmp-name1 tmp-name3) 4104 (make-symbolic-link tmp-name1 tmp-name3)
4091 (should (file-symlink-p tmp-name3)) 4105 (should (file-symlink-p tmp-name3))
4106 (should-not (file-regular-p tmp-name3))
4092 (should-not (string-equal tmp-name3 (file-truename tmp-name3))) 4107 (should-not (string-equal tmp-name3 (file-truename tmp-name3)))
4093 ;; `file-truename' returns a quoted file name for `tmp-name3'. 4108 ;; `file-truename' returns a quoted file name for `tmp-name3'.
4094 ;; We must unquote it. 4109 ;; We must unquote it.
@@ -4117,6 +4132,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
4117 (make-symbolic-link 4132 (make-symbolic-link
4118 tmp-name3 4133 tmp-name3
4119 (setq tmp-name3 (tramp--test-make-temp-name nil quoted)))) 4134 (setq tmp-name3 (tramp--test-make-temp-name nil quoted))))
4135 (should-not (file-regular-p tmp-name2))
4136 (should-not (file-regular-p tmp-name3))
4120 (should 4137 (should
4121 (string-equal 4138 (string-equal
4122 (file-truename tmp-name2) 4139 (file-truename tmp-name2)
@@ -4147,6 +4164,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
4147 (tramp--test-ignore-make-symbolic-link-error 4164 (tramp--test-ignore-make-symbolic-link-error
4148 (make-symbolic-link tmp-name2 tmp-name1) 4165 (make-symbolic-link tmp-name2 tmp-name1)
4149 (should (file-symlink-p tmp-name1)) 4166 (should (file-symlink-p tmp-name1))
4167 (should-not (file-regular-p tmp-name1))
4168 (should-not (file-regular-p tmp-name2))
4150 (if (tramp--test-smb-p) 4169 (if (tramp--test-smb-p)
4151 ;; The symlink command of "smbclient" detects the 4170 ;; The symlink command of "smbclient" detects the
4152 ;; cycle already. 4171 ;; cycle already.
@@ -4155,6 +4174,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
4155 :type 'file-error) 4174 :type 'file-error)
4156 (make-symbolic-link tmp-name1 tmp-name2) 4175 (make-symbolic-link tmp-name1 tmp-name2)
4157 (should (file-symlink-p tmp-name2)) 4176 (should (file-symlink-p tmp-name2))
4177 (should-not (file-regular-p tmp-name2))
4158 (should-error 4178 (should-error
4159 (file-truename tmp-name1) 4179 (file-truename tmp-name1)
4160 :type 'file-error)))) 4180 :type 'file-error))))