[Guile-commits] 01/02: popen: 'open-process' returns unbuffered ports.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guile.

commit c7f76d94dabb589601e809710de5fcc9c4c9a882
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Fri Jun 19 20:56:38 2020 +0200

    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      | 25 ++++++++++++++++++++-----
 test-suite/tests/popen.test | 23 +++++++++++++++++++++++
 2 files changed, 43 insertions(+), 5 deletions(-)

diff --git a/module/ice-9/popen.scm b/module/ice-9/popen.scm
index 5ab93f2..a0ef0dc 100644
--- a/module/ice-9/popen.scm
+++ b/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)))
-         (pid (piped-process command args from to)))
-    (values (and from (fdes->inport (car from)))
-            (and to (fdes->outport (cdr to))) pid)))
+                      (string=? mode OPEN_BOTH))
+                  (pipe)))
+         (pid (piped-process command args
+                             (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
diff --git a/test-suite/tests/popen.test b/test-suite/tests/popen.test
index 86e3889..692156a 100644
--- a/test-suite/tests/popen.test
+++ b/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
  ;;