Commit 2b6932b4 authored by Michael Albinus's avatar Michael Albinus
Browse files

; Instrument tramp--test-file-attributes-equal-p

parent 25baa7d2
Pipeline #2783 failed with stage
in 53 minutes and 35 seconds
...@@ -3085,44 +3085,24 @@ This tests also `access-file', `file-readable-p', ...@@ -3085,44 +3085,24 @@ This tests also `access-file', `file-readable-p',
(defsubst tramp--test-file-attributes-equal-p (attr1 attr2) (defsubst tramp--test-file-attributes-equal-p (attr1 attr2)
"Check, whether file attributes ATTR1 and ATTR2 are equal. "Check, whether file attributes ATTR1 and ATTR2 are equal.
They might differ only in time attributes or directory size." They might differ only in time attributes."
(let ((attr1 (copy-sequence attr1))
(attr2 (copy-sequence attr2))
(start-time
(aref
(ert--stats-test-start-times ert--current-run-stats)
(ert--stats-test-pos ert--current-run-stats (ert-running-test)))))
;; Access time. ;; Access time.
(setcar (nthcdr 4 attr1) tramp-time-dont-know) (setcar (nthcdr 4 attr1) tramp-time-dont-know)
(setcar (nthcdr 4 attr2) tramp-time-dont-know) (setcar (nthcdr 4 attr2) tramp-time-dont-know)
;; Modification time. If any of the time values is "don't know", ;; Modification time.
;; 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).
(when (or (tramp-compat-time-equal-p (nth 5 attr1) tramp-time-dont-know) (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)) (tramp-compat-time-equal-p (nth 5 attr2) tramp-time-dont-know)
(< (abs (tramp-time-diff (nth 5 attr1) (nth 5 attr2))) 5))
(setcar (nthcdr 5 attr1) tramp-time-dont-know) (setcar (nthcdr 5 attr1) tramp-time-dont-know)
(setcar (nthcdr 5 attr2) tramp-time-dont-know)) (setcar (nthcdr 5 attr2) tramp-time-dont-know))
(when (time-less-p start-time (nth 5 attr1)) ;; Status change time.
(setcar (nthcdr 5 attr1) tramp-time-dont-know))
(when (time-less-p start-time (nth 5 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) (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)) (tramp-compat-time-equal-p (nth 6 attr2) tramp-time-dont-know)
(< (abs (tramp-time-diff (nth 6 attr1) (nth 6 attr2))) 5))
(setcar (nthcdr 6 attr1) tramp-time-dont-know) (setcar (nthcdr 6 attr1) tramp-time-dont-know)
(setcar (nthcdr 6 attr2) tramp-time-dont-know)) (setcar (nthcdr 6 attr2) tramp-time-dont-know))
(when (time-less-p start-time (nth 6 attr1)) (unless (equal attr1 attr2) (tramp--test-message "%S\n%S" attr1 attr2))
(setcar (nthcdr 6 attr1) tramp-time-dont-know)) (equal attr1 attr2))
(when (time-less-p start-time (nth 6 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))
;; The check.
(equal attr1 attr2)))
;; This isn't 100% correct, but better than no explainer at all. ;; This isn't 100% correct, but better than no explainer at all.
(put #'tramp--test-file-attributes-equal-p 'ert-explainer #'ert--explain-equal) (put #'tramp--test-file-attributes-equal-p 'ert-explainer #'ert--explain-equal)
......
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