X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=win32%2Fwin32.c;h=7c0af0f11d71e929e22a14d0473ff9537b0de523;hb=f3c90b3644a4d1b01ee1a6fe678bc1357e85a56a;hp=41b70454999961d056cb63628cf0fc7aa23da2f6;hpb=44221b20e58d7d2e060f57de5d83fc6fb49337bd;p=p5sagit%2Fp5-mst-13.2.git diff --git a/win32/win32.c b/win32/win32.c index 41b7045..7c0af0f 100644 --- a/win32/win32.c +++ b/win32/win32.c @@ -1167,10 +1167,13 @@ win32_stat(const char *path, Stat_t *sbuf) char buffer[MAX_PATH+1]; int l = strlen(path); int res; - HANDLE handle; int nlink = 1; BOOL expect_dir = FALSE; + GV *gv_sloppy = gv_fetchpvs("\027IN32_SLOPPY_STAT", + GV_NOTQUAL, SVt_PV); + BOOL sloppy = gv_sloppy && SvTRUE(GvSV(gv_sloppy)); + if (l > 1) { switch(path[l - 1]) { /* FindFirstFile() and stat() are buggy with a trailing @@ -1208,17 +1211,20 @@ win32_stat(const char *path, Stat_t *sbuf) } } - /* We *must* open & close the file once; otherwise file attribute changes */ - /* might not yet have propagated to "other" hard links of the same file. */ - /* This also gives us an opportunity to determine the number of links. */ path = PerlDir_mapA(path); l = strlen(path); - handle = CreateFileA(path, 0, 0, NULL, OPEN_EXISTING, 0, NULL); - if (handle != INVALID_HANDLE_VALUE) { - BY_HANDLE_FILE_INFORMATION bhi; - if (GetFileInformationByHandle(handle, &bhi)) - nlink = bhi.nNumberOfLinks; - CloseHandle(handle); + + if (!sloppy) { + /* We must open & close the file once; otherwise file attribute changes */ + /* might not yet have propagated to "other" hard links of the same file. */ + /* This also gives us an opportunity to determine the number of links. */ + HANDLE handle = CreateFileA(path, 0, 0, NULL, OPEN_EXISTING, 0, NULL); + if (handle != INVALID_HANDLE_VALUE) { + BY_HANDLE_FILE_INFORMATION bhi; + if (GetFileInformationByHandle(handle, &bhi)) + nlink = bhi.nNumberOfLinks; + CloseHandle(handle); + } } /* path will be mapped correctly above */ @@ -1778,8 +1784,19 @@ win32_async_check(pTHX) w32_poll_count = 0; - if (hwnd == INVALID_HANDLE_VALUE) + if (hwnd == INVALID_HANDLE_VALUE) { + /* Call PeekMessage() to mark all pending messages in the queue as "old". + * This is necessary when we are being called by win32_msgwait() to + * make sure MsgWaitForMultipleObjects() stops reporting the same waiting + * message over and over. An example how this can happen is when + * Perl is calling win32_waitpid() inside a GUI application and the GUI + * is generating messages before the process terminated. + */ + PeekMessage(&msg, NULL, 0, 0, PM_NOREMOVE|PM_NOYIELD); + if (PL_sig_pending) + despatch_signals(); return 1; + } /* Passing PeekMessage -1 as HWND (2nd arg) only get PostThreadMessage() messages * and ignores window messages - should co-exist better with windows apps e.g. Tk @@ -2803,6 +2820,7 @@ win32_pclose(PerlIO *pf) childpid = 0; if (!childpid) { + UNLOCK_FDPID_MUTEX; errno = EBADF; return -1; } @@ -4856,6 +4874,7 @@ Perl_win32_init(int *argcp, char ***argvp) void Perl_win32_term(void) { + HINTS_REFCNT_TERM; OP_REFCNT_TERM; MALLOC_TERM; }