1 ;;; process-tests.el --- Testing the process facilities
3 ;; Copyright (C) 2013-2016 Free Software Foundation, Inc.
5 ;; This program is free software; you can redistribute it and/or modify
6 ;; it under the terms of the GNU General Public License as published by
7 ;; the Free Software Foundation, either version 3 of the License, or
8 ;; (at your option) any later version.
10 ;; This program is distributed in the hope that it will be useful,
11 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
12 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 ;; GNU General Public License for more details.
15 ;; You should have received a copy of the GNU General Public License
16 ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
26 ;; Timeout in seconds; the test fails if the timeout is reached.
27 (defvar process-test-sentinel-wait-timeout
2.0)
29 ;; Start a process that exits immediately. Call WAIT-FUNCTION,
30 ;; possibly multiple times, to wait for the process to complete.
31 (defun process-test-sentinel-wait-function-working-p (wait-function)
32 (let ((proc (start-process "test" nil
"bash" "-c" "exit 20"))
34 (start-time (float-time)))
35 (set-process-sentinel proc
(lambda (proc msg
)
36 (setq sentinel-called t
)))
37 (while (not (or sentinel-called
38 (> (- (float-time) start-time
)
39 process-test-sentinel-wait-timeout
)))
40 (funcall wait-function
))
41 (cl-assert (eq (process-status proc
) 'exit
))
42 (cl-assert (= (process-exit-status proc
) 20))
45 (ert-deftest process-test-sentinel-accept-process-output
()
46 (skip-unless (executable-find "bash"))
47 (should (process-test-sentinel-wait-function-working-p
48 #'accept-process-output
)))
50 (ert-deftest process-test-sentinel-sit-for
()
51 (skip-unless (executable-find "bash"))
53 (process-test-sentinel-wait-function-working-p (lambda () (sit-for 0.01 t
)))))
55 (when (eq system-type
'windows-nt
)
56 (ert-deftest process-test-quoted-batfile
()
57 "Check that Emacs hides CreateProcess deficiency (bug#18745)."
61 ;; CreateProcess will fail when both the bat file and 1st
62 ;; argument are quoted, so include spaces in both of those
64 (setq batfile
(make-temp-file "echo args" nil
".bat"))
65 (with-temp-file batfile
66 (insert "@echo arg1=%1, arg2=%2\n"))
68 (call-process batfile nil
'(t t
) t
"x &y")
69 (should (string= (buffer-string) "arg1=\"x &y\", arg2=\n")))
71 (call-process-shell-command
72 (mapconcat #'shell-quote-argument
(list batfile
"x &y") " ")
74 (should (string= (buffer-string) "arg1=\"x &y\", arg2=\n"))))
75 (when batfile
(delete-file batfile
))))))
77 (ert-deftest process-test-stderr-buffer
()
78 (skip-unless (executable-find "bash"))
79 (let* ((stdout-buffer (generate-new-buffer "*stdout*"))
80 (stderr-buffer (generate-new-buffer "*stderr*"))
81 (proc (make-process :name
"test"
82 :command
(list "bash" "-c"
83 (concat "echo hello stdout!; "
84 "echo hello stderr! >&2; "
87 :stderr stderr-buffer
))
89 (start-time (float-time)))
90 (set-process-sentinel proc
(lambda (proc msg
)
91 (setq sentinel-called t
)))
92 (while (not (or sentinel-called
93 (> (- (float-time) start-time
)
94 process-test-sentinel-wait-timeout
)))
95 (accept-process-output))
96 (cl-assert (eq (process-status proc
) 'exit
))
97 (cl-assert (= (process-exit-status proc
) 20))
98 (should (with-current-buffer stdout-buffer
99 (goto-char (point-min))
100 (looking-at "hello stdout!")))
101 (should (with-current-buffer stderr-buffer
102 (goto-char (point-min))
103 (looking-at "hello stderr!")))))
105 (ert-deftest process-test-stderr-filter
()
106 (skip-unless (executable-find "bash"))
107 (let* ((sentinel-called nil
)
108 (stderr-sentinel-called nil
)
111 (stdout-buffer (generate-new-buffer "*stdout*"))
112 (stderr-buffer (generate-new-buffer "*stderr*"))
113 (stderr-proc (make-pipe-process :name
"stderr"
114 :buffer stderr-buffer
))
115 (proc (make-process :name
"test" :buffer stdout-buffer
116 :command
(list "bash" "-c"
117 (concat "echo hello stdout!; "
118 "echo hello stderr! >&2; "
120 :stderr stderr-proc
))
121 (start-time (float-time)))
122 (set-process-filter proc
(lambda (proc input
)
123 (push input stdout-output
)))
124 (set-process-sentinel proc
(lambda (proc msg
)
125 (setq sentinel-called t
)))
126 (set-process-filter stderr-proc
(lambda (proc input
)
127 (push input stderr-output
)))
128 (set-process-sentinel stderr-proc
(lambda (proc input
)
129 (setq stderr-sentinel-called t
)))
130 (while (not (or sentinel-called
131 (> (- (float-time) start-time
)
132 process-test-sentinel-wait-timeout
)))
133 (accept-process-output))
134 (cl-assert (eq (process-status proc
) 'exit
))
135 (cl-assert (= (process-exit-status proc
) 20))
136 (should sentinel-called
)
137 (should (equal 1 (with-current-buffer stdout-buffer
139 (should (equal "hello stdout!\n"
140 (mapconcat #'identity
(nreverse stdout-output
) "")))
141 (should stderr-sentinel-called
)
142 (should (equal 1 (with-current-buffer stderr-buffer
144 (should (equal "hello stderr!\n"
145 (mapconcat #'identity
(nreverse stderr-output
) "")))))
147 (ert-deftest start-process-should-not-modify-arguments
()
148 "`start-process' must not modify its arguments in-place."
150 (let* ((path (pcase system-type
151 ((or 'windows-nt
'ms-dos
)
152 ;; Make sure the file name uses forward slashes.
153 ;; The original bug was that 'start-process' would
154 ;; convert forward slashes to backslashes.
155 (expand-file-name (executable-find "attrib.exe")))
157 (samepath (copy-sequence path
)))
158 ;; Make sure 'start-process' actually goes all the way and invokes
160 (should (process-live-p (condition-case nil
161 (start-process "" nil path
)
163 (should (equal path samepath
))))
165 (provide 'process-tests
)
166 ;; process-tests.el ends here.