In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/9afd62035da781127f09672a85cd363e6aecc44f?hp=b932b26697523f5576f3c2608445dfafe32b8832>
- Log ----------------------------------------------------------------- commit 9afd62035da781127f09672a85cd363e6aecc44f Author: Steve Hay <[email protected]> Date: Tue Sep 18 17:48:11 2012 +0100 Minor fixups from 001e9f8966 M pod/perldelta.pod M pod/perlport.pod M win32/win32.c commit 001e9f8966c22ce5f6e43f663bffdffb73bf623c Author: Daniel Dragan <[email protected]> Date: Tue Sep 18 04:17:21 2012 -0400 fix over/underflow issues in win32_msgwait This commit does not completely fix 33096, since the real problem is that VS IDE's debugger causes a Windows message to be sent to perl on each breakpoint. Depending on where the breakpoint was set. The BP may make it impossible to exit the loop because of the Visual Studio IDE Debugger's design. Various overflow and underflow issues were fixed in win32_msgwait. Specifically, the time count rolling forwards through zero (GetSystemTimeAsFileTime), and the time count running ahead of the end time (rolling backwards through zero) were fixed ("<=" check). M pod/perldelta.pod M pod/perlport.pod M win32/win32.c ----------------------------------------------------------------------- Summary of changes: pod/perldelta.pod | 3 +++ pod/perlport.pod | 4 ++++ win32/win32.c | 46 +++++++++++++++++++++++++++++++++++----------- 3 files changed, 42 insertions(+), 11 deletions(-) diff --git a/pod/perldelta.pod b/pod/perldelta.pod index 7d3ef03..e698041 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -643,6 +643,9 @@ Fixed a problem where perl could crash while cleaning up threads (including the main thread) in threaded debugging builds on Win32 and possibly other platforms [perl #114496]. +A rare race condition that would lead to L<sleep|perlfunc/sleep> taking more +time than requested, and possibly even hanging, has been fixed [perl #33096]. + =item Solaris In Configure, avoid running sed commands with flags not supported on Solaris. diff --git a/pod/perlport.pod b/pod/perlport.pod index a37bc7c..6be7487 100644 --- a/pod/perlport.pod +++ b/pod/perlport.pod @@ -1921,6 +1921,10 @@ Not implemented. (S<Plan 9>) Not implemented. (Win32, VMS, S<RISC OS>, VOS) +=item sleep + +Limited to a maximum of 4294967 seconds, approximately 49 days. (Win32) + =item sockatmark A relatively recent addition to socket functions, may not diff --git a/win32/win32.c b/win32/win32.c index c2ad58f..0a13ecd 100644 --- a/win32/win32.c +++ b/win32/win32.c @@ -2217,13 +2217,33 @@ DllExport DWORD win32_msgwait(pTHX_ DWORD count, LPHANDLE handles, DWORD timeout, LPDWORD resultp) { /* We may need several goes at this - so compute when we stop */ - DWORD ticks = 0; + FT_t ticks = {0}; + unsigned __int64 endtime = timeout; if (timeout != INFINITE) { - ticks = GetTickCount(); - timeout += ticks; - } - while (1) { - DWORD result = MsgWaitForMultipleObjects(count,handles,FALSE,timeout-ticks, QS_POSTMESSAGE|QS_TIMER|QS_SENDMESSAGE); + GetSystemTimeAsFileTime(&ticks.ft_val); + ticks.ft_i64 /= 10000; + endtime += ticks.ft_i64; + } + /* This was a race condition. Do not let a non INFINITE timeout to + * MsgWaitForMultipleObjects roll under 0 creating a near + * infinity/~(UINT32)0 timeout which will appear as a deadlock to the + * user who did a CORE perl function with a non infinity timeout, + * sleep for example. This is 64 to 32 truncation minefield. + * + * This scenario can only be created if the timespan from the return of + * MsgWaitForMultipleObjects to GetSystemTimeAsFileTime exceeds 1 ms. To + * generate the scenario, manual breakpoints in a C debugger are required, + * or a context switch occured in win32_async_check in PeekMessage, or random + * messages are delivered to the *thread* message queue of the Perl thread + * from another process (msctf.dll doing IPC among its instances, VS debugger + * causes msctf.dll to be loaded into Perl by kernel), see [perl #33096]. + */ + while (ticks.ft_i64 <= endtime) { + /* if timeout's type is lengthened, remember to split 64b timeout + * into multiple non-infinity runs of MWFMO */ + DWORD result = MsgWaitForMultipleObjects(count, handles, FALSE, + (DWORD)(endtime - ticks.ft_i64), + QS_POSTMESSAGE|QS_TIMER|QS_SENDMESSAGE); if (resultp) *resultp = result; if (result == WAIT_TIMEOUT) { @@ -2233,8 +2253,9 @@ win32_msgwait(pTHX_ DWORD count, LPHANDLE handles, DWORD timeout, LPDWORD result return 0; } if (timeout != INFINITE) { - ticks = GetTickCount(); - } + GetSystemTimeAsFileTime(&ticks.ft_val); + ticks.ft_i64 /= 10000; + } if (result == WAIT_OBJECT_0 + count) { /* Message has arrived - check it */ (void)win32_async_check(aTHX); @@ -2244,10 +2265,13 @@ win32_msgwait(pTHX_ DWORD count, LPHANDLE handles, DWORD timeout, LPDWORD result break; } } - /* compute time left to wait */ - ticks = timeout - ticks; /* If we are past the end say zero */ - return (ticks > 0) ? ticks : 0; + if (!ticks.ft_i64 || ticks.ft_i64 > endtime) + return 0; + /* compute time left to wait */ + ticks.ft_i64 = endtime - ticks.ft_i64; + /* if more ms than DWORD, then return max DWORD */ + return ticks.ft_i64 <= UINT_MAX ? (DWORD)ticks.ft_i64 : UINT_MAX; } int -- Perl5 Master Repository
