scsh-conservatory
/
commander-s
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Care about closing copied file-descriptor/ports in parent and child of 

RUN/FG*.
This commit is contained in:
eknauel 2005-08-11 15:18:25 +00:00
parent 843ed0493b
commit 8eedb14ef3
1 changed files with 6 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
scheme/job.scm
View File

@ -330,23 +330,23 @@
(proc (proc
(fork (fork
(lambda () (lambda ()
;; this a forked child
(close-input-port rport)
(set-process-group (pid) (pid)) (set-process-group (pid) (pid))
(set-tty-process-group (current-output-port) (pid)) (set-tty-process-group (current-output-port) (pid))
(let ((status (eval-s-expr s-expr))) (let ((status (eval-s-expr s-expr)))
;; I don't understand it. Send list, will work. (write status wport)
;; Send integer, READ will sit there and wait for ever.
;; Sigh.
(write (list status) wport)
(close-output-port wport) (close-output-port wport)
;; We can't call EXIT with a scsh encoded status code, ;; We can't call EXIT with a scsh encoded status code,
;; because the value does not fit into a byte. Sigh. ;; because the value does not fit into a byte. Sigh.
;; Send value over pipe instead. ;; Send value over pipe instead.
(exit 0)))))) (exit 0))))))
(close-output-port wport)
(let* ((job (make-job-sans-console (let* ((job (make-job-sans-console
s-expr proc s-expr proc
;; truely evil, I think. ;; truely evil, I think.
(lambda (ignore) (lambda (ignore)
(let ((v (car (read rport)))) ;; see above (let ((v (read rport)))
(close-input-port rport) (close-input-port rport)
v)))) v))))
(status (job-status job))) (status (job-status job)))