diff options
| author | Michael Albinus | 2023-01-21 12:04:50 +0100 |
|---|---|---|
| committer | Michael Albinus | 2023-01-21 12:04:50 +0100 |
| commit | b875c9bf67ebf858648a00307c370d7a196aab56 (patch) | |
| tree | 2e87ba14f0d61696d90d916ace737d468e6d818f /test/lisp | |
| parent | 63fa225d443409038e531fb9843e6d22a2efc94a (diff) | |
| download | emacs-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.el | 3 | ||||
| -rw-r--r-- | test/lisp/net/tramp-tests.el | 22 |
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)))) |