diff options
| author | Philipp Stephani | 2021-01-23 19:10:22 +0100 |
|---|---|---|
| committer | Philipp Stephani | 2021-01-23 19:10:22 +0100 |
| commit | 8dcb19fc5e3afee7a951194a892f4731bee8ed31 (patch) | |
| tree | e075728994712f1d7d6d80101a504c54f59593a9 /test/src | |
| parent | 17fec603709eb879297a4a0ff0c535c00a13066b (diff) | |
| download | emacs-8dcb19fc5e3afee7a951194a892f4731bee8ed31.tar.gz emacs-8dcb19fc5e3afee7a951194a892f4731bee8ed31.zip | |
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.
Diffstat (limited to 'test/src')
| -rw-r--r-- | test/src/process-tests.el | 29 |
1 files changed, 29 insertions, 0 deletions
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." | |||
| 789 | (should (equal calls | 789 | (should (equal calls |
| 790 | (list (list process "finished\n")))))))))) | 790 | (list (list process "finished\n")))))))))) |
| 791 | 791 | ||
| 792 | (ert-deftest process-tests/multiple-threads-waiting () | ||
| 793 | (skip-unless (fboundp 'make-thread)) | ||
| 794 | (with-timeout (60 (ert-fail "Test timed out")) | ||
| 795 | (process-tests--with-processes processes | ||
| 796 | (let ((threads ()) | ||
| 797 | (cat (executable-find "cat"))) | ||
| 798 | (skip-unless cat) | ||
| 799 | (dotimes (i 10) | ||
| 800 | (let* ((name (format "test %d" i)) | ||
| 801 | (process (make-process :name name | ||
| 802 | :command (list cat) | ||
| 803 | :coding 'no-conversion | ||
| 804 | :noquery t | ||
| 805 | :connection-type 'pipe))) | ||
| 806 | (push process processes) | ||
| 807 | (set-process-thread process nil) | ||
| 808 | (push (make-thread | ||
| 809 | (lambda () | ||
| 810 | (while (accept-process-output process))) | ||
| 811 | name) | ||
| 812 | threads))) | ||
| 813 | (mapc #'process-send-eof processes) | ||
| 814 | (cl-loop for process in processes | ||
| 815 | and thread in threads | ||
| 816 | do | ||
| 817 | (thread-join thread) | ||
| 818 | (should (eq (process-status process) 'exit)) | ||
| 819 | (should (eql (process-exit-status process) 0))))))) | ||
| 820 | |||
| 792 | (defun process-tests--eval (command form) | 821 | (defun process-tests--eval (command form) |
| 793 | "Return a command that evaluates FORM in an Emacs subprocess. | 822 | "Return a command that evaluates FORM in an Emacs subprocess. |
| 794 | COMMAND must be a list returned by | 823 | COMMAND must be a list returned by |