call-with-process-io should terminate if execute returns (i.e. fails)

This commit is contained in:
Alex Shinn 2015-04-23 18:14:33 +09:00
parent 1027b424c2
commit 28011727e4

View file

@ -54,19 +54,22 @@
(else x)))
(execvp (->string cmd) (map ->string args)))
(define (system cmd . args)
(let ((pid (fork)))
(cond
((zero? pid)
(let* ((res (execute cmd (cons cmd args)))
(err (current-error-port)))
(define (execute-returned cmd)
;; we only arrive here if execute fails
(let ((err (current-error-port)))
(cond
((output-port? err)
(display "ERROR: couldn't execute: " (current-error-port))
(write cmd (current-error-port))
(newline (current-error-port))))
(exit 1)))
(define (system cmd . args)
(let ((pid (fork)))
(cond
((zero? pid)
(execute cmd (cons cmd args))
(execute-returned cmd))
(else
(waitpid pid 0)))))
@ -98,7 +101,8 @@
(close-file-descriptor (car in-pipe))
(close-file-descriptor (cadr out-pipe))
(close-file-descriptor (cadr err-pipe))
(execute (car command-ls) command-ls))
(execute (car command-ls) command-ls)
(execute-returned command-ls))
(else ;; parent
(close-file-descriptor (car in-pipe))
(close-file-descriptor (cadr out-pipe))