Port to stricter C99
[emacs.git] / test / automated / process-tests.el
blob1dab615bed0e7e211ad067a7d21eb23306daf8f1
1 ;;; process-tests.el --- Testing the process facilities
3 ;; Copyright (C) 2013-2015 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/>.
18 ;;; Commentary:
22 ;;; Code:
24 (require 'ert)
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"))
33 (sentinel-called nil)
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))
43 sentinel-called))
45 (ert-deftest process-test-sentinel-accept-process-output ()
46 (should (process-test-sentinel-wait-function-working-p
47 #'accept-process-output)))
49 (ert-deftest process-test-sentinel-sit-for ()
50 (should
51 (process-test-sentinel-wait-function-working-p (lambda () (sit-for 0.01 t)))))
53 (when (eq system-type 'windows-nt)
54 (ert-deftest process-test-quoted-batfile ()
55 "Check that Emacs hides CreateProcess deficiency (bug#18745)."
56 (let (batfile)
57 (unwind-protect
58 (progn
59 ;; CreateProcess will fail when both the bat file and 1st
60 ;; argument are quoted, so include spaces in both of those
61 ;; to force quoting.
62 (setq batfile (make-temp-file "echo args" nil ".bat"))
63 (with-temp-file batfile
64 (insert "@echo arg1 = %1, arg2 = %2\n"))
65 (with-temp-buffer
66 (call-process batfile nil '(t t) t "x &y")
67 (should (string= (buffer-string) "arg1 = \"x &y\", arg2 = \n")))
68 (with-temp-buffer
69 (call-process-shell-command
70 (mapconcat #'shell-quote-argument (list batfile "x &y") " ")
71 nil '(t t) t)
72 (should (string= (buffer-string) "arg1 = \"x &y\", arg2 = \n"))))
73 (when batfile (delete-file batfile))))))
75 (ert-deftest process-test-stderr-buffer ()
76 (skip-unless (executable-find "bash"))
77 (let* ((stdout-buffer (generate-new-buffer "*stdout*"))
78 (stderr-buffer (generate-new-buffer "*stderr*"))
79 (proc (make-process :name "test"
80 :command (list "bash" "-c"
81 (concat "echo hello stdout!; "
82 "echo hello stderr! >&2; "
83 "exit 20"))
84 :buffer stdout-buffer
85 :stderr stderr-buffer))
86 (sentinel-called nil)
87 (start-time (float-time)))
88 (set-process-sentinel proc (lambda (proc msg)
89 (setq sentinel-called t)))
90 (while (not (or sentinel-called
91 (> (- (float-time) start-time)
92 process-test-sentinel-wait-timeout)))
93 (accept-process-output))
94 (cl-assert (eq (process-status proc) 'exit))
95 (cl-assert (= (process-exit-status proc) 20))
96 (should (with-current-buffer stdout-buffer
97 (goto-char (point-min))
98 (looking-at "hello stdout!")))
99 (should (with-current-buffer stderr-buffer
100 (goto-char (point-min))
101 (looking-at "hello stderr!")))))
103 (ert-deftest process-test-stderr-filter ()
104 (skip-unless (executable-find "bash"))
105 (let* ((sentinel-called nil)
106 (stderr-sentinel-called nil)
107 (stdout-output nil)
108 (stderr-output nil)
109 (stdout-buffer (generate-new-buffer "*stdout*"))
110 (stderr-buffer (generate-new-buffer "*stderr*"))
111 (stderr-proc (make-pipe-process :name "stderr"
112 :buffer stderr-buffer))
113 (proc (make-process :name "test" :buffer stdout-buffer
114 :command (list "bash" "-c"
115 (concat "echo hello stdout!; "
116 "echo hello stderr! >&2; "
117 "exit 20"))
118 :stderr stderr-proc))
119 (start-time (float-time)))
120 (set-process-filter proc (lambda (proc input)
121 (push input stdout-output)))
122 (set-process-sentinel proc (lambda (proc msg)
123 (setq sentinel-called t)))
124 (set-process-filter stderr-proc (lambda (proc input)
125 (push input stderr-output)))
126 (set-process-sentinel stderr-proc (lambda (proc input)
127 (setq stderr-sentinel-called t)))
128 (while (not (or sentinel-called
129 (> (- (float-time) start-time)
130 process-test-sentinel-wait-timeout)))
131 (accept-process-output))
132 (cl-assert (eq (process-status proc) 'exit))
133 (cl-assert (= (process-exit-status proc) 20))
134 (should sentinel-called)
135 (should (equal 1 (with-current-buffer stdout-buffer
136 (point-max))))
137 (should (equal "hello stdout!\n"
138 (mapconcat #'identity (nreverse stdout-output) "")))
139 (should stderr-sentinel-called)
140 (should (equal 1 (with-current-buffer stderr-buffer
141 (point-max))))
142 (should (equal "hello stderr!\n"
143 (mapconcat #'identity (nreverse stderr-output) "")))))
145 (provide 'process-tests)