From 0802db49a40586f24db70a95d27500e2845f1eda Mon Sep 17 00:00:00 2001
From: Peter Bex <peter@more-magic.net>
Date: Sat, 18 Jul 2015 14:12:23 +0200
Subject: Fix default output redirections to ignore stderr.

This is what scsh does as well, and is more like a regular UNIX shell.
Thanks to Haochi Kiang for reporting the bug and providing a patch.
---
 scsh-process.scm | 14 ++++----------
 tests/run.scm    | 37 ++++++++++++++++++++++++++++++++++---
 2 files changed, 38 insertions(+), 13 deletions(-)

diff --git a/scsh-process.scm b/scsh-process.scm
index d7ffaf0..a741177 100644
--- a/scsh-process.scm
+++ b/scsh-process.scm
@@ -11,7 +11,7 @@
 ;; WARNING: Don't mix with threading unless you're using
 ;;          Chicken 4.8.1 rev 47b5be71 or later.
 ;;
-;;; Copyright (c) 2012-2013, Peter Bex
+;;; Copyright (c) 2012-2015, Peter Bex
 ;; All rights reserved.
 ;
 ; Redistribution and use in source and binary forms, with or without
@@ -247,10 +247,7 @@
         (lambda ()
           (file-close in)
           (duplicate-fileno out 1)
-          (duplicate-fileno out 2)
-          (with-output-to-port (open-output-file* out)
-            (lambda ()
-              (with-error-output-to-port (open-output-file* out) thunk)))))))
+          (with-output-to-port (open-output-file* out) thunk)))))
     (file-close out)
     (open-input-file* in)))
 
@@ -260,10 +257,7 @@
      (fork/pipe (lambda ()
                   (let ((fd (file-open temp-file open/wronly)))
                     (duplicate-fileno fd 1)
-                    (duplicate-fileno fd 2)
-                    (with-output-to-port (open-output-file* 1)
-                      (lambda ()
-                        (with-error-output-to-port (open-output-file* 2) thunk)))))))
+                    (with-output-to-port (open-output-file* 1) thunk)))))
     temp-file))
 
 (define (run/string* thunk)
@@ -368,7 +362,7 @@
   ;; with the generic one if we happen to make a small mistake
   (syntax-rules (pipe pipe+ begin epf)
     ((_ (pipe ?pf0 ...) ?redir0 ...)
-     (exec-epf (pipe+ ((1 2 0)) ?pf0 ...) ?redir0 ...))
+     (exec-epf (pipe+ ((1 0)) ?pf0 ...) ?redir0 ...))
     ((_ (pipe+ ?args ...) ?redir0 ...)
      (let-syntax
          ((pipe+
diff --git a/tests/run.scm b/tests/run.scm
index ff7896d..2510c7e 100644
--- a/tests/run.scm
+++ b/tests/run.scm
@@ -18,6 +18,23 @@
         "This is a test"
         (run/string* (lambda () (display "This is a test"))))
 
+  ;; Reported by Haochi Kiang
+  (test "run/string* does not redirect stderr"
+        '("This should go to stdout" "")
+        (let* ((strerr (open-output-string))
+               (ignored-output          ; Collected in child process
+                (with-error-output-to-port
+                 strerr
+                 (lambda ()
+                   (run/string*
+                    (lambda ()
+                      (display "This should go to stdout")
+                      ;; This doesn't end up in the parent process'
+                      ;; buffer because the memory isn't shared.
+                      (display "This should go to stderr"
+                               (current-error-port))))))))
+          (list ignored-output (get-output-string strerr))))
+
   (test-error "run*/string* raises error if subprocess has nonzero exit status"
               (run*/string* (lambda () (display "ohai") (exit 1)))))
 
@@ -29,6 +46,13 @@
           "hi, there\n"
           (run/string (echo "hi, there")))
 
+    ;; Reported by Haochi Kiang
+    (test "Simple run/string with output to stderr"
+          ""
+          ;; TODO: Find some way so this doesn't pollute the actual
+          ;; process's stderr
+          (run/string (sh -c "echo 'hi, there' >&2")))
+
     (test "Unquote-splicing run/string"
           "hi, there\n"
           (run/string (echo ,@(list "hi," "there"))))
@@ -78,11 +102,11 @@
                                        (print "hi, there"))
                                 (cat))))))
     
-    (let ((outfile "outfile"))
+    (let ((the-outfile "outfile"))
       (test "Subprocess writing to a file"
             "hi, there\n"
-            (begin (run (echo "hi, there") (> ,outfile))
-                   (read-all "outfile"))))
+            (begin (run (echo "hi, there") (> ,the-outfile))
+                   (read-all the-outfile))))
   
     (delete-file* "outfile")
     (let ((echo-command 'echo))
@@ -94,6 +118,13 @@
                    (read-all "outfile"))))
     (delete-file* "outfile")
 
+    ;; Reported by Haochi Kiang
+    (test "Output redirection with pipe ignores stderr"
+          ""
+          ;; TODO: Find some way so this doesn't pollute the actual
+          ;; process's stderr
+          (run/string (pipe (sh -c "echo foo >&2") (cat))))
+
     (test "Nested output redirection with pipe+"
           "foo\n"
           (run/string (pipe+ ((1 0))
-- 
cgit v1.2.3