diff options
| author | Michael Albinus | 2019-08-07 14:59:19 +0200 |
|---|---|---|
| committer | Michael Albinus | 2019-08-07 14:59:19 +0200 |
| commit | 2b6932b44070ad18e1622fbbb9496f2e05e3e809 (patch) | |
| tree | fae23a614af6302880a3cc0321d6df0f7d87ee2f | |
| parent | 25baa7d20ccc4b76c5a886a1e32b66f6c1a23485 (diff) | |
| download | emacs-2b6932b44070ad18e1622fbbb9496f2e05e3e809.tar.gz emacs-2b6932b44070ad18e1622fbbb9496f2e05e3e809.zip | |
; Instrument tramp--test-file-attributes-equal-p
| -rw-r--r-- | test/lisp/net/tramp-tests.el | 56 |
1 files changed, 18 insertions, 38 deletions
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index bcc74cc3a2c..c11997a5c09 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el | |||
| @@ -3085,44 +3085,24 @@ This tests also `access-file', `file-readable-p', | |||
| 3085 | 3085 | ||
| 3086 | (defsubst tramp--test-file-attributes-equal-p (attr1 attr2) | 3086 | (defsubst tramp--test-file-attributes-equal-p (attr1 attr2) |
| 3087 | "Check, whether file attributes ATTR1 and ATTR2 are equal. | 3087 | "Check, whether file attributes ATTR1 and ATTR2 are equal. |
| 3088 | They might differ only in time attributes or directory size." | 3088 | They might differ only in time attributes." |
| 3089 | (let ((attr1 (copy-sequence attr1)) | 3089 | ;; Access time. |
| 3090 | (attr2 (copy-sequence attr2)) | 3090 | (setcar (nthcdr 4 attr1) tramp-time-dont-know) |
| 3091 | (start-time | 3091 | (setcar (nthcdr 4 attr2) tramp-time-dont-know) |
| 3092 | (aref | 3092 | ;; Modification time. |
| 3093 | (ert--stats-test-start-times ert--current-run-stats) | 3093 | (when (or (tramp-compat-time-equal-p (nth 5 attr1) tramp-time-dont-know) |
| 3094 | (ert--stats-test-pos ert--current-run-stats (ert-running-test))))) | 3094 | (tramp-compat-time-equal-p (nth 5 attr2) tramp-time-dont-know) |
| 3095 | ;; Access time. | 3095 | (< (abs (tramp-time-diff (nth 5 attr1) (nth 5 attr2))) 5)) |
| 3096 | (setcar (nthcdr 4 attr1) tramp-time-dont-know) | 3096 | (setcar (nthcdr 5 attr1) tramp-time-dont-know) |
| 3097 | (setcar (nthcdr 4 attr2) tramp-time-dont-know) | 3097 | (setcar (nthcdr 5 attr2) tramp-time-dont-know)) |
| 3098 | ;; Modification time. If any of the time values is "don't know", | 3098 | ;; Status change time. |
| 3099 | ;; we cannot compare, and we normalize the time stamps. If the | 3099 | (when (or (tramp-compat-time-equal-p (nth 6 attr1) tramp-time-dont-know) |
| 3100 | ;; time value is newer than the test start time, normalize it, | 3100 | (tramp-compat-time-equal-p (nth 6 attr2) tramp-time-dont-know) |
| 3101 | ;; because due to caching the time stamps could differ slightly (a | 3101 | (< (abs (tramp-time-diff (nth 6 attr1) (nth 6 attr2))) 5)) |
| 3102 | ;; few seconds). | 3102 | (setcar (nthcdr 6 attr1) tramp-time-dont-know) |
| 3103 | (when (or (tramp-compat-time-equal-p (nth 5 attr1) tramp-time-dont-know) | 3103 | (setcar (nthcdr 6 attr2) tramp-time-dont-know)) |
| 3104 | (tramp-compat-time-equal-p (nth 5 attr2) tramp-time-dont-know)) | 3104 | (unless (equal attr1 attr2) (tramp--test-message "%S\n%S" attr1 attr2)) |
| 3105 | (setcar (nthcdr 5 attr1) tramp-time-dont-know) | 3105 | (equal attr1 attr2)) |
| 3106 | (setcar (nthcdr 5 attr2) tramp-time-dont-know)) | ||
| 3107 | (when (time-less-p start-time (nth 5 attr1)) | ||
| 3108 | (setcar (nthcdr 5 attr1) tramp-time-dont-know)) | ||
| 3109 | (when (time-less-p start-time (nth 5 attr2)) | ||
| 3110 | (setcar (nthcdr 5 attr2) tramp-time-dont-know)) | ||
| 3111 | ;; Status change time. Dito. | ||
| 3112 | (when (or (tramp-compat-time-equal-p (nth 6 attr1) tramp-time-dont-know) | ||
| 3113 | (tramp-compat-time-equal-p (nth 6 attr2) tramp-time-dont-know)) | ||
| 3114 | (setcar (nthcdr 6 attr1) tramp-time-dont-know) | ||
| 3115 | (setcar (nthcdr 6 attr2) tramp-time-dont-know)) | ||
| 3116 | (when (time-less-p start-time (nth 6 attr1)) | ||
| 3117 | (setcar (nthcdr 6 attr1) tramp-time-dont-know)) | ||
| 3118 | (when (time-less-p start-time (nth 6 attr2)) | ||
| 3119 | (setcar (nthcdr 6 attr2) tramp-time-dont-know)) | ||
| 3120 | ;; Size. Set it to 0 for directories, because it might have | ||
| 3121 | ;; changed. For example the upper directory "../". | ||
| 3122 | (when (eq (car attr1) t) (setcar (nthcdr 7 attr1) 0)) | ||
| 3123 | (when (eq (car attr2) t) (setcar (nthcdr 7 attr2) 0)) | ||
| 3124 | ;; The check. | ||
| 3125 | (equal attr1 attr2))) | ||
| 3126 | 3106 | ||
| 3127 | ;; This isn't 100% correct, but better than no explainer at all. | 3107 | ;; This isn't 100% correct, but better than no explainer at all. |
| 3128 | (put #'tramp--test-file-attributes-equal-p 'ert-explainer #'ert--explain-equal) | 3108 | (put #'tramp--test-file-attributes-equal-p 'ert-explainer #'ert--explain-equal) |