From 2b5528847db0b70fc676e34b30acaa6bc296f980 Mon Sep 17 00:00:00 2001
From: Michael Gran <spk121@yahoo.com>
Date: Sun, 30 Mar 2025 20:54:06 -0700
Subject: [PATCH] MinGW: don't hand on unsupported popen tests

---
 test-suite/tests/popen.test | 48 ++++++++++++++++++++-----------------
 1 file 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)