Close ports opened for redirects.

* gash/shell.scm (redir->parameter+port): Rename this...
(process-redirect): ...to this, and make it return a list with the
third element being a boolean indicating if the port was opened by us.
(sh:with-redirects): Close ports when the new boolean is set.

gash/shell.scm

@@ -167,45 +167,46 @@ environment variable bindings @var{bindings}."
 
 ;;; Redirects.
 
-(define (redir->parameter+port redir)
+(define (process-redir redir)
-  "Convert @var{redir} into a pair consisting of the current-port
+  "Convert @var{redir} into a list consisting of the current-port
-parameter to be updated and the port that should be its new value (or
+parameter to be updated, the port that should be its new value (or
-@code{#f} if it should be considered closed)."
+@code{#f} if it should be considered closed), and a boolean indicating
+if it is our responsibility to close the port."
 
-  (define* (make-parameter+port fd target #:optional (open-flags 0))
+  (define* (make-processed-redir fd target #:optional (open-flags 0))
     (let ((port (match target
                   ((? port?) target)
                   ((? string?) (open target open-flags))
                   ;; TODO: Verify open-flags.
                   ((? integer?) ((fd->current-port target)))
                   (#f #f))))
-      `(,(fd->current-port fd) . ,port)))
+      `(,(fd->current-port fd) ,port ,(string? target))))
 
   (match redir
     (('< (? integer? fd) (? string? filename))
-     (make-parameter+port fd filename O_RDONLY))
+     (make-processed-redir fd filename O_RDONLY))
     (('> (? integer? fd) (? string? filename))
      ;; TODO: Observe noclobber.
-     (make-parameter+port fd filename (logior O_WRONLY O_CREAT O_TRUNC)))
+     (make-processed-redir fd filename (logior O_WRONLY O_CREAT O_TRUNC)))
     (('>! (? integer? fd) (? string? filename))
-     (make-parameter+port fd filename (logior O_WRONLY O_CREAT O_TRUNC)))
+     (make-processed-redir fd filename (logior O_WRONLY O_CREAT O_TRUNC)))
     (('>> fd filename)
-     (make-parameter+port fd filename (logior O_WRONLY O_CREAT O_APPEND)))
+     (make-processed-redir fd filename (logior O_WRONLY O_CREAT O_APPEND)))
     (('<> fd filename)
-     (make-parameter+port fd filename (logior O_RDWR O_CREAT)))
+     (make-processed-redir fd filename (logior O_RDWR O_CREAT)))
     (('<& (? integer? fd1) (? integer? fd2))
-     (make-parameter+port fd1 fd2))
+     (make-processed-redir fd1 fd2))
     (('<& (? integer? fd) '-)
-     (make-parameter+port fd #f))
+     (make-processed-redir fd #f))
     (('>& (? integer? fd1) (? integer? fd2))
-     (make-parameter+port fd1 fd2))
+     (make-processed-redir fd1 fd2))
     (('>& (? integer? fd) '-)
-     (make-parameter+port fd #f))
+     (make-processed-redir fd #f))
     (('<< (? integer? fd) text)
      (let ((port (tmpfile)))
        (display text port)
        (seek port 0 SEEK_SET)
-       (make-parameter+port fd port)))))
+       (make-processed-redir fd port)))))
 
 (define (sh:set-redirects redirs)
   "Put the redirects @var{redirs} into effect."
@@ -213,11 +214,10 @@ parameter to be updated and the port that should be its new value (or
     (match redirs
       (() #t)
       ((redir . rest)
-       (match (false-if-exception
+       (match (false-if-exception (process-redir redir))
-               (redir->parameter+port redir))
          (#f (set-status! 1)
              (errexit))
-         ((parameter . port)
+         ((parameter port close?)
           (parameter port)
           (loop rest)))))))
 
@@ -228,15 +228,15 @@ parameter to be updated and the port that should be its new value (or
   ;; only way.
   ((fold-right (lambda (redir thunk)
                  (lambda ()
-                   (match (false-if-exception
+                   (match (false-if-exception (process-redir redir))
-                           (redir->parameter+port redir))
                      (#f (set-status! 1)
                          (errexit))
-                     ((parameter . port)
+                     ((parameter port close?)
                       (parameterize ((parameter port))
                         (thunk))
-                      (when (output-port? port)
+                      (cond
-                        (force-output port))))))
+                       (close? (close-port port))
+                       ((output-port? port) (force-output port)))))))
                thunk
                redirs)))