From 62504a9f5de3adb0569e69af116a2852e08d7d6f Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Mon, 3 Jul 2017 13:21:39 +0200 Subject: [PATCH] Fix tramp-tests.el for hydra * test/Makefile.in: Remove instrumentation for tramp-tests. * test/lisp/net/tramp-tests.el (tramp-test36-asynchronous-requests): Remove instrumentation. Wrap with a timeout. Give hydra another timer value. Set `default-directory' in timer. --- test/Makefile.in | 3 +- test/lisp/net/tramp-tests.el | 232 +++++++++++++++++------------------ 2 files changed, 112 insertions(+), 123 deletions(-) diff --git a/test/Makefile.in b/test/Makefile.in index 11373db8ca9..414eca90564 100644 --- a/test/Makefile.in +++ b/test/Makefile.in @@ -147,8 +147,7 @@ endif %.log: %.elc $(AM_V_at)${MKDIR_P} $(dir $@) $(AM_V_GEN)HOME=/nonexistent $(emacs) -l ert -l $(testloadfile) \ - --eval "(ert-run-tests-batch-and-exit ${SELECTOR_ACTUAL})" \ - $(if $(and ${NIX_STORE}, $(findstring tramp, $(testloadfile))), , ${WRITE_LOG}) + --eval "(ert-run-tests-batch-and-exit ${SELECTOR_ACTUAL})" ${WRITE_LOG} ifeq (@HAVE_MODULES@, yes) maybe_exclude_module_tests := diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 03730ef7a84..31cf7f9ba1c 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -3689,130 +3689,120 @@ process sentinels. They shall not disturb each other." (skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-sh-p)) - ;; This test times out on hydra. + ;; This test could be blocked on hydra. (with-timeout (300 (ert-fail "`tramp-test36-asynchronous-requests' timed out")) - (let* ((tmp-name (tramp--test-make-temp-name)) - (default-directory tmp-name) - ;; Do not cache Tramp properties. - (remote-file-name-inhibit-cache t) - (process-file-side-effects t) - ;; Suppress nasty messages. - (inhibit-message t) - (number-proc 10) - ;; On hydra, timings are bad. - (timer-repeat - (cond - ((getenv "NIX_STORE") 10) - (t 1))) - ;; We must distinguish due to performance reasons. - (timer-operation - (cond - ((string-equal "mock" (file-remote-p tmp-name 'method)) - 'vc-registered) - (t 'file-attributes))) - timer buffers kill-buffer-query-functions) + (let* ((tmp-name (tramp--test-make-temp-name)) + (default-directory tmp-name) + ;; Do not cache Tramp properties. + (remote-file-name-inhibit-cache t) + (process-file-side-effects t) + ;; Suppress nasty messages. + (inhibit-message t) + (number-proc 10) + ;; On hydra, timings are bad. + (timer-repeat + (cond + ((getenv "NIX_STORE") 10) + (t 1))) + ;; We must distinguish due to performance reasons. + (timer-operation + (cond + ((string-equal "mock" (file-remote-p tmp-name 'method)) + 'vc-registered) + (t 'file-attributes))) + timer buffers kill-buffer-query-functions) - (unwind-protect - (progn - (make-directory tmp-name) - - ;; Setup a timer in order to raise an ordinary command again - ;; and again. `vc-registered' is well suited, because there - ;; are many checks. - (setq - timer - (run-at-time - 0 timer-repeat - (lambda () - (when buffers - (let ((default-directory tmp-name) - (file - (buffer-name (nth (random (length buffers)) buffers)))) - (tramp--test-message - "Start timer %s %s %s" - timer-operation file (current-time-string)) - (funcall timer-operation file) - (tramp--test-message - "Stop timer %s %s %s" - timer-operation file (current-time-string))))))) - - ;; Create temporary buffers. The number of buffers - ;; corresponds to the number of processes; it could be - ;; increased in order to make pressure on Tramp. - (dotimes (_i number-proc) - (add-to-list 'buffers (generate-new-buffer "foo"))) - - ;; Open asynchronous processes. Set process sentinel. - (dolist (buf buffers) - (tramp--test-message "Start process %s" buf) - (let ((proc - (start-file-process-shell-command - (buffer-name buf) buf - (concat - "(read line && echo $line >$line);" - "(read line && cat $line);" - "(read line && rm $line)"))) - (file (expand-file-name (buffer-name buf)))) - ;; Remember the file name. Add counter. - (process-put proc 'foo file) - (process-put proc 'bar 0) - ;; Add process filter. - (set-process-filter - proc - (lambda (proc string) - (tramp--test-message "Process filter %s" proc) - (with-current-buffer (process-buffer proc) - (insert string)) - (unless (zerop (length string)) - (should (file-attributes (process-get proc 'foo)))))) - ;; Add process sentinel. - (set-process-sentinel - proc - (lambda (proc _state) - (tramp--test-message "Process sentinel %s" proc) - (should-not (file-attributes (process-get proc 'foo))))))) - - ;; Send a string. Use a random order of the buffers. Mix - ;; with regular operation. - (let ((buffers (copy-sequence buffers))) - (while buffers - (let* ((buf (nth (random (length buffers)) buffers)) - (proc (get-buffer-process buf)) - (file (process-get proc 'foo)) - (count (process-get proc 'bar))) - ;; Regular operation. - (if (= count 0) - (should-not (file-attributes file)) - (should (file-attributes file))) - ;; Send string to process. - (tramp--test-message "Send string %s" proc) - (process-send-string proc (format "%s\n" (buffer-name buf))) - (accept-process-output proc 0.1 nil 0) - ;; Regular operation. - (if (= count 2) - (should-not (file-attributes file)) - (should (file-attributes file))) - (process-put proc 'bar (1+ count)) - (unless (process-live-p proc) - (tramp--test-message "Buffer delete %s" buf) - (setq buffers (delq buf buffers)))))) - - ;; Checks. All process output shall exists in the - ;; respective buffers. All created files shall be deleted. - (tramp--test-message "Checks %s" buffers) - (dolist (buf buffers) - (with-current-buffer buf - (should (string-equal (format "%s\n" buf) (buffer-string))))) - (should-not - (directory-files tmp-name nil directory-files-no-dot-files-regexp))) - - ;; Cleanup. - (dolist (buf buffers) - (ignore-errors (delete-process (get-buffer-process buf))) - (ignore-errors (kill-buffer buf))) - (ignore-errors (cancel-timer timer)) - (ignore-errors (delete-directory tmp-name 'recursive)))))) + (unwind-protect + (progn + (make-directory tmp-name) + + ;; Setup a timer in order to raise an ordinary command + ;; again and again. `vc-registered' is well suited, + ;; because there are many checks. + (setq + timer + (run-at-time + 0 timer-repeat + (lambda () + (when buffers + (let ((default-directory tmp-name) + (file + (buffer-name (nth (random (length buffers)) buffers)))) + (funcall timer-operation file)))))) + + ;; Create temporary buffers. The number of buffers + ;; corresponds to the number of processes; it could be + ;; increased in order to make pressure on Tramp. + (dotimes (_i number-proc) + (add-to-list 'buffers (generate-new-buffer "foo"))) + + ;; Open asynchronous processes. Set process filter and sentinel. + (dolist (buf buffers) + (let ((proc + (start-file-process-shell-command + (buffer-name buf) buf + (concat + "(read line && echo $line >$line);" + "(read line && cat $line);" + "(read line && rm $line)"))) + (file (expand-file-name (buffer-name buf)))) + ;; Remember the file name. Add counter. + (process-put proc 'foo file) + (process-put proc 'bar 0) + ;; Add process filter. + (set-process-filter + proc + (lambda (proc string) + (with-current-buffer (process-buffer proc) + (insert string)) + (unless (zerop (length string)) + (should (file-attributes (process-get proc 'foo)))))) + ;; Add process sentinel. + (set-process-sentinel + proc + (lambda (proc _state) + (should-not (file-attributes (process-get proc 'foo))))))) + + ;; Send a string. Use a random order of the buffers. Mix + ;; with regular operation. + (let ((buffers (copy-sequence buffers))) + (while buffers + (let* ((buf (nth (random (length buffers)) buffers)) + (proc (get-buffer-process buf)) + (file (process-get proc 'foo)) + (count (process-get proc 'bar))) + ;; Regular operation. + (if (= count 0) + (should-not (file-attributes file)) + (should (file-attributes file))) + ;; Send string to process. + (process-send-string proc (format "%s\n" (buffer-name buf))) + (accept-process-output proc 0.1 nil 0) + ;; Regular operation. + (if (= count 2) + (should-not (file-attributes file)) + (should (file-attributes file))) + (process-put proc 'bar (1+ count)) + (unless (process-live-p proc) + (setq buffers (delq buf buffers)))))) + + ;; Checks. All process output shall exists in the + ;; respective buffers. All created files shall be + ;; deleted. + (dolist (buf buffers) + (with-current-buffer buf + (should (string-equal (format "%s\n" buf) (buffer-string))))) + (should-not + (directory-files + tmp-name nil directory-files-no-dot-files-regexp))) + + ;; Cleanup. + (dolist (buf buffers) + (ignore-errors (delete-process (get-buffer-process buf))) + (ignore-errors (kill-buffer buf))) + (ignore-errors (cancel-timer timer)) + (ignore-errors (delete-directory tmp-name 'recursive)))))) (ert-deftest tramp-test37-recursive-load () "Check that Tramp does not fail due to recursive load." -- 2.39.2