Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-19 05:39:18 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

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

Browse source
This commit is contained in:
Alex Shinn 2015-04-23 18:14:33 +09:00
parent 1027b424c2
commit 28011727e4
1 changed files with 14 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

24
lib/chibi/process.scm
View file

@ -54,19 +54,22 @@
(else x)))
(execvp (->string cmd) (map ->string args)))
(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)
(let* ((res (execute cmd (cons cmd args)))
(err (current-error-port)))
;; we only arrive here if execute fails
(cond
((output-port? err)
(display "ERROR: couldn't execute: " (current-error-port))
(write cmd (current-error-port))
(newline (current-error-port))))
(exit 1)))
(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))