popen: 'open-process' returns unbuffered ports.

* module/ice-9/popen.scm (open-process)[unbuffered, fdes-pair]: New
procedures.
Use them.  Return unbuffered ports.
* test-suite/tests/popen.test ("open-pipe*"): New test prefix.

module/ice-9/popen.scm

@@ -99,13 +99,28 @@ process (based on pipes) is created and returned.  @var{mode} specifies
 whether an input, an output or an input-output port to the process is
 created: it should be the value of @code{OPEN_READ}, @code{OPEN_WRITE}
 or @code{OPEN_BOTH}."
+  (define (unbuffered port)
+    (setvbuf port 'none)
+    port)
+
+  (define (fdes-pair ports)
+    (and ports
+         (cons (port->fdes (car ports)) (port->fdes (cdr ports)))))
+
   (let* ((from (and (or (string=? mode OPEN_READ)
-                        (string=? mode OPEN_BOTH)) (pipe->fdes)))
+                        (string=? mode OPEN_BOTH))
+                    (pipe)))
          (to (and (or (string=? mode OPEN_WRITE)
-                      (string=? mode OPEN_BOTH)) (pipe->fdes)))
+                      (string=? mode OPEN_BOTH))
-         (pid (piped-process command args from to)))
+                  (pipe)))
-    (values (and from (fdes->inport (car from)))
+         (pid (piped-process command args
-            (and to (fdes->outport (cdr to))) pid)))
+                             (fdes-pair from)
+                             (fdes-pair to))))
+    ;; The original 'open-process' procedure would return unbuffered
+    ;; ports; do the same here.
+    (values (and from (unbuffered (car from)))
+            (and to (unbuffered (cdr to)))
+            pid)))
 
 (define (open-pipe* mode command . args)
   "Executes the program @var{command} with optional arguments

test-suite/tests/popen.test

@@ -196,6 +196,29 @@ exec 2>~a; read REPLY"
             (close-pipe port)
             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))))))
+
  ;;
  ;; close-pipe
  ;;