diff options
| -rw-r--r-- | scsh-process.scm | 17 | ||||
| -rw-r--r-- | tests/run.scm | 12 |
2 files changed, 21 insertions, 8 deletions
diff --git a/scsh-process.scm b/scsh-process.scm index 6102c4d..57a773e 100644 --- a/scsh-process.scm +++ b/scsh-process.scm @@ -214,19 +214,22 @@ (define-syntax setup-redirection (syntax-rules (< > << >> = - stdports) ((_ (< ?file-name)) (setup-redirection (< 0 ?file-name))) - ((_ (> ?file-name)) (setup-redirection (> 1 ?file-name))) ((_ (<< ?object)) (setup-redirection (<< 0 ?object))) - ((_ (>> ?object)) (setup-redirection (>> 1 ?object))) - ((_ (< ?fd ?file-name)) - (duplicate-fileno (file-open (maybe-symbol->string `?file-name) - open/rdonly) - `?fd)) + ((_ (> ?file-name)) (setup-redirection (> 1 ?file-name))) + ((_ (>> ?file-name)) (setup-redirection (>> 1 ?file-name))) ((_ (> ?fd ?file-name)) (duplicate-fileno (file-open (maybe-symbol->string `?file-name) (fx+ open/wronly open/creat)) `?fd)) + ((_ (>> ?fd ?file-name)) + (duplicate-fileno (file-open (maybe-symbol->string `?file-name) + (fx+ open/wronly (fx+ open/append open/creat))) + `?fd)) + ((_ (< ?fd ?file-name)) + (duplicate-fileno (file-open (maybe-symbol->string `?file-name) + open/rdonly) + `?fd)) ((_ (<< ?fd ?object)) (error "<< currently not implemented")) - ((_ (>> ?fd ?object)) (error ">> currently not implemented")) ((_ (= ?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 4e3bb8a..df73ac3 100644 --- a/tests/run.scm +++ b/tests/run.scm @@ -38,7 +38,17 @@ (let ((tmpfile (run/file (echo "blah")))) (test "Simple run/file" "blah\n" - (with-input-from-file tmpfile read-all)))) + (with-input-from-file tmpfile read-all)) + + (test "Appending to a file" + '("blah" "foo") + (begin (run (echo foo) (>> ,tmpfile)) + (read-lines tmpfile))) + + (test "Redirecting from object" + '("blah" "foo" "testing, 1 2 3") + (run/strings (cat tmpfile -) (<< "testing, 1 2 3"))) + (delete-file* tmpfile))) (test-group "Subprocesses" (let ((outfile "outfile")) |