diff options
| author | Michael Albinus | 2014-04-20 23:39:43 +0200 |
|---|---|---|
| committer | Michael Albinus | 2014-04-20 23:39:43 +0200 |
| commit | f3a4812cf2fe0facbda57bee0810cf23f1c96fa2 (patch) | |
| tree | cec4902ea38ce3b76ff9d18790cf48953412a8d2 /test | |
| parent | feb5d8a4d340ef247ec581141388f6ba6cfb0d73 (diff) | |
| download | emacs-f3a4812cf2fe0facbda57bee0810cf23f1c96fa2.tar.gz emacs-f3a4812cf2fe0facbda57bee0810cf23f1c96fa2.zip | |
* automated/tramp-tests.el (tramp-test19-directory-files-and-attributes)
(tramp-test22-file-times): Check for `file-attributes' equality
only if there is a usable timestamp.
(tramp--test-check-files): Do not use `copy-sequence'.
Diffstat (limited to 'test')
| -rw-r--r-- | test/ChangeLog | 8 | ||||
| -rw-r--r-- | test/automated/tramp-tests.el | 40 |
2 files changed, 32 insertions, 16 deletions
diff --git a/test/ChangeLog b/test/ChangeLog index d677d13db44..0a9872ba1db 100644 --- a/test/ChangeLog +++ b/test/ChangeLog | |||
| @@ -1,3 +1,11 @@ | |||
| 1 | 2014-04-20 Michael Albinus <michael.albinus@gmx.de> | ||
| 2 | |||
| 3 | * automated/tramp-tests.el | ||
| 4 | (tramp-test19-directory-files-and-attributes) | ||
| 5 | (tramp-test22-file-times): Check for `file-attributes' equality | ||
| 6 | only if there is a usable timestamp. | ||
| 7 | (tramp--test-check-files): Do not use `copy-sequence'. | ||
| 8 | |||
| 1 | 2014-04-19 Michael Albinus <michael.albinus@gmx.de> | 9 | 2014-04-19 Michael Albinus <michael.albinus@gmx.de> |
| 2 | 10 | ||
| 3 | * automated/tramp-tests.el (tramp--test-check-files): Extend test. | 11 | * automated/tramp-tests.el (tramp--test-check-files): Extend test. |
diff --git a/test/automated/tramp-tests.el b/test/automated/tramp-tests.el index 2572f9c82e4..f5ba59a02b6 100644 --- a/test/automated/tramp-tests.el +++ b/test/automated/tramp-tests.el | |||
| @@ -1012,14 +1012,22 @@ This tests also `file-readable-p' and `file-regular-p'." | |||
| 1012 | (write-region "boz" nil (expand-file-name "boz" tmp-name2)) | 1012 | (write-region "boz" nil (expand-file-name "boz" tmp-name2)) |
| 1013 | (setq attr (directory-files-and-attributes tmp-name2)) | 1013 | (setq attr (directory-files-and-attributes tmp-name2)) |
| 1014 | (should (consp attr)) | 1014 | (should (consp attr)) |
| 1015 | ;; Dumb remote shells without perl(1) or stat(1) are not | ||
| 1016 | ;; able to return the date correctly. They say "don't know". | ||
| 1015 | (dolist (elt attr) | 1017 | (dolist (elt attr) |
| 1016 | (should | 1018 | (unless |
| 1017 | (equal (file-attributes (expand-file-name (car elt) tmp-name2)) | 1019 | (equal |
| 1018 | (cdr elt)))) | 1020 | (nth 5 |
| 1021 | (file-attributes (expand-file-name (car elt) tmp-name2))) | ||
| 1022 | '(0 0)) | ||
| 1023 | (should | ||
| 1024 | (equal (file-attributes (expand-file-name (car elt) tmp-name2)) | ||
| 1025 | (cdr elt))))) | ||
| 1019 | (setq attr (directory-files-and-attributes tmp-name2 'full)) | 1026 | (setq attr (directory-files-and-attributes tmp-name2 'full)) |
| 1020 | (dolist (elt attr) | 1027 | (dolist (elt attr) |
| 1021 | (should | 1028 | (unless (equal (nth 5 (file-attributes (car elt))) '(0 0)) |
| 1022 | (equal (file-attributes (car elt)) (cdr elt)))) | 1029 | (should |
| 1030 | (equal (file-attributes (car elt)) (cdr elt))))) | ||
| 1023 | (setq attr (directory-files-and-attributes tmp-name2 nil "^b")) | 1031 | (setq attr (directory-files-and-attributes tmp-name2 nil "^b")) |
| 1024 | (should (equal (mapcar 'car attr) '("bar" "boz")))) | 1032 | (should (equal (mapcar 'car attr) '("bar" "boz")))) |
| 1025 | (ignore-errors (delete-directory tmp-name1 'recursive))))) | 1033 | (ignore-errors (delete-directory tmp-name1 'recursive))))) |
| @@ -1142,16 +1150,16 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." | |||
| 1142 | ;; We skip the test, if the remote handler is not able to | 1150 | ;; We skip the test, if the remote handler is not able to |
| 1143 | ;; set the correct time. | 1151 | ;; set the correct time. |
| 1144 | (skip-unless (set-file-times tmp-name1 '(0 1))) | 1152 | (skip-unless (set-file-times tmp-name1 '(0 1))) |
| 1145 | ;; Dumb busyboxes are not able to return the date correctly. | 1153 | ;; Dumb remote shells without perl(1) or stat(1) are not |
| 1146 | ;; They say "don't know. | 1154 | ;; able to return the date correctly. They say "don't know". |
| 1147 | (skip-unless (not (equal (nth 5 (file-attributes tmp-name1)) '(0 0)))) | 1155 | (unless (equal (nth 5 (file-attributes tmp-name1)) '(0 0)) |
| 1148 | (should (equal (nth 5 (file-attributes tmp-name1)) '(0 1))) | 1156 | (should (equal (nth 5 (file-attributes tmp-name1)) '(0 1))) |
| 1149 | (write-region "bla" nil tmp-name2) | 1157 | (write-region "bla" nil tmp-name2) |
| 1150 | (should (file-exists-p tmp-name2)) | 1158 | (should (file-exists-p tmp-name2)) |
| 1151 | (should (file-newer-than-file-p tmp-name2 tmp-name1)) | 1159 | (should (file-newer-than-file-p tmp-name2 tmp-name1)) |
| 1152 | ;; `tmp-name3' does not exist. | 1160 | ;; `tmp-name3' does not exist. |
| 1153 | (should (file-newer-than-file-p tmp-name2 tmp-name3)) | 1161 | (should (file-newer-than-file-p tmp-name2 tmp-name3)) |
| 1154 | (should-not (file-newer-than-file-p tmp-name3 tmp-name1))) | 1162 | (should-not (file-newer-than-file-p tmp-name3 tmp-name1)))) |
| 1155 | (ignore-errors | 1163 | (ignore-errors |
| 1156 | (delete-file tmp-name1) | 1164 | (delete-file tmp-name1) |
| 1157 | (delete-file tmp-name2))))) | 1165 | (delete-file tmp-name2))))) |
| @@ -1447,7 +1455,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." | |||
| 1447 | (sort (copy-sequence files) 'string-lessp))) | 1455 | (sort (copy-sequence files) 'string-lessp))) |
| 1448 | (should (equal (directory-files | 1456 | (should (equal (directory-files |
| 1449 | tmp-name2 nil directory-files-no-dot-files-regexp) | 1457 | tmp-name2 nil directory-files-no-dot-files-regexp) |
| 1450 | (sort (copy-sequence files) 'string-lessp)))) | 1458 | (sort files 'string-lessp)))) |
| 1451 | (ignore-errors (delete-directory tmp-name1 'recursive)) | 1459 | (ignore-errors (delete-directory tmp-name1 'recursive)) |
| 1452 | (ignore-errors (delete-directory tmp-name2 'recursive)))))) | 1460 | (ignore-errors (delete-directory tmp-name2 'recursive)))))) |
| 1453 | 1461 | ||