Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-19 13:49:17 +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

18
lib/chibi/process.scm
View file

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