~ chicken-core (chicken-5) 8de39231faec76e0eb76e661c6e32e1e1c3454af

commit 8de39231faec76e0eb76e661c6e32e1e1c3454af
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Tue Jan 28 10:39:26 2025 +0100
Commit:     Peter Bex <peter@more-magic.net>
CommitDate: Thu Feb 6 10:40:27 2025 +0100

    Clean up process-wait return value handling; use epid for drop-child
    
    There are three cases: either there's an error (epid = -1), there's no
    child to wait for (epid = 0, if nohang was #t), or we successfully
    awaited a child (epid > 0).  The original code was a bit messy and
    also didn't handle the nohang situation correctly because it would
    set the exit status and returned normally in the process struct if
    it was passed in.  By putting the conditionals into three separate
    branches, it is much clearer what the situations are.
    
    Also, there was a bug when "proc" would be #f (wait for the next
    child, whichever it is).  In that case, we would use the fallback
    for get-pid (i.e, -1) to look up in the list of children, which means
    we wouldn't fill in the correct struct.  Instead, use "epid", the
    returned value which represents the process we just reaped.  This
    would also be a memory leak because that child would never be dropped
    from the list because the (unless proc ...) would only ever be called
    when proc is #f, and therefore would always call (drop-child -1).
    
    Finally, fix types.db return value types: the second
    value (representing whether the child returned normally) is a boolean,
    not a fixnum.  The third value is a fixnum, but may also be false when
    nohang is supplied and there's nothing to wait for.

diff --git a/posix-common.scm b/posix-common.scm
index 2935ff3c..c888a108 100644
--- a/posix-common.scm
+++ b/posix-common.scm
@@ -715,25 +715,29 @@ EOF
 (set! chicken.process#process-wait
   (lambda args
     (let-optionals* args ((proc #f) (nohang #f))
-      (if (and proc (process? proc) (process-exit-status proc))
+      (if (and (process? proc) (process-exit-status proc))
           (values (process-id proc)
                   (process-returned-normally? proc)
                   (process-exit-status proc))
           (let ((pid (get-pid proc -1)))
             (##sys#check-fixnum pid 'process-wait)
             (receive (epid enorm ecode) (process-wait-impl pid nohang)
-              (unless proc
-                (let ((a (assq pid children)))
-                  (when a
-                    (set! proc (cdr a))
-                    (drop-child pid))))
-              (when (process? proc)
-                (process-returned-normally?-set! proc enorm)
-                (process-exit-status-set! proc ecode))
-              (if (fx= epid -1)
-                  (posix-error #:process-error 'process-wait
-                               "waiting for child process failed" pid)
-                  (values epid enorm ecode) ) ) )) ) ) )
+              (cond
+               ((fx= epid -1)
+                (posix-error #:process-error 'process-wait
+                             "waiting for child process failed" pid))
+               ((fx= epid 0)
+                (values 0 #f #f))
+               (else
+                (unless (process? proc)
+                  (let ((a (assq epid children)))
+                    (when a
+                      (set! proc (cdr a))
+                      (drop-child epid))))
+                (when (process? proc)
+                  (process-returned-normally?-set! proc enorm)
+                  (process-exit-status-set! proc ecode))
+                (values epid enorm ecode))) ) )) ) ) )
 
 ;; This can construct argv or envp for process-execute or process-run
 (define list->c-string-buffer
diff --git a/types.db b/types.db
index 79e5071f..0ba17ce2 100644
--- a/types.db
+++ b/types.db
@@ -2178,7 +2178,7 @@
 (chicken.process#system* (#(procedure #:clean #:enforce) chicken.process#system* (string) undefined))
 (chicken.process#process (#(procedure #:clean #:enforce) chicken.process#process (string #!optional (list-of string) (list-of (pair string string)) symbol boolean) (struct process)))
 (chicken.process#process* (#(procedure #:clean #:enforce) chicken.process#process* (string #!optional (list-of string) (list-of (pair string string)) symbol boolean) (struct process)))
-(chicken.process#process-wait (#(procedure #:clean #:enforce) chicken.process#process-wait (#!optional (or (struct process) fixnum) *) fixnum fixnum fixnum))
+(chicken.process#process-wait (#(procedure #:clean #:enforce) chicken.process#process-wait (#!optional (or (struct process) fixnum) *) fixnum boolean (or fixnum false)))
 (chicken.process#process-sleep (#(procedure #:clean #:enforce) chicken.process#process-sleep (fixnum) fixnum))
 (chicken.process#process-exit-status (#(procedure #:clean #:enforce) chicken.process#process-exit-status ((struct process)) *))
 (chicken.process#process-input-port (#(procedure #:clean #:enforce) chicken.process#process-input-port ((struct process)) output-port))