Re: When should PERL_SYS_TERM() be called? [was: Re: [PATCH] Re: [PATCH] Re: [PATCH...

[perl5.git] / win32 / win32.c

diff --git a/win32/win32.c b/win32/win32.c
index 49ba63a..a7c409f 100644 (file)
--- a/win32/win32.c
+++ b/win32/win32.c
@@ -18,12 +18,6 @@
 #ifndef HWND_MESSAGE
 #  define HWND_MESSAGE     ((HWND)-3)
 #endif
-/* GCC-2.95.2/Mingw32-1.1 forgot the WINAPI on CommandLineToArgvW() */
-#if defined(__MINGW32__) && (__MINGW32_MAJOR_VERSION==1)       
-#  include <shellapi.h>
-#else
-   LPWSTR* WINAPI CommandLineToArgvW(LPCWSTR lpCommandLine, int * pNumArgs);
-#endif
 #include <winnt.h>
 #include <io.h>
 #include <signal.h>
@@ -38,6 +32,13 @@
 #include "EXTERN.h"
 #include "perl.h"
 
+/* GCC-2.95.2/Mingw32-1.1 forgot the WINAPI on CommandLineToArgvW() */
+#if defined(__MINGW32__) && (__MINGW32_MAJOR_VERSION==1)
+#  include <shellapi.h>
+#else
+EXTERN_C LPWSTR* WINAPI CommandLineToArgvW(LPCWSTR lpCommandLine, int * pNumArgs);
+#endif
+
 #define NO_XSLOCKS
 #define PERL_NO_GET_CONTEXT
 #include "XSUB.h"
@@ -66,11 +67,13 @@ int _CRT_glob = 0;
 
 #if defined(__MINGW32__) && (__MINGW32_MAJOR_VERSION==1)       
 /* Mingw32-1.1 is missing some prototypes */
+START_EXTERN_C
 FILE * _wfopen(LPCWSTR wszFileName, LPCWSTR wszMode);
 FILE * _wfdopen(int nFd, LPCWSTR wszMode);
 FILE * _freopen(LPCWSTR wszFileName, LPCWSTR wszMode, FILE * pOldStream);
 int _flushall();
 int _fcloseall();
+END_EXTERN_C
 #endif
 
 #if defined(__BORLANDC__)
@@ -130,6 +133,21 @@ _matherr(struct _exception *a)
 }
 #endif
 
+#if _MSC_VER >= 1400
+void my_invalid_parameter_handler(const wchar_t* expression,
+    const wchar_t* function, 
+    const wchar_t* file, 
+    unsigned int line, 
+    uintptr_t pReserved)
+{
+#  ifdef _DEBUG
+    wprintf(L"Invalid parameter detected in function %s."
+            L" File: %s Line: %d\n", function, file, line);
+    wprintf(L"Expression: %s\n", expression);
+#  endif
+}
+#endif
+
 int
 IsWin95(void)
 {
@@ -4856,9 +4874,19 @@ win32_ctrlhandler(DWORD dwCtrlType)
 }
 
 
+#if _MSC_VER >= 1400
+#  include <crtdbg.h>
+#endif
+
 void
 Perl_win32_init(int *argcp, char ***argvp)
 {
+#if _MSC_VER >= 1400
+    _invalid_parameter_handler oldHandler, newHandler;
+    newHandler = my_invalid_parameter_handler;
+    oldHandler = _set_invalid_parameter_handler(newHandler);
+    _CrtSetReportMode(_CRT_ASSERT, 0);
+#endif
     /* Disable floating point errors, Perl will trap the ones we
      * care about.  VC++ RTL defaults to switching these off
      * already, but the Borland RTL doesn't.  Since we don't
@@ -4874,8 +4902,10 @@ Perl_win32_init(int *argcp, char ***argvp)
 void
 Perl_win32_term(void)
 {
+    dTHX;
     HINTS_REFCNT_TERM;
     OP_REFCNT_TERM;
+    PERLIO_TERM;
     MALLOC_TERM;
 }
 
@@ -4938,6 +4968,12 @@ win32_create_message_window()
     return CreateWindow("Static", "", 0, 0, 0, 0, 0, HWND_MESSAGE, 0, 0, NULL);
 }
 
+#if defined(__MINGW32__) && defined(__cplusplus)
+#define CAST_HWND__(x) (HWND__*)(x)
+#else
+#define CAST_HWND__(x) x
+#endif
+
 void
 Perl_sys_intern_init(pTHX)
 {
@@ -4960,7 +4996,7 @@ Perl_sys_intern_init(pTHX)
     w32_num_pseudo_children    = 0;
 #  endif
     w32_timerid                 = 0;
-    w32_message_hwnd            = INVALID_HANDLE_VALUE;
+    w32_message_hwnd            = CAST_HWND__(INVALID_HANDLE_VALUE);
     w32_poll_count              = 0;
     for (i=0; i < SIG_SIZE; i++) {
        w32_sighandler[i] = SIG_DFL;
@@ -5016,7 +5052,7 @@ Perl_sys_intern_dup(pTHX_ struct interp_intern *src, struct interp_intern *dst)
     dst->pseudo_id             = 0;
     Newxz(dst->pseudo_children, 1, pseudo_child_tab);
     dst->timerid                = 0;
-    dst->message_hwnd          = INVALID_HANDLE_VALUE;
+    dst->message_hwnd          = CAST_HWND__(INVALID_HANDLE_VALUE);
     dst->poll_count             = 0;
     Copy(src->sigtable,dst->sigtable,SIG_SIZE,Sighandler_t);
 }