summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorPeter Bex <peter@more-magic.net>2012-10-01 19:02:50 +0100
committerPeter Bex <peter@more-magic.net>2012-10-01 19:02:50 +0100
commit64a6f0f19f488ef87071ef15fa6ddd67c78ae272 (patch)
tree872c2a4055b59667fa5a9b377ce10840037306a9
parent32e9bffa67258b7331dfcf85ffea8fd490bb2333 (diff)
downloadscsh-process-64a6f0f19f488ef87071ef15fa6ddd67c78ae272.tar.gz
Implement run/file*, which is really weird
-rw-r--r--scsh-process.scm16
-rw-r--r--tests/run.scm6
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"))