Commit 95552e08 authored by Michael Albinus's avatar Michael Albinus
Browse files

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.
parent 252704de
Pipeline #2813 failed with stage
in 52 minutes and 54 seconds
......@@ -136,6 +136,14 @@ looked up, a numeric value, either an integer or a float, is
returned."
(nth 3 attributes))))
(defalias 'tramp-compat-file-attribute-access-time
(if (fboundp 'file-attribute-access-time)
#'file-attribute-access-time
(lambda (attributes)
"The last access time in ATTRIBUTES returned by `file-attributes'.
This a Lisp timestamp in the style of `current-time'."
(nth 4 attributes))))
(defalias 'tramp-compat-file-attribute-modification-time
(if (fboundp 'file-attribute-modification-time)
#'file-attribute-modification-time
......@@ -145,6 +153,16 @@ This is the time of the last change to the file's contents, and
is a Lisp timestamp in the style of `current-time'."
(nth 5 attributes))))
(defalias 'tramp-compat-file-attribute-status-change-time
(if (fboundp 'file-attribute-status-change-time)
#'file-attribute-status-change-time
(lambda (attributes)
"The status modification time in ATTRIBUTES returned by `file-attributes'.
This is the time of last change to the file's attributes: owner
and group, access mode bits, etc., and is a Lisp timestamp in the
style of `current-time'."
(nth 6 attributes))))
(defalias 'tramp-compat-file-attribute-size
(if (fboundp 'file-attribute-size)
#'file-attribute-size
......
......@@ -3007,22 +3007,28 @@ This tests also `access-file', `file-readable-p',
;; We do not test inodes and device numbers.
(setq attr (file-attributes tmp-name1))
(should (consp attr))
(should (null (car attr)))
(should (numberp (nth 1 attr))) ;; Link.
(should (numberp (nth 2 attr))) ;; Uid.
(should (numberp (nth 3 attr))) ;; Gid.
;; Last access time.
(should (stringp (current-time-string (nth 4 attr))))
;; Last modification time.
(should (stringp (current-time-string (nth 5 attr))))
;; Last status change time.
(should (stringp (current-time-string (nth 6 attr))))
(should (numberp (nth 7 attr))) ;; Size.
(should (stringp (nth 8 attr))) ;; Modes.
(should (null (tramp-compat-file-attribute-type attr)))
(should (numberp (tramp-compat-file-attribute-link-number attr)))
(should (numberp (tramp-compat-file-attribute-user-id attr)))
(should (numberp (tramp-compat-file-attribute-group-id attr)))
(should
(stringp
(current-time-string
(tramp-compat-file-attribute-access-time attr))))
(should
(stringp
(current-time-string
(tramp-compat-file-attribute-modification-time attr))))
(should
(stringp
(current-time-string
(tramp-compat-file-attribute-status-change-time attr))))
(should (numberp (tramp-compat-file-attribute-size attr)))
(should (stringp (tramp-compat-file-attribute-modes attr)))
(setq attr (file-attributes tmp-name1 'string))
(should (stringp (nth 2 attr))) ;; Uid.
(should (stringp (nth 3 attr))) ;; Gid.
(should (stringp (tramp-compat-file-attribute-user-id attr)))
(should (stringp (tramp-compat-file-attribute-group-id attr)))
(tramp--test-ignore-make-symbolic-link-error
(should-error
......@@ -3041,7 +3047,7 @@ This tests also `access-file', `file-readable-p',
(string-equal
(funcall
(if quoted #'tramp-compat-file-name-quote #'identity)
(car attr))
(tramp-compat-file-attribute-type attr))
(file-remote-p (file-truename tmp-name1) 'localname)))
(delete-file tmp-name2))
......@@ -3060,7 +3066,7 @@ This tests also `access-file', `file-readable-p',
(setq attr (file-attributes tmp-name2))
(should
(string-equal
(car attr)
(tramp-compat-file-attribute-type attr)
(tramp-file-name-localname
(tramp-dissect-file-name tmp-name3))))
(delete-file tmp-name2))
......@@ -3076,24 +3082,22 @@ This tests also `access-file', `file-readable-p',
(when (tramp--test-sh-p)
(should (file-ownership-preserved-p tmp-name1 'group)))
(setq attr (file-attributes tmp-name1))
(should (eq (car attr) t)))
(should (eq (tramp-compat-file-attribute-type attr) t)))
;; Cleanup.
(ignore-errors (delete-directory tmp-name1))
(ignore-errors (delete-file tmp-name1))
(ignore-errors (delete-file tmp-name2))))))
(defvar tramp--test-start-time nil
"Keep the start time of the current test, a float number.")
(defsubst tramp--test-file-attributes-equal-p (attr1 attr2)
"Check, whether file attributes ATTR1 and ATTR2 are equal.
They might differ only in time attributes or directory size."
(let ((attr1 (copy-sequence attr1))
(attr2 (copy-sequence attr2))
(start-time
(- (float-time
(aref
(ert--stats-test-start-times ert--current-run-stats)
(ert--stats-test-pos ert--current-run-stats (ert-running-test))))
60)))
(start-time (- tramp--test-start-time 10)))
;; Access time.
(setcar (nthcdr 4 attr1) tramp-time-dont-know)
(setcar (nthcdr 4 attr2) tramp-time-dont-know)
......@@ -3101,30 +3105,47 @@ They might differ only in time attributes or directory size."
;; we cannot compare, and we normalize the time stamps. If the
;; time value is newer than the test start time, normalize it,
;; because due to caching the time stamps could differ slightly (a
;; few seconds). We use a test start time minus 60 seconds, in
;; order to compensate a possible time offset on local and remote
;; machines.
(when (or (tramp-compat-time-equal-p (nth 5 attr1) tramp-time-dont-know)
(tramp-compat-time-equal-p (nth 5 attr2) tramp-time-dont-know))
;; few seconds). We use a test start time minus 10 seconds, in
;; order to compensate a possible timestamp resolution higher than
;; a second on the remote machine.
(when (or (tramp-compat-time-equal-p
(tramp-compat-file-attribute-modification-time attr1)
tramp-time-dont-know)
(tramp-compat-time-equal-p
(tramp-compat-file-attribute-modification-time attr2)
tramp-time-dont-know))
(setcar (nthcdr 5 attr1) tramp-time-dont-know)
(setcar (nthcdr 5 attr2) tramp-time-dont-know))
(when (< start-time (float-time (nth 5 attr1)))
(when (< start-time
(float-time (tramp-compat-file-attribute-modification-time attr1)))
(setcar (nthcdr 5 attr1) tramp-time-dont-know))
(when (< start-time (float-time (nth 5 attr2)))
(when (< start-time
(float-time (tramp-compat-file-attribute-modification-time attr2)))
(setcar (nthcdr 5 attr2) tramp-time-dont-know))
;; Status change time. Dito.
(when (or (tramp-compat-time-equal-p (nth 6 attr1) tramp-time-dont-know)
(tramp-compat-time-equal-p (nth 6 attr2) tramp-time-dont-know))
(when (or (tramp-compat-time-equal-p
(tramp-compat-file-attribute-status-change-time attr1)
tramp-time-dont-know)
(tramp-compat-time-equal-p
(tramp-compat-file-attribute-status-change-time attr2)
tramp-time-dont-know))
(setcar (nthcdr 6 attr1) tramp-time-dont-know)
(setcar (nthcdr 6 attr2) tramp-time-dont-know))
(when (< start-time (float-time (nth 6 attr1)))
(when
(< start-time
(float-time
(tramp-compat-file-attribute-status-change-time attr1)))
(setcar (nthcdr 6 attr1) tramp-time-dont-know))
(when (< start-time (float-time (nth 6 attr2)))
(when
(< start-time
(float-time (tramp-compat-file-attribute-status-change-time attr2)))
(setcar (nthcdr 6 attr2) tramp-time-dont-know))
;; Size. Set it to 0 for directories, because it might have
;; changed. For example the upper directory "../".
(when (eq (car attr1) t) (setcar (nthcdr 7 attr1) 0))
(when (eq (car attr2) t) (setcar (nthcdr 7 attr2) 0))
(when (eq (tramp-compat-file-attribute-type attr1) t)
(setcar (nthcdr 7 attr1) 0))
(when (eq (tramp-compat-file-attribute-type attr2) t)
(setcar (nthcdr 7 attr2) 0))
;; The check.
(unless (equal attr1 attr2) (tramp--test-message "%S\n%S" attr1 attr2))
(equal attr1 attr2)))
......@@ -3147,6 +3168,10 @@ They might differ only in time attributes or directory size."
(progn
(make-directory tmp-name1)
(should (file-directory-p tmp-name1))
(setq tramp--test-start-time
(float-time
(tramp-compat-file-attribute-modification-time
(file-attributes tmp-name1))))
(make-directory tmp-name2)
(should (file-directory-p tmp-name2))
(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'."
(should (= (file-modes tmp-name) #o444))
(should-not (file-executable-p tmp-name))
;; A file is always writable for user "root".
(unless (zerop (nth 2 (file-attributes tmp-name)))
(unless (zerop (tramp-compat-file-attribute-user-id
(file-attributes tmp-name)))
(should-not (file-writable-p tmp-name))))
;; Cleanup.
......@@ -3495,16 +3521,21 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(progn
(write-region "foo" nil tmp-name1)
(should (file-exists-p tmp-name1))
(should (consp (nth 5 (file-attributes tmp-name1))))
(should (consp (tramp-compat-file-attribute-modification-time
(file-attributes tmp-name1))))
;; Skip the test, if the remote handler is not able to set
;; the correct time.
(skip-unless (set-file-times tmp-name1 (seconds-to-time 1)))
;; Dumb remote shells without perl(1) or stat(1) are not
;; able to return the date correctly. They say "don't know".
(unless (tramp-compat-time-equal-p
(nth 5 (file-attributes tmp-name1)) tramp-time-dont-know)
(tramp-compat-file-attribute-modification-time
(file-attributes tmp-name1))
tramp-time-dont-know)
(should
(equal (nth 5 (file-attributes tmp-name1)) (seconds-to-time 1)))
(equal (tramp-compat-file-attribute-modification-time
(file-attributes tmp-name1))
(seconds-to-time 1)))
(write-region "bla" nil tmp-name2)
(should (file-exists-p tmp-name2))
(should (file-newer-than-file-p tmp-name2 tmp-name1))
......@@ -5150,7 +5181,7 @@ This requires restrictions of file name syntax."
(string-equal
(funcall
(if quoted #'tramp-compat-file-name-quote #'identity)
(car (file-attributes file3)))
(tramp-compat-file-attribute-type (file-attributes file3)))
(file-remote-p (file-truename file1) 'localname)))
;; Check file contents.
(with-temp-buffer
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment