Actually commit msdos/sedadmin.inp.
[emacs.git] / test / automated / process-tests.el
blobcd209bacaa68aae741b37070bf737d412e1dbb45
1 ;;; process-tests.el --- Testing the process facilities
3 ;; Copyright (C) 2013-2014 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 (provide 'process-tests)