code.delx.au - gnu-emacs/blob - test/lisp/legacy/process-tests.el

   1 ;;; process-tests.el --- Testing the process facilities
   2
   3 ;; Copyright (C) 2013-2016 Free Software Foundation, Inc.
   4
   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.
   9
  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.
  14
  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/>.
  17
  18 ;;; Commentary:
  19
  20 ;;
  21
  22 ;;; Code:
  23
  24 (require 'ert)
  25
  26 ;; Timeout in seconds; the test fails if the timeout is reached.
  27 (defvar process-test-sentinel-wait-timeout 2.0)
  28
  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))
  44
  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)))
  49
  50 (ert-deftest process-test-sentinel-sit-for ()
  51   (skip-unless (executable-find "bash"))
  52   (should
  53    (process-test-sentinel-wait-function-working-p (lambda () (sit-for 0.01 t)))))
  54
  55 (when (eq system-type 'windows-nt)
  56   (ert-deftest process-test-quoted-batfile ()
  57     "Check that Emacs hides CreateProcess deficiency (bug#18745)."
  58     (let (batfile)
  59       (unwind-protect
  60           (progn
  61             ;; CreateProcess will fail when both the bat file and 1st
  62             ;; argument are quoted, so include spaces in both of those
  63             ;; to force quoting.
  64             (setq batfile (make-temp-file "echo args" nil ".bat"))
  65             (with-temp-file batfile
  66               (insert "@echo arg1=%1, arg2=%2\n"))
  67             (with-temp-buffer
  68               (call-process batfile nil '(t t) t "x &y")
  69               (should (string= (buffer-string) "arg1=\"x &y\", arg2=\n")))
  70             (with-temp-buffer
  71               (call-process-shell-command
  72                (mapconcat #'shell-quote-argument (list batfile "x &y") " ")
  73                nil '(t t) t)
  74               (should (string= (buffer-string) "arg1=\"x &y\", arg2=\n"))))
  75         (when batfile (delete-file batfile))))))
  76
  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; "
  85                                                     "exit 20"))
  86                              :buffer stdout-buffer
  87                              :stderr stderr-buffer))
  88          (sentinel-called nil)
  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!")))))
 104
 105 (ert-deftest process-test-stderr-filter ()
 106   (skip-unless (executable-find "bash"))
 107   (let* ((sentinel-called nil)
 108          (stderr-sentinel-called nil)
 109          (stdout-output nil)
 110          (stderr-output 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; "
 119                                                     "exit 20"))
 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
 138                        (point-max))))
 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
 143                        (point-max))))
 144     (should (equal "hello stderr!\n"
 145                    (mapconcat #'identity (nreverse stderr-output) "")))))
 146
 147 (ert-deftest start-process-should-not-modify-arguments ()
 148   "`start-process' must not modify its arguments in-place."
 149   ;; See bug#21831.
 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")))
 156                  (_ "/bin//sh")))
 157          (samepath (copy-sequence path)))
 158     ;; Make sure 'start-process' actually goes all the way and invokes
 159     ;; the program.
 160     (should (process-live-p (condition-case nil
 161                                 (start-process "" nil path)
 162                               (error nil))))
 163     (should (equal path samepath))))
 164
 165 (provide 'process-tests)