diff options
| author | Peter Bex <peter@more-magic.net> | 2012-10-05 21:16:35 +0200 |
|---|---|---|
| committer | Peter Bex <peter@more-magic.net> | 2012-10-05 21:16:35 +0200 |
| commit | 151d2a88bb15a252453c41a080ddc3fcc7b4de49 (patch) | |
| tree | 1527103bbc59d8ba87bd0e7917597eb0c99cccad | |
| parent | f335b90a882da57f7a3c438d959a34d574e46c04 (diff) | |
| download | scsh-process-151d2a88bb15a252453c41a080ddc3fcc7b4de49.tar.gz | |
Improve test for <<-redirection by making it less dependent on random factors that determine process interleaving, ensuring it gets processed through the pipeline rather than on the same descriptor by mangling it through 'tr'. Fix <<-redirection by reopening output port on new descriptor and explicitly setting up the input port to the given fd in the parent process
| -rw-r--r-- | scsh-process.scm | 2 | ||||
| -rw-r--r-- | tests/run.scm | 7 |
2 files changed, 5 insertions, 4 deletions
diff --git a/scsh-process.scm b/scsh-process.scm index e60fb67..1fa12d9 100644 --- a/scsh-process.scm +++ b/scsh-process.scm @@ -322,7 +322,7 @@ (duplicate-fileno (file-open (maybe->string `?file-name) open/rdonly) `?fd)) ((_ (<< ?fd ?object)) - (fork/pipe (lambda () (display `?object)))) + (fork/pipe+ `((1 ?fd)) (lambda () (display `?object (open-output-file* 1))))) ((_ (= ?fd-from ?fd/port-to)) (let* ((fd/port-to ?fd/port-to) ; Evaluate once (fd-to (if (port? fd/port-to) diff --git a/tests/run.scm b/tests/run.scm index 2ad287f..c4deb88 100644 --- a/tests/run.scm +++ b/tests/run.scm @@ -1,7 +1,7 @@ (include "../scsh-process.scm") (import scsh-process) -(use test posix) +(use test posix srfi-13) (test-begin "scsh-process") @@ -53,8 +53,9 @@ (let ((message "testing, 1 2 3")) (test "Redirecting from object" - `("blah" "foo" ,message) - (run/strings (cat ,tmpfile -) (<< ,message)))) + `("blah" "foo" ,(string-delete #\t message)) + (run/strings (pipe (epf (tr -d t) (<< ,message)) + (cat ,tmpfile -))))) (delete-file* tmpfile))) (test-group "Subprocesses" |