~ chicken-core (chicken-5) 954b62ad0a6609ef034aa6c4ab1dc62185c47476
commit 954b62ad0a6609ef034aa6c4ab1dc62185c47476
Author: Peter Bex <peter@more-magic.net>
AuthorDate: Fri Feb 7 10:38:23 2025 +0100
Commit: Peter Bex <peter@more-magic.net>
CommitDate: Fri Feb 7 10:38:23 2025 +0100
Fix bug in process(*) auto-wait on closing of all pipes; simplify
The code in make-on-close that would call process-wait-impl after all
pipes of a subprocess are closed was basically a duplicate of what
happens in process-wait, except it had a bug - it would set the
process' exit-status field to the same value as the returned-normally?
field.
We could fix this by fixing the code here, but it's simpler to just
call chicken.process#process-wait instead. While at it, pass the
process object to make-on-close instead of the pid, to avoid an extra
unnecessary lookup of the child.
The (input-port) and (output-port) helpers accepted a pid argument
which they didn't use; drop it.
diff --git a/posixunix.scm b/posixunix.scm
index a9ca355e..f329dada 100644
--- a/posixunix.scm
+++ b/posixunix.scm
@@ -1208,18 +1208,12 @@ static int set_file_mtime(C_word filename, C_word atime, C_word mtime)
(chicken.file.posix#duplicate-fileno fd stdfd)
(chicken.file.posix#file-close fd) ) )) )
(let ((make-on-close
- (lambda (loc pid clsvec idx idxa idxb)
+ (lambda (loc proc clsvec idx idxa idxb)
(lambda ()
(vector-set! clsvec idx #t)
(when (and (vector-ref clsvec idxa) (vector-ref clsvec idxb))
- (receive (_ flg cod) (process-wait-impl pid #f)
- (and-let* ((a (assq pid children)))
- (process-returned-normally?-set! (cdr a) flg)
- (process-exit-status-set! (cdr a) flg)
- (drop-child pid))
- (unless flg
- (##sys#signal-hook #:process-error loc
- "abnormal process exit" pid cod)) ) ) ) ))
+ (chicken.process#process-wait proc #f) )
+ (void)) ))
(needed-pipe
(lambda (loc port)
(and port
@@ -1256,11 +1250,11 @@ static int set_file_mtime(C_word filename, C_word atime, C_word mtime)
(connect-child loc (swapped-ends epipe) stderrf chicken.file.posix#fileno/stderr)
(chicken.process#process-execute cmd args env)))) ) ) ))
[input-port
- (lambda (loc pid cmd pipe stdf stdfd on-close enc)
+ (lambda (loc cmd pipe stdf stdfd on-close enc)
(and-let* ([fd (connect-parent loc pipe stdf stdfd)])
(##sys#custom-input-port loc cmd fd #t DEFAULT-INPUT-BUFFER-SIZE on-close #f enc) ) )]
[output-port
- (lambda (loc pid cmd pipe stdf stdfd on-close enc)
+ (lambda (loc cmd pipe stdf stdfd on-close enc)
(and-let* ([fd (connect-parent loc pipe stdf stdfd)])
(##sys#custom-output-port loc cmd fd #t DEFAULT-OUTPUT-BUFFER-SIZE on-close enc) ) )] )
(lambda (loc cmd args env stdoutf stdinf stderrf enc)
@@ -1269,22 +1263,21 @@ static int set_file_mtime(C_word filename, C_word atime, C_word mtime)
;When shared assume already "closed", since only created ports
;should be explicitly closed, and when one is closed we want
;to wait.
- (let ((clsvec (vector (not stdinf) (not stdoutf) (not stderrf)))
- (pid (process-id proc)))
+ (let ((clsvec (vector (not stdinf) (not stdoutf) (not stderrf))))
(process-output-port-set! proc
- (input-port loc pid cmd inpipe stdinf
+ (input-port loc cmd inpipe stdinf
chicken.file.posix#fileno/stdin
- (make-on-close loc pid clsvec 0 1 2)
+ (make-on-close loc proc clsvec 0 1 2)
enc))
(process-input-port-set! proc
- (output-port loc pid cmd outpipe stdoutf
+ (output-port loc cmd outpipe stdoutf
chicken.file.posix#fileno/stdout
- (make-on-close loc pid clsvec 1 0 2)
+ (make-on-close loc proc clsvec 1 0 2)
enc))
(process-error-port-set! proc
- (input-port loc pid cmd errpipe stderrf
+ (input-port loc cmd errpipe stderrf
chicken.file.posix#fileno/stderr
- (make-on-close loc pid clsvec 2 0 1)
+ (make-on-close loc proc clsvec 2 0 1)
enc) )
proc) ) ) ) ) ) )
Trap