diff options
author | Peter Bex <peter@more-magic.net> | 2012-10-01 19:02:50 +0100 |
---|---|---|
committer | Peter Bex <peter@more-magic.net> | 2012-10-01 19:02:50 +0100 |
commit | 64a6f0f19f488ef87071ef15fa6ddd67c78ae272 (patch) | |
tree | 872c2a4055b59667fa5a9b377ce10840037306a9 | |
parent | 32e9bffa67258b7331dfcf85ffea8fd490bb2333 (diff) | |
download | scsh-process-64a6f0f19f488ef87071ef15fa6ddd67c78ae272.tar.gz |
Implement run/file*, which is really weird
-rw-r--r-- | scsh-process.scm | 16 | ||||
-rw-r--r-- | tests/run.scm | 6 |
2 files changed, 19 insertions, 3 deletions
diff --git a/scsh-process.scm b/scsh-process.scm index 96a3bc7..50c2431 100644 --- a/scsh-process.scm +++ b/scsh-process.scm @@ -113,10 +113,22 @@ (apply values (fork/pipe+ conns thunk) temp-files))) (define (run/port* thunk) - (fork/pipe (lambda () (with-output-to-port (open-output-file* 1) thunk))) + (fork/pipe (lambda () + (with-output-to-port (open-output-file* 1) + (lambda () + (with-error-output-to-port (open-output-file* 2) thunk))))) (open-input-file* 0)) (define (run/file* thunk) - (error "not yet implemented")) + (let* ((temp-file (create-temporary-file))) + (process-wait ; This is peculiar + (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))))))) + temp-file)) (define (run/string* thunk) (read-string #f (run/port* thunk))) (define (run/strings* thunk) diff --git a/tests/run.scm b/tests/run.scm index c0cb01f..f537ad8 100644 --- a/tests/run.scm +++ b/tests/run.scm @@ -33,7 +33,11 @@ (test "Simple run/port" '(a b c) - (read (run/port (echo "(a b c)"))))) + (read (run/port (echo "(a b c)")))) + + (test "Simple run/file" + "blah\n" + (with-input-from-file (run/file (echo "blah")) read-all))) (test-group "Subprocesses" (let ((outfile "outfile")) |