From 8dcb19fc5e3afee7a951194a892f4731bee8ed31 Mon Sep 17 00:00:00 2001 From: Philipp Stephani Date: Sat, 23 Jan 2021 19:10:22 +0100 Subject: [PATCH] Add a unit test testing interaction between threads and processes. This unit test tests that we can call 'accept-process-output' in parallel from multiple threads. * test/src/process-tests.el (process-tests/multiple-threads-waiting): New unit test. --- test/src/process-tests.el | 29 +++++++++++++++++++++++++++++ 1 file changed, 29 insertions(+) diff --git a/test/src/process-tests.el b/test/src/process-tests.el index 949f73595b4..676e1b1ac32 100644 --- a/test/src/process-tests.el +++ b/test/src/process-tests.el @@ -789,6 +789,35 @@ have written output." (should (equal calls (list (list process "finished\n")))))))))) +(ert-deftest process-tests/multiple-threads-waiting () + (skip-unless (fboundp 'make-thread)) + (with-timeout (60 (ert-fail "Test timed out")) + (process-tests--with-processes processes + (let ((threads ()) + (cat (executable-find "cat"))) + (skip-unless cat) + (dotimes (i 10) + (let* ((name (format "test %d" i)) + (process (make-process :name name + :command (list cat) + :coding 'no-conversion + :noquery t + :connection-type 'pipe))) + (push process processes) + (set-process-thread process nil) + (push (make-thread + (lambda () + (while (accept-process-output process))) + name) + threads))) + (mapc #'process-send-eof processes) + (cl-loop for process in processes + and thread in threads + do + (thread-join thread) + (should (eq (process-status process) 'exit)) + (should (eql (process-exit-status process) 0))))))) + (defun process-tests--eval (command form) "Return a command that evaluates FORM in an Emacs subprocess. COMMAND must be a list returned by -- 2.39.2