The compilation of PerlIO::via may hang on AIX when
[p5sagit/p5-mst-13.2.git] / win32 / win32.c
index 083e98e..4d8a621 100644 (file)
@@ -1067,6 +1067,7 @@ win32_kill(int pid, int sig)
     dTHX;
     HANDLE hProcess;
     long child;
+    int retval;
 #ifdef USE_ITHREADS
     if (pid < 0) {
        /* it is a pseudo-forked child */
@@ -1114,6 +1115,11 @@ win32_kill(int pid, int sig)
                if (GenerateConsoleCtrlEvent(CTRL_C_EVENT,pid))
                    return 0;
                break;
+            case SIGBREAK:
+            case SIGTERM:
+                if (GenerateConsoleCtrlEvent(CTRL_BREAK_EVENT,pid))
+                    return 0;
+                break;
            default: /* For now be backwards compatible with perl5.6 */
            case 9:
                if (TerminateProcess(hProcess, sig)) {
@@ -1125,25 +1131,34 @@ win32_kill(int pid, int sig)
        }
        else {
 alien_process:
+            retval = -1;
            hProcess = OpenProcess(PROCESS_ALL_ACCESS, TRUE,
                                   (IsWin95() ? -pid : pid));
            if (hProcess) {
                switch(sig) {
                case 0:
                    /* "Does process exist?" use of kill */
-                   return 0;
+                   retval = 0;
+                    break;
                case 2:
                    if (GenerateConsoleCtrlEvent(CTRL_C_EVENT,pid))
-                       return 0;
+                       retval = 0;
                    break;
+                case SIGBREAK:
+                case SIGTERM:
+                    if (GenerateConsoleCtrlEvent(CTRL_BREAK_EVENT,pid))
+                       retval = 0;
+                    break;
                default: /* For now be backwards compatible with perl5.6 */
                 case 9:
-                   if (TerminateProcess(hProcess, sig)) {
-                       CloseHandle(hProcess);
-                       return 0;
-                   }
+                   if (TerminateProcess(hProcess, sig))
+                       retval = 0;
+                    break;
                }
            }
+            CloseHandle(hProcess);
+            if (retval == 0)
+                return 0;
        }
     }
     errno = EINVAL;
