diff options
| -rw-r--r-- | scsh-process.scm | 14 | ||||
| -rw-r--r-- | 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)) |