fix `subprocess-status' when places are enabled

Closes PR 12158
This commit is contained in:
Matthew Flatt 2011-09-04 15:40:15 -06:00
parent fd0a2e9879
commit ee6104b4fc
4 changed files with 32 additions and 19 deletions

View File

@ -413,15 +413,13 @@
"-e" "-e"
"(let loop () (loop))"))] "(let loop () (loop))"))]
[running? (lambda (sub-pid) [running? (lambda (sub-pid)
(equal? (regexp-match?
(list (number->string sub-pid))
(regexp-match
(format "(?m:^ *~a(?=[^0-9]))" sub-pid) (format "(?m:^ *~a(?=[^0-9]))" sub-pid)
(let ([s (open-output-string)]) (let ([s (open-output-string)])
(parameterize ([current-output-port s] (parameterize ([current-output-port s]
[current-input-port (open-input-string "")]) [current-input-port (open-input-string "")])
(system (format "ps x"))) (system (format "ps x")))
(get-output-string s)))))]) (get-output-string s))))])
(let ([sub-pid (read (car l))]) (let ([sub-pid (read (car l))])
(test 'running (list-ref l 4) 'status) (test 'running (list-ref l 4) 'status)
(test #t running? sub-pid) (test #t running? sub-pid)
@ -436,6 +434,13 @@
(try #f))) (try #f)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Check status result
(unless (eq? (system-type) 'windows)
(parameterize ([current-input-port (open-input-string "")])
(test 3 system/exit-code "exit 3")))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(report-errs) (report-errs)

View File

@ -517,7 +517,7 @@ int scheme_get_child_status(int pid, int is_group, int *status) {
} while ((pid2 == -1) && (errno == EINTR)); } while ((pid2 == -1) && (errno == EINTR));
if (pid2 > 0) if (pid2 > 0)
add_child_status(pid, status); add_child_status(pid, scheme_extract_child_status(status));
} }
mzrt_mutex_lock(child_status_lock); mzrt_mutex_lock(child_status_lock);
@ -631,7 +631,7 @@ static void *mz_proc_thread_signal_worker(void *data) {
free(unused_status); free(unused_status);
unused_status = next; unused_status = next;
} else } else
add_child_status(pid, status); add_child_status(pid, scheme_extract_child_status(status));
} else { } else {
if (is_group) { if (is_group) {
prev_unused = unused_status; prev_unused = unused_status;

View File

@ -7448,14 +7448,7 @@ static void check_child_done(pid_t pid)
unused = (void **)next; unused = (void **)next;
} }
START_XFORM_SKIP; status = scheme_extract_child_status(status);
if (WIFEXITED(status))
status = WEXITSTATUS(status);
else if (WIFSIGNALED(status))
status = WTERMSIG(status) + 128;
else
status = MZ_FAILURE_STATUS;
END_XFORM_SKIP;
prev = NULL; prev = NULL;
for (sc = scheme_system_children; sc; prev = sc, sc = sc->next) { for (sc = scheme_system_children; sc; prev = sc, sc = sc->next) {
@ -7489,6 +7482,20 @@ void scheme_check_child_done(void)
#endif #endif
#if defined(UNIX_PROCESSES)
int scheme_extract_child_status(int status) XFORM_SKIP_PROC
{
if (WIFEXITED(status))
status = WEXITSTATUS(status);
else if (WIFSIGNALED(status))
status = WTERMSIG(status) + 128;
else
status = MZ_FAILURE_STATUS;
return status;
}
#endif
/*========================================================================*/ /*========================================================================*/
/* null output ports */ /* null output ports */
/*========================================================================*/ /*========================================================================*/

View File

@ -514,6 +514,7 @@ void scheme_kickoff_green_thread_time_slice_timer(intptr_t usec);
#ifdef UNIX_PROCESSES #ifdef UNIX_PROCESSES
void scheme_block_child_signals(int block); void scheme_block_child_signals(int block);
void scheme_check_child_done(void); void scheme_check_child_done(void);
int scheme_extract_child_status(int status);
#endif #endif
void scheme_prepare_this_thread_for_GC(Scheme_Thread *t); void scheme_prepare_this_thread_for_GC(Scheme_Thread *t);