Fix ocamltest process termination on Windows

On Windows, a process can become signalled even if child processes it
spawned are still running. Fix this by creating the proces in a job object
and using an I/O completion port to detect when there are no processes
left running in the job.
master
David Allsopp 2018-04-26 14:39:05 +01:00
parent 1fe12abaf3
commit ea0fc8ac26
2 changed files with 50 additions and 9 deletions

View File

@ -41,6 +41,9 @@ Working version
ignored when used on streams based on input channels.
(Nicolás Ojeda Bär, report by Michael Perin, review by Gabriel Scherer)
- GPR#1739: ensure ocamltest waits for child processes to terminate on Windows
(David Allsopp, review by Sébastien Hinderer)
OCaml 4.07
----------

View File

@ -256,9 +256,16 @@ int run_command(const command_settings *settings)
LPCWSTR current_directory = NULL;
STARTUPINFO startup_info;
PROCESS_INFORMATION process_info;
DWORD wait_result, status;
BOOL wait_result;
DWORD status, stamp, cur;
DWORD timeout = (settings->timeout > 0) ? settings->timeout * 1000 : INFINITE;
JOBOBJECT_ASSOCIATE_COMPLETION_PORT port = {NULL, NULL};
HANDLE hJob = NULL;
DWORD completion_code;
ULONG_PTR completion_key;
LPOVERLAPPED pOverlapped;
ZeroMemory(&startup_info, sizeof(STARTUPINFO));
startup_info.cb = sizeof(STARTUPINFO);
startup_info.dwFlags = STARTF_USESTDHANDLES;
@ -328,7 +335,7 @@ int run_command(const command_settings *settings)
NULL, /* SECURITY_ATTRIBUTES process_attributes */
NULL, /* SECURITY_ATTRIBUTES thread_attributes */
TRUE, /* BOOL inherit_handles */
CREATE_UNICODE_ENVIRONMENT, /* DWORD creation_flags */
CREATE_SUSPENDED | CREATE_UNICODE_ENVIRONMENT, /* DWORD creation_flags */
environment,
NULL, /* LPCSTR current_directory */
&startup_info,
@ -336,23 +343,52 @@ int run_command(const command_settings *settings)
);
checkerr( (! process_created), "CreateProcess failed", NULL);
CloseHandle(process_info.hThread); /* Not needed so closed ASAP */
hJob = CreateJobObject(NULL, NULL);
checkerr( (hJob == NULL), "CreateJobObject failed", NULL);
checkerr( !AssignProcessToJobObject(hJob, process_info.hProcess),
"AssignProcessToJob failed", NULL);
port.CompletionPort =
CreateIoCompletionPort(INVALID_HANDLE_VALUE, NULL, 0, 0);
checkerr( (port.CompletionPort == NULL),
"CreateIoCompletionPort failed", NULL);
checkerr( !SetInformationJobObject(
hJob,
JobObjectAssociateCompletionPortInformation,
&port, sizeof(port)), "SetInformationJobObject failed", NULL);
wait_result = WaitForSingleObject(process_info.hProcess, timeout);
if (wait_result == WAIT_OBJECT_0)
ResumeThread(process_info.hThread);
CloseHandle(process_info.hThread);
stamp = GetTickCount();
while ((wait_result = GetQueuedCompletionStatus(port.CompletionPort,
&completion_code,
&completion_key,
&pOverlapped,
timeout))
&& completion_code != JOB_OBJECT_MSG_ACTIVE_PROCESS_ZERO)
{
if (timeout != INFINITE)
{
cur = GetTickCount();
stamp = (cur > stamp ? cur - stamp : MAXDWORD - stamp + cur);
timeout = (timeout > stamp ? timeout - stamp : 0);
stamp = cur;
}
}
if (wait_result)
{
/* The child has terminated before the timeout has expired */
checkerr( (! GetExitCodeProcess(process_info.hProcess, &status)),
"GetExitCodeProcess failed", NULL);
} else if (wait_result == WAIT_TIMEOUT) {
} else if (pOverlapped == NULL) {
/* The timeout has expired, terminate the process */
checkerr( (! TerminateProcess(process_info.hProcess, 0)),
"TerminateProcess failed", NULL);
checkerr( (! TerminateJobObject(hJob, 0)),
"TerminateJob failed", NULL);
status = -1;
wait_again = 1;
} else {
error_with_location(__FILE__, __LINE__, settings,
"WaitForSingleObject failed\n");
"GetQueuedCompletionStatus failed\n");
report_error(__FILE__, __LINE__,
settings, "Failure while waiting for process termination", NULL);
status = -1;
@ -370,5 +406,7 @@ cleanup:
WaitForSingleObject(process_info.hProcess, 1000);
}
if (process_created) CloseHandle(process_info.hProcess);
if (hJob != NULL) CloseHandle(hJob);
if (port.CompletionPort != NULL) CloseHandle(port.CompletionPort);
return status;
}