summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMichael Gran <spk121@yahoo.com>2025-03-30 20:54:06 -0700
committerMichael Gran <spk121@yahoo.com>2025-03-30 20:54:06 -0700
commit2b5528847db0b70fc676e34b30acaa6bc296f980 (patch)
tree93642945c25898a2addd55c3678095f46ab7999e
parent59f3e1a881a2d5a836d8ae0ca6930d4c8c3ba3bc (diff)
downloadguile-2b5528847db0b70fc676e34b30acaa6bc296f980.tar.gz
MinGW: don't hand on unsupported popen tests
-rw-r--r--test-suite/tests/popen.test48
1 files changed, 26 insertions, 22 deletions
diff --git a/test-suite/tests/popen.test b/test-suite/tests/popen.test
index 6328eed37..01907d6f5 100644
--- a/test-suite/tests/popen.test
+++ b/test-suite/tests/popen.test
@@ -115,11 +115,11 @@
(open-input-pipe "read line && echo $line")))))
(display "hello\n" (cdr p2c))
(force-output (cdr p2c))
- (let ((result (eq? (read port) 'hello)))
+ (let ((result (eq? (read port)) 'hello))
(close-port (cdr p2c))
(close-pipe port)
result)))
-
+
;; After the child closes stdout (which it indicates here by writing
;; "closed" to stderr), the parent should see eof. In Guile 1.6.4
;; and earlier a duplicate of stdout existed in the child, meaning
@@ -132,7 +132,10 @@
;; sure that we are testing what the parent sees at a point where
;; the child has closed stdout but is still alive.
(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))
(p2c (pipe))
(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
;; terminate it (and avoid leaving a zombie).
(pass-if "no duplicate"
- (unless (defined? 'SIGPIPE)
- ;; MinGW has no SIGPIPE, so closing the pipe doesn't
+ (when mingw?
+ ;; MinGW has no working SIGPIPE, so closing the pipe doesn't
;; terminate the process.
(throw 'unsupported))
(let* ((c2p (pipe))
@@ -230,26 +233,27 @@ exec 2>~a; read REPLY"
result))))))
(with-test-prefix "open-pipe*"
-
(pass-if-equal "OPEN_BOTH"
'(0 (good!))
;; This test ensures that the ports that underlie the read/write
;; port are unbuffered. If they were buffered, the child process
;; would wait in 'read' forever.
- (let ((pipe (open-pipe* OPEN_BOTH "guile" "-c"
- (object->string
- '(begin
- (setvbuf (current-output-port) 'line)
- (write '(hello!))
- (newline)
- (let ((greeting (read)))
- (write '(good!))))))))
- (setvbuf pipe 'line)
- (let ((return (read pipe)))
- (write '(hi!) pipe)
- (newline pipe)
- (let ((last (read pipe)))
- (list (close-pipe pipe) last))))))
+ (if mingw?
+ (throw 'unresolved) ; FIXME: why does this hang?
+ (let ((pipe (open-pipe* OPEN_BOTH "guile" "-c"
+ (object->string
+ '(begin
+ (setvbuf (current-output-port) 'line)
+ (write '(hello!))
+ (newline)
+ (let ((greeting (read)))
+ (write '(good!))))))))
+ (setvbuf pipe 'line)
+ (let ((return (read pipe)))
+ (write '(hi!) pipe)
+ (newline pipe)
+ (let ((last (read pipe)))
+ (list (close-pipe pipe) last)))))))
;;
;; close-pipe
@@ -277,8 +281,8 @@ 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
+ (when mingw?
+ ;; MinGW has a broken SIGPIPE, so 'tr' doesn't exit when input is
;; exhausted.
(throw 'unsupported))
(receive (from to pid)