From 64a6f0f19f488ef87071ef15fa6ddd67c78ae272 Mon Sep 17 00:00:00 2001 From: Peter Bex Date: Mon, 1 Oct 2012 19:02:50 +0100 Subject: Implement run/file*, which is really weird --- scsh-process.scm | 16 ++++++++++++++-- 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")) -- cgit v1.2.3