From c68ec729693813f35109b9853b0d18a6376d585f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Primo=C5=BE=20Gabrijel=C4=8Di=C4=8D?=
 <primoz@gabrijelcic.org>
Date: Mon, 12 Dec 2016 10:34:47 +0100
Subject: [PATCH] register all allocas as expected memory leaks

Implemented two EnableMemoryLeakReporting-mode methods
StartRegisteringAllThreadAllocationsAsExpectedLeaks and
StopRegisteringAllThreadAllocationsAsExpectedLeaks. Windows only.

Rationale: customer calls RegisterPropertyEditor from a program (not
package) and RegisterPropertyEditor creates a memory leak which cannot
be cleaned (local TList in a system unit) and cannot be correctly
registered (Unknown and UnicodeString leaks).

Call StartRegisteringAllThreadAllocationsAsExpectedLeaks to register all
following memory allocations as expected memory leaks.

Call StopRegisteringAllThreadAllocationsAsExpectedLeaks to stop that
behaviour.

Only one thread at a time can be in that state; if a second thread tries
to enter it, it will be blocked until the first thread exits from that
state.
---
 FastMM4.pas | 44 ++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 44 insertions(+)

diff --git a/FastMM4.pas b/FastMM4.pas
index 98bc729..a59abad 100644
--- a/FastMM4.pas
+++ b/FastMM4.pas
@@ -1389,6 +1389,20 @@ procedure GetMemoryMap(var AMemoryMap: TMemoryMap);
 function RegisterExpectedMemoryLeak(ALeakedPointer: Pointer): Boolean; overload;
 function RegisterExpectedMemoryLeak(ALeakedObjectClass: TClass; ACount: Integer = 1): Boolean; overload;
 function RegisterExpectedMemoryLeak(ALeakedBlockSize: NativeInt; ACount: Integer = 1): Boolean; overload;
+
+{$ifdef MSWINDOWS}
+{Start registering all allocations in the current thread as expected memory leaks.
+ Only one thread in the program can be in this state. While the program is registering
+ all memory allocations in a thread as expected leaks any other call to this function
+ will block and will only continue when the original thread calls
+ StopRegisteringAllThreadAllocationsAsExpectedLeaks;
+}
+procedure StartRegisteringAllThreadAllocationsAsExpectedLeaks;
+{Stops registering all allocations in the current thread as expected memory leaks.
+}
+procedure StopRegisteringAllThreadAllocationsAsExpectedLeaks;
+{$endif}
+
 {$ifdef CheckCppObjectTypeEnabled}
 {Registers expected memory leaks by virtual object's typeId pointer.
  Usage: RegisterExpectedMemoryLeak(typeid(ACppObject).tpp, Count);}
@@ -9651,6 +9665,11 @@ function DebugGetMem(ASize: {$ifdef XE2AndUp}NativeInt{$else}Integer{$endif}): P
     {Leaving the memory manager routine: Block scans may be performed again.}
     DoneChangingFullDebugModeBlock;
   end;
+  if Result <> nil then
+  begin
+    if (RegisterAllAsLeakForThread <> 0) and (RegisterAllAsLeakForThread = GetCurrentThreadID) then
+      RegisterExpectedMemoryLeak(Result);
+  end;
 end;
 
 function CheckBlockBeforeFreeOrRealloc(APBlock: PFullDebugBlockHeader;
@@ -10492,6 +10511,31 @@ function RegisterExpectedMemoryLeak(ALeakedBlockSize: NativeInt; ACount: Integer
   ExpectedMemoryLeaksListLocked := False;
 end;
 
+{$ifdef MSWINDOWS}
+procedure StartRegisteringAllThreadAllocationsAsExpectedLeaks;
+var
+  LThreadID: Cardinal;
+begin
+  LThreadID := GetCurrentThreadID;
+  while LockCmpxchg32(0, LThreadID, @RegisterAllAsLeakForThread) <> 0 do
+  begin
+    Sleep(InitialSleepTime);
+    if LockCmpxchg(0, LThreadID, @RegisterAllAsLeakForThread) = 0 then
+      Break;
+    Sleep(AdditionalSleepTime);
+  end;
+end;
+
+procedure StopRegisteringAllThreadAllocationsAsExpectedLeaks;
+var
+  LThreadID: Cardinal;
+begin
+  LThreadID := GetCurrentThreadID;
+  if LockCmpxchg32(LThreadID, 0, @RegisterAllAsLeakForThread) <> LThreadID then
+    {$ifdef BCB6OrDelphi7AndUp}System.Error(reInvalidPtr);{$else}System.RunError(reInvalidPtr);{$endif}
+end;
+{$endif}
+
 function UnregisterExpectedMemoryLeak(ALeakedPointer: Pointer): Boolean; overload;
 var
   LNewEntry: TExpectedMemoryLeak;