suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix `subprocess-status' when places are enabled

Browse Source 
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
collects/tests/racket/subprocess.rktl
View File

@ -413,15 +413,13 @@
"-e"
"(let loop () (loop))"))]
[running? (lambda (sub-pid)
(equal?
(list (number->string sub-pid))
(regexp-match
(format "(?m:^ *~a(?=[^0-9]))" sub-pid)
(let ([s (open-output-string)])
(parameterize ([current-output-port s]
[current-input-port (open-input-string "")])
(system (format "ps x")))
(get-output-string s)))))])
(regexp-match?
(format "(?m:^ *~a(?=[^0-9]))" sub-pid)
(let ([s (open-output-string)])
(parameterize ([current-output-port s]
[current-input-port (open-input-string "")])
(system (format "ps x")))
(get-output-string s))))])
(let ([sub-pid (read (car l))])
(test 'running (list-ref l 4) 'status)
(test #t running? sub-pid)
@ -436,6 +434,13 @@
(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)

4
src/racket/src/place.c
View File

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

23
src/racket/src/port.c
View File

@ -7448,14 +7448,7 @@ static void check_child_done(pid_t pid)
unused = (void **)next;
}
START_XFORM_SKIP;
if (WIFEXITED(status))
status = WEXITSTATUS(status);
else if (WIFSIGNALED(status))
status = WTERMSIG(status) + 128;
else
status = MZ_FAILURE_STATUS;
END_XFORM_SKIP;
status = scheme_extract_child_status(status);
prev = NULL;
for (sc = scheme_system_children; sc; prev = sc, sc = sc->next) {
@ -7489,6 +7482,20 @@ void scheme_check_child_done(void)
#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 */
/*========================================================================*/

1
src/racket/src/schpriv.h
View File

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