diff --git a/test-suite/tests/popen.test b/test-suite/tests/popen.test index aad7687b7..6328eed37 100644 --- a/test-suite/tests/popen.test +++ b/test-suite/tests/popen.test @@ -200,6 +200,10 @@ exec 2>~a; read REPLY" ;; the child process; we rely on the child getting SIGPIPE, to ;; terminate it (and avoid leaving a zombie). (pass-if "no duplicate" + (unless (defined? 'SIGPIPE) + ;; MinGW has no SIGPIPE, so closing the pipe doesn't + ;; terminate the process. + (throw 'unsupported)) (let* ((c2p (pipe)) (port (with-error-to-port (cdr c2p) (lambda () @@ -273,6 +277,10 @@ exec 2>~a; read REPLY" (pass-if-equal "open-process" '("HELLO WORLD" 0) + (unless (defined? 'SIGPIPE) + ;; MinGW has no SIGPIPE, so 'tr' doesn't exit when input is + ;; exhausted. + (throw 'unsupported)) (receive (from to pid) ((@@ (ice-9 popen) open-process) OPEN_BOTH "tr" "[:lower:]" "[:upper:]") diff --git a/test-suite/tests/ports.test b/test-suite/tests/ports.test index 88c13a04e..6f1b1bd8a 100644 --- a/test-suite/tests/ports.test +++ b/test-suite/tests/ports.test @@ -752,9 +752,14 @@ ;;; Run a command, send some output to it, and see if it worked. + +;; We could have used grep for this test, but on systems without +;; SIGPIPE, grep never exits. (pass-if "pipe: write" (let* ((filename (test-file)) - (pipe (open-pipe (string-append "grep Mommy > " filename) "w"))) + (awkscript + "awk 'BEGIN{i=1} {if (match($0,\"Mommy\")) print $0; if (i==2) exit; i++;}'") + (pipe (open-pipe (string-append awkscript " > " filename) "w"))) (display "Now Jimmy lives on a mushroom cloud\n" pipe) (display "Mommy, why does everybody have a bomb?\n" pipe) (close-pipe pipe) diff --git a/test-suite/tests/posix.test b/test-suite/tests/posix.test index fe79c988f..b031de6f5 100644 --- a/test-suite/tests/posix.test +++ b/test-suite/tests/posix.test @@ -422,8 +422,29 @@ (close-port (car input+output)) (list (cdr (waitpid pid)) str)))) + (pass-if-equal "awk with stdin and stdout redirects" + "world.\n" + (let* ((a+b (pipe)) + (c+d (pipe)) + (pid (spawn "awk" '("awk" "{print $2; exit 0;}") + #:input (car a+b) + #:output (cdr c+d)))) + (close-port (car a+b)) + (close-port (cdr c+d)) + + (display "Hello world.\n" (cdr a+b)) + (close-port (cdr a+b)) + + (let ((str (get-string-all (car c+d)))) + (close-port (car c+d)) + (waitpid pid) + str))) + (pass-if-equal "wc with stdin and stdout redirects" "2\n" + (unless (defined? 'SIGPIPE) + ;; This test expects a closing pipe to kill the spawned process. + (throw 'unsupported)) (let* ((a+b (pipe)) (c+d (pipe)) (pid (spawn "wc" '("wc" "-w")