Commits

Peter Bex committed a87bd2e

Implement run/file*, which is really weird

Comments (0)

Files changed (2)

     (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)
 
     (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"))