@@ -1884,10 +1899,12 @@ win32_async_check(pTHX)
 
        case WM_TIMER: {
            /* alarm() is a one-shot but SetTimer() repeats so kill it */
-           if (w32_timerid) {
+           if (w32_timerid && w32_timerid==msg.wParam) {
                KillTimer(NULL,w32_timerid);
                w32_timerid=0;
            }
+            else
+               goto FallThrough;
            /* Now fake a call to signal handler */
            if (do_raise(aTHX_ 14)) {
                sig_terminate(aTHX_ 14);
@@ -1897,6 +1914,7 @@ win32_async_check(pTHX)
 
        /* Otherwise do normal Win32 thing - in case it is useful */
        default:
+       FallThrough:
            TranslateMessage(&msg);
            DispatchMessage(&msg);
            ours = 0;
@@ -2079,6 +2097,7 @@ alien_process:
            if (hProcess) {
                win32_msgwait(aTHX_ 1, &hProcess, timeout, &waitcode);
                if (waitcode == WAIT_TIMEOUT) {
+                    CloseHandle(hProcess);
                    return 0;
                }
                else if (waitcode == WAIT_OBJECT_0) {
@@ -4499,26 +4518,68 @@ static
 XS(w32_GetOSVersion)
 {
     dXSARGS;
-    OSVERSIONINFOA osver;
+    /* Use explicit struct definition because wSuiteMask and
+     * wProductType are not defined in the VC++ 6.0 headers.
+     * WORD type has been replaced by unsigned short because
+     * WORD is already used by Perl itself.
+     */
+    struct {
+        DWORD dwOSVersionInfoSize;
+        DWORD dwMajorVersion;
+        DWORD dwMinorVersion;
+        DWORD dwBuildNumber;
+        DWORD dwPlatformId;
+        CHAR  szCSDVersion[128];
+        unsigned short wServicePackMajor;
+        unsigned short wServicePackMinor;
+        unsigned short wSuiteMask;
+        BYTE  wProductType;
+        BYTE  wReserved;
+    }   osver;
+    BOOL bEx = TRUE;
 
     if (USING_WIDE()) {
-       OSVERSIONINFOW osverw;
+        struct {
+            DWORD dwOSVersionInfoSize;
+            DWORD dwMajorVersion;
+            DWORD dwMinorVersion;
+            DWORD dwBuildNumber;
+            DWORD dwPlatformId;
+            WCHAR szCSDVersion[128];
+            unsigned short wServicePackMajor;
+            unsigned short wServicePackMinor;
+            unsigned short wSuiteMask;
+            BYTE  wProductType;
+            BYTE  wReserved;
+        } osverw;
        char szCSDVersion[sizeof(osverw.szCSDVersion)];
-       osverw.dwOSVersionInfoSize = sizeof(OSVERSIONINFOW);
-       if (!GetVersionExW(&osverw)) {
-           XSRETURN_EMPTY;
+       osverw.dwOSVersionInfoSize = sizeof(osverw);
+       if (!GetVersionExW((OSVERSIONINFOW*)&osverw)) {
+            bEx = FALSE;
+            osverw.dwOSVersionInfoSize = sizeof(OSVERSIONINFOW);
+            if (!GetVersionExW((OSVERSIONINFOW*)&osverw)) {
+                XSRETURN_EMPTY;
+            }
        }
        W2AHELPER(osverw.szCSDVersion, szCSDVersion, sizeof(szCSDVersion));
        XPUSHs(newSVpvn(szCSDVersion, strlen(szCSDVersion)));
-       osver.dwMajorVersion = osverw.dwMajorVersion;
-       osver.dwMinorVersion = osverw.dwMinorVersion;
-       osver.dwBuildNumber = osverw.dwBuildNumber;
-       osver.dwPlatformId = osverw.dwPlatformId;
+        osver.dwMajorVersion    = osverw.dwMajorVersion;
+        osver.dwMinorVersion    = osverw.dwMinorVersion;
+        osver.dwBuildNumber     = osverw.dwBuildNumber;
+        osver.dwPlatformId      = osverw.dwPlatformId;
+        osver.wServicePackMajor = osverw.wServicePackMajor;
+        osver.wServicePackMinor = osverw.wServicePackMinor;
+        osver.wSuiteMask        = osverw.wSuiteMask;
+        osver.wProductType      = osverw.wProductType;
     }
     else {
-       osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFOA);
-       if (!GetVersionExA(&osver)) {
-           XSRETURN_EMPTY;
+       osver.dwOSVersionInfoSize = sizeof(osver);
+       if (!GetVersionExA((OSVERSIONINFOA*)&osver)) {
+            bEx = FALSE;
+            osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFOA);
+            if (!GetVersionExA((OSVERSIONINFOA*)&osver)) {
+                XSRETURN_EMPTY;
+            }
        }
        XPUSHs(newSVpvn(osver.szCSDVersion, strlen(osver.szCSDVersion)));
     }
@@ -4526,6 +4587,12 @@ XS(w32_GetOSVersion)
     XPUSHs(newSViv(osver.dwMinorVersion));
     XPUSHs(newSViv(osver.dwBuildNumber));
     XPUSHs(newSViv(osver.dwPlatformId));
+    if (bEx) {
+        XPUSHs(newSViv(osver.wServicePackMajor));
+        XPUSHs(newSViv(osver.wServicePackMinor));
+        XPUSHs(newSViv(osver.wSuiteMask));
+        XPUSHs(newSViv(osver.wProductType));
+    }
     PUTBACK;
 }