diff options
| author | Michael Albinus | 2019-08-11 12:06:57 +0200 |
|---|---|---|
| committer | Michael Albinus | 2019-08-11 12:06:57 +0200 |
| commit | 95552e08db1688809b7f3979ed86033287fa5dc9 (patch) | |
| tree | fe8558cc6ce95a045e51dffdda5064d5e5adfc82 /test | |
| parent | 252704ded4657123d9ed95b9c2573ca5c1c38dc5 (diff) | |
| download | emacs-95552e08db1688809b7f3979ed86033287fa5dc9.tar.gz emacs-95552e08db1688809b7f3979ed86033287fa5dc9.zip | |
Retrieve start time from remote machine, use compat attrib functions
* lisp/net/tramp-compat.el (tramp-compat-file-attribute-access-time)
(tramp-compat-file-attribute-status-change-time): New defaliases.
* test/lisp/net/tramp-tests.el (tramp--test-start-time): New defvar.
(tramp--test-file-attributes-equal-p)
(tramp-test19-directory-files-and-attributes): Use it.
(tramp-test18-file-attributes)
(tramp--test-file-attributes-equal-p, tramp-test20-file-modes)
(tramp-test22-file-times, tramp--test-check-files):
Use `tramp-compat-file-attribute-*' functions.
Diffstat (limited to 'test')
| -rw-r--r-- | test/lisp/net/tramp-tests.el | 113 |
1 files changed, 72 insertions, 41 deletions
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 095c145e69b..180f746c647 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el | |||
| @@ -3007,22 +3007,28 @@ This tests also `access-file', `file-readable-p', | |||
| 3007 | ;; We do not test inodes and device numbers. | 3007 | ;; We do not test inodes and device numbers. |
| 3008 | (setq attr (file-attributes tmp-name1)) | 3008 | (setq attr (file-attributes tmp-name1)) |
| 3009 | (should (consp attr)) | 3009 | (should (consp attr)) |
| 3010 | (should (null (car attr))) | 3010 | (should (null (tramp-compat-file-attribute-type attr))) |
| 3011 | (should (numberp (nth 1 attr))) ;; Link. | 3011 | (should (numberp (tramp-compat-file-attribute-link-number attr))) |
| 3012 | (should (numberp (nth 2 attr))) ;; Uid. | 3012 | (should (numberp (tramp-compat-file-attribute-user-id attr))) |
| 3013 | (should (numberp (nth 3 attr))) ;; Gid. | 3013 | (should (numberp (tramp-compat-file-attribute-group-id attr))) |
| 3014 | ;; Last access time. | 3014 | (should |
| 3015 | (should (stringp (current-time-string (nth 4 attr)))) | 3015 | (stringp |
| 3016 | ;; Last modification time. | 3016 | (current-time-string |
| 3017 | (should (stringp (current-time-string (nth 5 attr)))) | 3017 | (tramp-compat-file-attribute-access-time attr)))) |
| 3018 | ;; Last status change time. | 3018 | (should |
| 3019 | (should (stringp (current-time-string (nth 6 attr)))) | 3019 | (stringp |
| 3020 | (should (numberp (nth 7 attr))) ;; Size. | 3020 | (current-time-string |
| 3021 | (should (stringp (nth 8 attr))) ;; Modes. | 3021 | (tramp-compat-file-attribute-modification-time attr)))) |
| 3022 | (should | ||
| 3023 | (stringp | ||
| 3024 | (current-time-string | ||
| 3025 | (tramp-compat-file-attribute-status-change-time attr)))) | ||
| 3026 | (should (numberp (tramp-compat-file-attribute-size attr))) | ||
| 3027 | (should (stringp (tramp-compat-file-attribute-modes attr))) | ||
| 3022 | 3028 | ||
| 3023 | (setq attr (file-attributes tmp-name1 'string)) | 3029 | (setq attr (file-attributes tmp-name1 'string)) |
| 3024 | (should (stringp (nth 2 attr))) ;; Uid. | 3030 | (should (stringp (tramp-compat-file-attribute-user-id attr))) |
| 3025 | (should (stringp (nth 3 attr))) ;; Gid. | 3031 | (should (stringp (tramp-compat-file-attribute-group-id attr))) |
| 3026 | 3032 | ||
| 3027 | (tramp--test-ignore-make-symbolic-link-error | 3033 | (tramp--test-ignore-make-symbolic-link-error |
| 3028 | (should-error | 3034 | (should-error |
| @@ -3041,7 +3047,7 @@ This tests also `access-file', `file-readable-p', | |||
| 3041 | (string-equal | 3047 | (string-equal |
| 3042 | (funcall | 3048 | (funcall |
| 3043 | (if quoted #'tramp-compat-file-name-quote #'identity) | 3049 | (if quoted #'tramp-compat-file-name-quote #'identity) |
| 3044 | (car attr)) | 3050 | (tramp-compat-file-attribute-type attr)) |
| 3045 | (file-remote-p (file-truename tmp-name1) 'localname))) | 3051 | (file-remote-p (file-truename tmp-name1) 'localname))) |
| 3046 | (delete-file tmp-name2)) | 3052 | (delete-file tmp-name2)) |
| 3047 | 3053 | ||
| @@ -3060,7 +3066,7 @@ This tests also `access-file', `file-readable-p', | |||
| 3060 | (setq attr (file-attributes tmp-name2)) | 3066 | (setq attr (file-attributes tmp-name2)) |
| 3061 | (should | 3067 | (should |
| 3062 | (string-equal | 3068 | (string-equal |
| 3063 | (car attr) | 3069 | (tramp-compat-file-attribute-type attr) |
| 3064 | (tramp-file-name-localname | 3070 | (tramp-file-name-localname |
| 3065 | (tramp-dissect-file-name tmp-name3)))) | 3071 | (tramp-dissect-file-name tmp-name3)))) |
| 3066 | (delete-file tmp-name2)) | 3072 | (delete-file tmp-name2)) |
| @@ -3076,24 +3082,22 @@ This tests also `access-file', `file-readable-p', | |||
| 3076 | (when (tramp--test-sh-p) | 3082 | (when (tramp--test-sh-p) |
| 3077 | (should (file-ownership-preserved-p tmp-name1 'group))) | 3083 | (should (file-ownership-preserved-p tmp-name1 'group))) |
| 3078 | (setq attr (file-attributes tmp-name1)) | 3084 | (setq attr (file-attributes tmp-name1)) |
| 3079 | (should (eq (car attr) t))) | 3085 | (should (eq (tramp-compat-file-attribute-type attr) t))) |
| 3080 | 3086 | ||
| 3081 | ;; Cleanup. | 3087 | ;; Cleanup. |
| 3082 | (ignore-errors (delete-directory tmp-name1)) | 3088 | (ignore-errors (delete-directory tmp-name1)) |
| 3083 | (ignore-errors (delete-file tmp-name1)) | 3089 | (ignore-errors (delete-file tmp-name1)) |
| 3084 | (ignore-errors (delete-file tmp-name2)))))) | 3090 | (ignore-errors (delete-file tmp-name2)))))) |
| 3085 | 3091 | ||
| 3092 | (defvar tramp--test-start-time nil | ||
| 3093 | "Keep the start time of the current test, a float number.") | ||
| 3094 | |||
| 3086 | (defsubst tramp--test-file-attributes-equal-p (attr1 attr2) | 3095 | (defsubst tramp--test-file-attributes-equal-p (attr1 attr2) |
| 3087 | "Check, whether file attributes ATTR1 and ATTR2 are equal. | 3096 | "Check, whether file attributes ATTR1 and ATTR2 are equal. |
| 3088 | They might differ only in time attributes or directory size." | 3097 | They might differ only in time attributes or directory size." |
| 3089 | (let ((attr1 (copy-sequence attr1)) | 3098 | (let ((attr1 (copy-sequence attr1)) |
| 3090 | (attr2 (copy-sequence attr2)) | 3099 | (attr2 (copy-sequence attr2)) |
| 3091 | (start-time | 3100 | (start-time (- tramp--test-start-time 10))) |
| 3092 | (- (float-time | ||
| 3093 | (aref | ||
| 3094 | (ert--stats-test-start-times ert--current-run-stats) | ||
| 3095 | (ert--stats-test-pos ert--current-run-stats (ert-running-test)))) | ||
| 3096 | 60))) | ||
| 3097 | ;; Access time. | 3101 | ;; Access time. |
| 3098 | (setcar (nthcdr 4 attr1) tramp-time-dont-know) | 3102 | (setcar (nthcdr 4 attr1) tramp-time-dont-know) |
| 3099 | (setcar (nthcdr 4 attr2) tramp-time-dont-know) | 3103 | (setcar (nthcdr 4 attr2) tramp-time-dont-know) |
| @@ -3101,30 +3105,47 @@ They might differ only in time attributes or directory size." | |||
| 3101 | ;; we cannot compare, and we normalize the time stamps. If the | 3105 | ;; we cannot compare, and we normalize the time stamps. If the |
| 3102 | ;; time value is newer than the test start time, normalize it, | 3106 | ;; time value is newer than the test start time, normalize it, |
| 3103 | ;; because due to caching the time stamps could differ slightly (a | 3107 | ;; because due to caching the time stamps could differ slightly (a |
| 3104 | ;; few seconds). We use a test start time minus 60 seconds, in | 3108 | ;; few seconds). We use a test start time minus 10 seconds, in |
| 3105 | ;; order to compensate a possible time offset on local and remote | 3109 | ;; order to compensate a possible timestamp resolution higher than |
| 3106 | ;; machines. | 3110 | ;; a second on the remote machine. |
| 3107 | (when (or (tramp-compat-time-equal-p (nth 5 attr1) tramp-time-dont-know) | 3111 | (when (or (tramp-compat-time-equal-p |
| 3108 | (tramp-compat-time-equal-p (nth 5 attr2) tramp-time-dont-know)) | 3112 | (tramp-compat-file-attribute-modification-time attr1) |
| 3113 | tramp-time-dont-know) | ||
| 3114 | (tramp-compat-time-equal-p | ||
| 3115 | (tramp-compat-file-attribute-modification-time attr2) | ||
| 3116 | tramp-time-dont-know)) | ||
| 3109 | (setcar (nthcdr 5 attr1) tramp-time-dont-know) | 3117 | (setcar (nthcdr 5 attr1) tramp-time-dont-know) |
| 3110 | (setcar (nthcdr 5 attr2) tramp-time-dont-know)) | 3118 | (setcar (nthcdr 5 attr2) tramp-time-dont-know)) |
| 3111 | (when (< start-time (float-time (nth 5 attr1))) | 3119 | (when (< start-time |
| 3120 | (float-time (tramp-compat-file-attribute-modification-time attr1))) | ||
| 3112 | (setcar (nthcdr 5 attr1) tramp-time-dont-know)) | 3121 | (setcar (nthcdr 5 attr1) tramp-time-dont-know)) |
| 3113 | (when (< start-time (float-time (nth 5 attr2))) | 3122 | (when (< start-time |
| 3123 | (float-time (tramp-compat-file-attribute-modification-time attr2))) | ||
| 3114 | (setcar (nthcdr 5 attr2) tramp-time-dont-know)) | 3124 | (setcar (nthcdr 5 attr2) tramp-time-dont-know)) |
| 3115 | ;; Status change time. Dito. | 3125 | ;; Status change time. Dito. |
| 3116 | (when (or (tramp-compat-time-equal-p (nth 6 attr1) tramp-time-dont-know) | 3126 | (when (or (tramp-compat-time-equal-p |
| 3117 | (tramp-compat-time-equal-p (nth 6 attr2) tramp-time-dont-know)) | 3127 | (tramp-compat-file-attribute-status-change-time attr1) |
| 3128 | tramp-time-dont-know) | ||
| 3129 | (tramp-compat-time-equal-p | ||
| 3130 | (tramp-compat-file-attribute-status-change-time attr2) | ||
| 3131 | tramp-time-dont-know)) | ||
| 3118 | (setcar (nthcdr 6 attr1) tramp-time-dont-know) | 3132 | (setcar (nthcdr 6 attr1) tramp-time-dont-know) |
| 3119 | (setcar (nthcdr 6 attr2) tramp-time-dont-know)) | 3133 | (setcar (nthcdr 6 attr2) tramp-time-dont-know)) |
| 3120 | (when (< start-time (float-time (nth 6 attr1))) | 3134 | (when |
| 3135 | (< start-time | ||
| 3136 | (float-time | ||
| 3137 | (tramp-compat-file-attribute-status-change-time attr1))) | ||
| 3121 | (setcar (nthcdr 6 attr1) tramp-time-dont-know)) | 3138 | (setcar (nthcdr 6 attr1) tramp-time-dont-know)) |
| 3122 | (when (< start-time (float-time (nth 6 attr2))) | 3139 | (when |
| 3140 | (< start-time | ||
| 3141 | (float-time (tramp-compat-file-attribute-status-change-time attr2))) | ||
| 3123 | (setcar (nthcdr 6 attr2) tramp-time-dont-know)) | 3142 | (setcar (nthcdr 6 attr2) tramp-time-dont-know)) |
| 3124 | ;; Size. Set it to 0 for directories, because it might have | 3143 | ;; Size. Set it to 0 for directories, because it might have |
| 3125 | ;; changed. For example the upper directory "../". | 3144 | ;; changed. For example the upper directory "../". |
| 3126 | (when (eq (car attr1) t) (setcar (nthcdr 7 attr1) 0)) | 3145 | (when (eq (tramp-compat-file-attribute-type attr1) t) |
| 3127 | (when (eq (car attr2) t) (setcar (nthcdr 7 attr2) 0)) | 3146 | (setcar (nthcdr 7 attr1) 0)) |
| 3147 | (when (eq (tramp-compat-file-attribute-type attr2) t) | ||
| 3148 | (setcar (nthcdr 7 attr2) 0)) | ||
| 3128 | ;; The check. | 3149 | ;; The check. |
| 3129 | (unless (equal attr1 attr2) (tramp--test-message "%S\n%S" attr1 attr2)) | 3150 | (unless (equal attr1 attr2) (tramp--test-message "%S\n%S" attr1 attr2)) |
| 3130 | (equal attr1 attr2))) | 3151 | (equal attr1 attr2))) |
| @@ -3147,6 +3168,10 @@ They might differ only in time attributes or directory size." | |||
| 3147 | (progn | 3168 | (progn |
| 3148 | (make-directory tmp-name1) | 3169 | (make-directory tmp-name1) |
| 3149 | (should (file-directory-p tmp-name1)) | 3170 | (should (file-directory-p tmp-name1)) |
| 3171 | (setq tramp--test-start-time | ||
| 3172 | (float-time | ||
| 3173 | (tramp-compat-file-attribute-modification-time | ||
| 3174 | (file-attributes tmp-name1)))) | ||
| 3150 | (make-directory tmp-name2) | 3175 | (make-directory tmp-name2) |
| 3151 | (should (file-directory-p tmp-name2)) | 3176 | (should (file-directory-p tmp-name2)) |
| 3152 | (write-region "foo" nil (expand-file-name "foo" tmp-name2)) | 3177 | (write-region "foo" nil (expand-file-name "foo" tmp-name2)) |
| @@ -3200,7 +3225,8 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'." | |||
| 3200 | (should (= (file-modes tmp-name) #o444)) | 3225 | (should (= (file-modes tmp-name) #o444)) |
| 3201 | (should-not (file-executable-p tmp-name)) | 3226 | (should-not (file-executable-p tmp-name)) |
| 3202 | ;; A file is always writable for user "root". | 3227 | ;; A file is always writable for user "root". |
| 3203 | (unless (zerop (nth 2 (file-attributes tmp-name))) | 3228 | (unless (zerop (tramp-compat-file-attribute-user-id |
| 3229 | (file-attributes tmp-name))) | ||
| 3204 | (should-not (file-writable-p tmp-name)))) | 3230 | (should-not (file-writable-p tmp-name)))) |
| 3205 | 3231 | ||
| 3206 | ;; Cleanup. | 3232 | ;; Cleanup. |
| @@ -3495,16 +3521,21 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." | |||
| 3495 | (progn | 3521 | (progn |
| 3496 | (write-region "foo" nil tmp-name1) | 3522 | (write-region "foo" nil tmp-name1) |
| 3497 | (should (file-exists-p tmp-name1)) | 3523 | (should (file-exists-p tmp-name1)) |
| 3498 | (should (consp (nth 5 (file-attributes tmp-name1)))) | 3524 | (should (consp (tramp-compat-file-attribute-modification-time |
| 3525 | (file-attributes tmp-name1)))) | ||
| 3499 | ;; Skip the test, if the remote handler is not able to set | 3526 | ;; Skip the test, if the remote handler is not able to set |
| 3500 | ;; the correct time. | 3527 | ;; the correct time. |
| 3501 | (skip-unless (set-file-times tmp-name1 (seconds-to-time 1))) | 3528 | (skip-unless (set-file-times tmp-name1 (seconds-to-time 1))) |
| 3502 | ;; Dumb remote shells without perl(1) or stat(1) are not | 3529 | ;; Dumb remote shells without perl(1) or stat(1) are not |
| 3503 | ;; able to return the date correctly. They say "don't know". | 3530 | ;; able to return the date correctly. They say "don't know". |
| 3504 | (unless (tramp-compat-time-equal-p | 3531 | (unless (tramp-compat-time-equal-p |
| 3505 | (nth 5 (file-attributes tmp-name1)) tramp-time-dont-know) | 3532 | (tramp-compat-file-attribute-modification-time |
| 3533 | (file-attributes tmp-name1)) | ||
| 3534 | tramp-time-dont-know) | ||
| 3506 | (should | 3535 | (should |
| 3507 | (equal (nth 5 (file-attributes tmp-name1)) (seconds-to-time 1))) | 3536 | (equal (tramp-compat-file-attribute-modification-time |
| 3537 | (file-attributes tmp-name1)) | ||
| 3538 | (seconds-to-time 1))) | ||
| 3508 | (write-region "bla" nil tmp-name2) | 3539 | (write-region "bla" nil tmp-name2) |
| 3509 | (should (file-exists-p tmp-name2)) | 3540 | (should (file-exists-p tmp-name2)) |
| 3510 | (should (file-newer-than-file-p tmp-name2 tmp-name1)) | 3541 | (should (file-newer-than-file-p tmp-name2 tmp-name1)) |
| @@ -5150,7 +5181,7 @@ This requires restrictions of file name syntax." | |||
| 5150 | (string-equal | 5181 | (string-equal |
| 5151 | (funcall | 5182 | (funcall |
| 5152 | (if quoted #'tramp-compat-file-name-quote #'identity) | 5183 | (if quoted #'tramp-compat-file-name-quote #'identity) |
| 5153 | (car (file-attributes file3))) | 5184 | (tramp-compat-file-attribute-type (file-attributes file3))) |
| 5154 | (file-remote-p (file-truename file1) 'localname))) | 5185 | (file-remote-p (file-truename file1) 'localname))) |
| 5155 | ;; Check file contents. | 5186 | ;; Check file contents. |
| 5156 | (with-temp-buffer | 5187 | (with-temp-buffer |