This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Turn on memory leak reporting for CFG = DebugFull builds on Windows
authorSteve Hay <steve.m.hay@googlemail.com>
Sun, 15 Feb 2015 16:06:43 +0000 (16:06 +0000)
committerSteve Hay <steve.m.hay@googlemail.com>
Sun, 15 Feb 2015 16:06:43 +0000 (16:06 +0000)
Setting _CRTDBG_LEAK_CHECK_DF arranges for _CrtDumpMemoryLeaks() to be
called automatically at program termination, outputting a report of all
allocations that have not been freed into the Output window in Developer
Studio.

If a leak is reported then note its allocation number, change the -1 in
the _CrtSetBreakAlloc(-1L) call to the leaked allocation number and
rebuild. A breakpoint will be set on the allocation call that leaked.

(A slicker approach is to have the report include the file name and line
number of the leaked allocation call by inserting

#define _CRTDBG_MAP_ALLOC
#include <crtdbg.h>

early in each compilation unit (e.g. by inserting it early in perl.h), but
that works by re-#defining malloc/free etc, which unfortunately clashes
with #defines in win32/win32iop.h and with the 'free' member of the
regexp_engine struct in regexp.h.)

win32/runperl.c

index b76f8ba..2157224 100644 (file)
@@ -1,3 +1,7 @@
+#ifdef _MSC_VER
+#include <crtdbg.h>
+#endif
+
 #include "EXTERN.h"
 #include "perl.h"
 
 #include "EXTERN.h"
 #include "perl.h"
 
@@ -20,6 +24,18 @@ int _CRT_glob = 0;
 int
 main(int argc, char **argv, char **env)
 {
 int
 main(int argc, char **argv, char **env)
 {
+#ifdef _MSC_VER
+    /* Arrange for _CrtDumpMemoryLeaks() to be called automatically at program
+     * termination when built with CFG = DebugFull. */
+    int currentFlag = _CrtSetDbgFlag(_CRTDBG_REPORT_FLAG);
+    currentFlag |= _CRTDBG_LEAK_CHECK_DF;
+    _CrtSetDbgFlag(currentFlag);
+
+    /* Change this -1 to the allocation number of any reported memory leaks to
+     * break on the allocation call that was leaked. */
+    _CrtSetBreakAlloc(-1L);
+#endif
+
     return RunPerl(argc, argv, env);
 }
 
     return RunPerl(argc, argv, env);
 }