test/src/process-tests.el

   1 ;;; process-tests.el --- Testing the process facilities
   2
   3 ;; Copyright (C) 2013-2018 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 <https://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 (ert-deftest make-process/noquery-stderr ()
 166   "Checks that Bug#30031 is fixed."
 167   (skip-unless (executable-find "sleep"))
 168   (with-temp-buffer
 169     (let* ((previous-processes (process-list))
 170            (process (make-process :name "sleep"
 171                                   :command '("sleep" "1h")
 172                                   :noquery t
 173                                   :connection-type 'pipe
 174                                   :stderr (current-buffer))))
 175       (unwind-protect
 176           (let ((new-processes (cl-set-difference (process-list)
 177                                                   previous-processes
 178                                                   :test #'eq)))
 179             (should new-processes)
 180             (dolist (process new-processes)
 181               (should-not (process-query-on-exit-flag process))))
 182         (kill-process process)))))
 183
 184 ;; Return t if OUTPUT could have been generated by merging the INPUTS somehow.
 185 (defun process-tests--mixable (output &rest inputs)
 186   (while (and output (let ((ins inputs))
 187                        (while (and ins (not (eq (car (car ins)) (car output))))
 188                          (setq ins (cdr ins)))
 189                        (if ins
 190                            (setcar ins (cdr (car ins))))
 191                        ins))
 192     (setq output (cdr output)))
 193   (not (apply #'append output inputs)))
 194
 195 (ert-deftest make-process/mix-stderr ()
 196   "Check that `make-process' mixes the output streams if STDERR is nil."
 197   (skip-unless (executable-find "bash"))
 198   ;; Frequent random (?) failures on hydra.nixos.org, with no process output.
 199   ;; Maybe this test should be tagged unstable?  See bug#31214.
 200   (skip-unless (not (getenv "EMACS_HYDRA_CI")))
 201   (with-temp-buffer
 202     (let ((process (make-process
 203                     :name "mix-stderr"
 204                     :command (list "bash" "-c"
 205                                    "echo stdout && echo stderr >&2")
 206                     :buffer (current-buffer)
 207                     :sentinel #'ignore
 208                     :noquery t
 209                     :connection-type 'pipe)))
 210       (while (process-live-p process)
 211         (accept-process-output process))
 212       (should (eq (process-status process) 'exit))
 213       (should (eq (process-exit-status process) 0))
 214       (should (process-tests--mixable (string-to-list (buffer-string))
 215                                       (string-to-list "stdout\n")
 216                                       (string-to-list "stderr\n"))))))
 217
 218 (provide 'process-tests)
 219 ;; process-tests.el ends here.