mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-01 04:10:18 +02:00
Code Activity

MinGW: don't hand on unsupported popen tests

Browse source
This commit is contained in:
Michael Gran 2025-03-30 20:54:06 -07:00
parent 59f3e1a881
commit 2b5528847d
1 changed files with 26 additions and 22 deletions
Download patch file Download diff file Expand all files Collapse all files

20
test-suite/tests/popen.test
View file

@ -115,7 +115,7 @@
(open-input-pipe "read line && echo $line"))))) (open-input-pipe "read line && echo $line")))))
(display "hello\n" (cdr p2c)) (display "hello\n" (cdr p2c))
(force-output (cdr p2c)) (force-output (cdr p2c))
(let ((result (eq? (read port) 'hello))) (let ((result (eq? (read port)) 'hello))
(close-port (cdr p2c)) (close-port (cdr p2c))
(close-pipe port) (close-pipe port)
result))) result)))
@ -132,7 +132,10 @@
;; sure that we are testing what the parent sees at a point where ;; sure that we are testing what the parent sees at a point where
;; the child has closed stdout but is still alive. ;; the child has closed stdout but is still alive.
(pass-if "no duplicate" (pass-if "no duplicate"
(when mingw? (throw 'unresolved)) (when mingw?
;; MinGW has no SIGPIPE, so closing the pipe doesn't
;; terminate the process.
(throw 'unresolved))
(let* ((c2p (pipe)) (let* ((c2p (pipe))
(p2c (pipe)) (p2c (pipe))
(port (with-error-to-port (cdr c2p) (port (with-error-to-port (cdr c2p)
@ -200,8 +203,8 @@ exec 2>~a; read REPLY"
;; the child process; we rely on the child getting SIGPIPE, to ;; the child process; we rely on the child getting SIGPIPE, to
;; terminate it (and avoid leaving a zombie). ;; terminate it (and avoid leaving a zombie).
(pass-if "no duplicate" (pass-if "no duplicate"
(unless (defined? 'SIGPIPE) (when mingw?
;; MinGW has no SIGPIPE, so closing the pipe doesn't ;; MinGW has no working SIGPIPE, so closing the pipe doesn't
;; terminate the process. ;; terminate the process.
(throw 'unsupported)) (throw 'unsupported))
(let* ((c2p (pipe)) (let* ((c2p (pipe))
@ -230,12 +233,13 @@ exec 2>~a; read REPLY"
result)))))) result))))))
(with-test-prefix "open-pipe*" (with-test-prefix "open-pipe*"
(pass-if-equal "OPEN_BOTH" (pass-if-equal "OPEN_BOTH"
'(0 (good!)) '(0 (good!))
;; This test ensures that the ports that underlie the read/write ;; This test ensures that the ports that underlie the read/write
;; port are unbuffered. If they were buffered, the child process ;; port are unbuffered. If they were buffered, the child process
;; would wait in 'read' forever. ;; would wait in 'read' forever.
(if mingw?
(throw 'unresolved) ; FIXME: why does this hang?
(let ((pipe (open-pipe* OPEN_BOTH "guile" "-c" (let ((pipe (open-pipe* OPEN_BOTH "guile" "-c"
(object->string (object->string
'(begin '(begin
@ -249,7 +253,7 @@ exec 2>~a; read REPLY"
(write '(hi!) pipe) (write '(hi!) pipe)
(newline pipe) (newline pipe)
(let ((last (read pipe))) (let ((last (read pipe)))
(list (close-pipe pipe) last)))))) (list (close-pipe pipe) last)))))))
;; ;;
;; close-pipe ;; close-pipe
@ -277,8 +281,8 @@ exec 2>~a; read REPLY"
(pass-if-equal "open-process" (pass-if-equal "open-process"
'("HELLO WORLD" 0) '("HELLO WORLD" 0)
(unless (defined? 'SIGPIPE) (when mingw?
;; MinGW has no SIGPIPE, so 'tr' doesn't exit when input is ;; MinGW has a broken SIGPIPE, so 'tr' doesn't exit when input is
;; exhausted. ;; exhausted.
(throw 'unsupported)) (throw 'unsupported))
(receive (from to pid) (receive (from to pid)