AbstractMem library v 1.3

Minor stats and analyzers added

src/libraries/abstractmem/ConfigAbstractMem.inc

@@ -52,8 +52,12 @@
   - Added TAbstractBTree - Standard B-Tree implementation for use on AbstractMem Library - Multithread protected
   - Added TAbstractMemBTreeData<TData> that implements a generic <TData> implementation for TAbstractBTree on TAbstractMem
   - Added ABSTRACTMEM_CIRCULAR_SEARCH_PROTECTION compiler directive to prevent circular structures on Tree nodes
+  
+  Version 1.3 - Jul 2021
+  - Added TAbstractMemZoneInfo that allows to Analyze TAbstractMem using CheckConsistency and returns all blocks information
+  - Added TAVLCacheStats that allows to obtain stats from any TAVLCache<T> object
 
 }
 
 const
-  CT_ABSTRACTMEM_VERSION = 1.2; // Each revision should increase this version...
+  CT_ABSTRACTMEM_VERSION = 1.3; // Each revision should increase this version...

src/libraries/abstractmem/UAVLCache.pas

@@ -41,6 +41,16 @@ type
 
   { TAVLCache }
 
+  TAVLCacheStats = Record
+    searchesOk : Integer;
+    searchesFailed : Integer;
+    addedCount : Integer;
+    removedCount : Integer;
+    removedByOveruse : Integer;
+    procedure Clear;
+    function ToString : String;
+  end;
+
   TAVLCache<T> = Class
   public
     type
@@ -89,6 +99,7 @@ type
     var FAVLCacheMem : TAVLCacheMem;
     FMaxRegisters : Integer;
     FAVLCacheLock : TCriticalSection;
+    FStats : TAVLCacheStats;
   protected
     procedure BeforeDelete(var AData : T); virtual;
     procedure ConsistencyCheck;
@@ -104,6 +115,7 @@ type
     function TreeToString: String;
     function ToString(const AData : T) : String; overload; virtual;
     property MaxRegisters : Integer read FMaxRegisters write FMaxRegisters;
+    property Stats : TAVLCacheStats read FStats;
   End;
 
 implementation
@@ -354,9 +366,12 @@ begin
       FAVLCacheMem.Delete(PToDelete);
 
       inc(i);
+      Inc(FStats.removedCount);
+      Inc(FStats.removedByOveruse);
     end;
   end;
   Finally
+    Inc(FStats.addedCount);
     FAVLCacheLock.Release;
   End;
 end;
@@ -378,6 +393,7 @@ begin
     BeforeDelete(P^.data);
     FAVLCacheMem.DoMark(P,False);
     FAVLCacheMem.Delete(P);
+    Inc(FStats.removedCount);
   end;
   Finally
     FAVLCacheLock.Release;
@@ -401,6 +417,7 @@ begin
   FAVLCacheMem := TAVLCacheMem.Create(AOnCompareMethod,False);
   FMaxRegisters := ADefaultMaxRegisters;
   FAVLCacheLock := TCriticalSection.Create;
+  FStats.Clear;
 end;
 
 destructor TAVLCache<T>.Destroy;
@@ -431,7 +448,11 @@ begin
       AFound := PFound^.data;
       Result := True;
       FAVLCacheMem.DoMark(PFound,True);
-    end else Result := False;
+      Inc(FStats.searchesOk);
+    end else begin
+      Result := False;
+      Inc(FStats.searchesFailed);
+    end;
   finally
     Dispose(P);
   end;
@@ -454,6 +475,7 @@ begin
       BeforeDelete(PFound^.data);
       FAVLCacheMem.DoMark(PFound,False);
       FAVLCacheMem.Delete(PFound);
+      Inc(FStats.removedCount);
     end;
   finally
     Dispose(P);
@@ -491,4 +513,20 @@ begin
   Result := 'TAVLCache<T>.TAVLCacheMemData.'+IntToStr(SizeOf(Self.data));
 end;
 
+{ TAVLCacheStats }
+
+procedure TAVLCacheStats.Clear;
+begin
+  Self.searchesOk := 0;
+  Self.searchesFailed := 0;
+  Self.addedCount := 0;
+  Self.removedCount := 0;
+  Self.removedByOveruse := 0;
+end;
+
+function TAVLCacheStats.ToString: String;
+begin
+  Result := Format('%2.f%% of %d searches Ok. Added %d and removed %d for overuse',[Self.searchesOk*100/(Self.searchesFailed+Self.searchesFailed),Self.searchesFailed+Self.searchesFailed,Self.addedCount,Self.removedByOveruse]);
+end;
+
 end.

src/libraries/abstractmem/UAbstractMem.pas

@@ -34,7 +34,8 @@ interface
 uses
   Classes, SysUtils,
   SyncObjs,
-  UAbstractAVLTree;
+  UAbstractAVLTree
+  {$IFNDEF FPC},System.Generics.Collections,System.Generics.Defaults{$ELSE},Generics.Collections,Generics.Defaults{$ENDIF};
 
 {$I ./ConfigAbstractMem.inc }
 
@@ -71,7 +72,6 @@ Type
     function ToString : String;
   end;
 
-
   TAbstractMemMemoryLeaks = Class( TAVLAbstractTree<TAbstractMemMemoryLeaksNode> )
   private
     FAbstractMem : TAbstractMem;
@@ -97,6 +97,11 @@ Type
 
   TAbstractMemZoneType = (amzt_unknown, amzt_memory_leak, amzt_used);
 
+  TAbstractMemZoneInfo = record
+    AMZone : TAMZone;
+    ZoneType : TAbstractMemZoneType;
+  end;
+
   { TAbstractMem }
 
   TAbstractMem = Class
@@ -135,7 +140,7 @@ Type
     procedure Dispose(const APosition : TAbstractMemPosition); overload;
     function GetUsedZoneInfo(const APosition : TAbstractMemPosition; ACheckForUsedZone : Boolean; out AAMZone : TAMZone) : Boolean;
     function ToString : String; override;
-    function CheckConsistency(const AStructure : TStrings; out ATotalUsedSize, ATotalUsedBlocksCount, ATotalLeaksSize, ATotalLeaksBlocksCount : Integer) : Boolean;
+    function CheckConsistency(const AStructure : TStrings; const AAbstractMemZoneInfoList : TList<TAbstractMemZoneInfo>; out ATotalUsedSize, ATotalUsedBlocksCount, ATotalLeaksSize, ATotalLeaksBlocksCount : Integer) : Boolean;
     function ReadFirstData(var AFirstDataZone : TAMZone; var AFirstData : TBytes) : Boolean;
     class function GetAbstractMemVersion : String;
     property ReadOnly : Boolean read FReadOnly;
@@ -189,9 +194,12 @@ const
 
 { TAbstractMem }
 
-function TAbstractMem.CheckConsistency(const AStructure: TStrings; out ATotalUsedSize, ATotalUsedBlocksCount, ATotalLeaksSize, ATotalLeaksBlocksCount : Integer) : Boolean;
+function TAbstractMem.CheckConsistency(const AStructure : TStrings; const AAbstractMemZoneInfoList : TList<TAbstractMemZoneInfo>; out ATotalUsedSize, ATotalUsedBlocksCount, ATotalLeaksSize, ATotalLeaksBlocksCount : Integer) : Boolean;
 var LPosition : TAbstractMemPosition;
   LZone : TAMZone;
+  LAMZoneInfo : TAbstractMemZoneInfo;
+  i, nCount : Integer;
+  LMemLeakFound,LMemLeakToFind : TAbstractMemMemoryLeaksNode;
 begin
   // Will check since first position:
   FLock.Acquire;
@@ -206,12 +214,22 @@ begin
       case GetZoneType(LPosition,LZone) of
         amzt_memory_leak : begin
           if Assigned(AStructure) then AStructure.Add( Format('%d to %d mem leak %d bytes',[LPosition,LZone.position + LZone.size,LZone.size]));
+          if Assigned(AAbstractMemZoneInfoList) then begin
+            LAMZoneInfo.AMZone := LZone;
+            LAMZoneInfo.ZoneType := amzt_memory_leak;
+            AAbstractMemZoneInfoList.Add(LAMZoneInfo);
+          end;
           Inc(LPosition, LZone.size);
           inc(ATotalLeaksSize,LZone.size);
           inc(ATotalLeaksBlocksCount);
         end;
         amzt_used : begin
           if Assigned(AStructure) then AStructure.Add( Format('%d to %d used %d bytes',[LPosition,LZone.position + LZone.size, LZone.size]));
+          if Assigned(AAbstractMemZoneInfoList) then begin
+            LAMZoneInfo.AMZone := LZone;
+            LAMZoneInfo.ZoneType := amzt_used;
+            AAbstractMemZoneInfoList.Add(LAMZoneInfo);
+          end;
           inc(LPosition, LZone.size + CT_ExtraSizeForUsedZoneType);
           inc(ATotalUsedSize,LZone.size + CT_ExtraSizeForUsedZoneType);
           inc(ATotalUsedBlocksCount);
@@ -221,6 +239,34 @@ begin
         Result := False;
       end;
     end;
+    //
+    if Assigned(AAbstractMemZoneInfoList) then begin
+      // Try to find all blocks:
+      for i := 0 to AAbstractMemZoneInfoList.Count-1 do begin
+        if (AAbstractMemZoneInfoList.Items[i].ZoneType=amzt_memory_leak) then begin
+          // Search it:
+          LMemLeakToFind.Clear;
+          LMemLeakToFind.SetSize( AAbstractMemZoneInfoList.Items[i].AMZone.size );
+          LMemLeakToFind.myPosition := AAbstractMemZoneInfoList.Items[i].AMZone.position;
+
+          LMemLeakFound := FMemLeaks.Find( LMemLeakToFind );
+          if Not FMemLeaks.IsNil(LMemLeakFound) then begin
+            if (LMemLeakFound.myPosition<>AAbstractMemZoneInfoList.Items[i].AMZone.position) then begin
+              if Assigned(AStructure) then AStructure.Add( Format('MemLeak of %d bytes at %d pos not equal at %d/%d',
+                [LMemLeakToFind.GetSize,AAbstractMemZoneInfoList.Items[i].AMZone.position,i+1,AAbstractMemZoneInfoList.Count]));
+              Result := False;
+            end;
+          end else begin
+            if Assigned(AStructure) then AStructure.Add( Format('MemLeak of %d bytes at pos %d pos not found %d/%d',
+              [LMemLeakToFind.GetSize,AAbstractMemZoneInfoList.Items[i].AMZone.position,i+1,AAbstractMemZoneInfoList.Count]));
+            Result := False;
+          end;
+
+        end;
+      end;
+
+
+    end;
   Finally
     FLock.Release;
   End;
@@ -554,7 +600,7 @@ var LAnalize : TStrings;
 begin
   LAnalize := TStringList.Create;
   try
-    if Not CheckConsistency(LAnalize,LTotalUsedSize, LTotalUsedBlocksCount, LTotalLeaksSize, LTotalLeaksBlocksCount) then begin
+    if Not CheckConsistency(LAnalize, Nil, LTotalUsedSize, LTotalUsedBlocksCount, LTotalLeaksSize, LTotalLeaksBlocksCount) then begin
       LAnalize.Add('CONSISTENCY ERROR FOUND');
     end else begin
       LAnalize.Clear;

src/libraries/abstractmem/tests/src/UAbstractMem.Tests.pas

@@ -7,13 +7,14 @@ unit UAbstractMem.Tests;
 interface
 
  uses
-   SysUtils,
+   SysUtils, classes,
    {$IFDEF FPC}
    fpcunit, testutils, testregistry,
    {$ELSE}
    TestFramework,
    {$ENDIF}
-   UCacheMem, UFileMem, UAbstractMem, UAbstractBTree, UAbstractMemTList;
+   UCacheMem, UFileMem, UAbstractMem, UAbstractBTree, UAbstractMemTList
+   {$IFNDEF FPC},System.Generics.Collections,System.Generics.Defaults{$ELSE},Generics.Collections,Generics.Defaults{$ENDIF};
  type
    // Test methods for class TCalc
    TestTAbstractMem = class(TTestCase)
@@ -22,7 +23,8 @@ interface
      procedure SetUp; override;
      procedure TearDown; override;
    published
-     procedure Test1;
+     procedure Test_ClearContent;
+     procedure Test_MemLeaksReuse;
    end;
 
 implementation
@@ -35,7 +37,7 @@ procedure TestTAbstractMem.TearDown;
 begin
 end;
 
-procedure TestTAbstractMem.Test1;
+procedure TestTAbstractMem.Test_ClearContent;
 var Lfm : TFileMem;
 begin
   Lfm := TFileMem.Create(ExtractFileDir(ParamStr(0))+PathDelim+'test1.am',False);
@@ -47,6 +49,49 @@ begin
 end;
 
 
+procedure TestTAbstractMem.Test_MemLeaksReuse;
+var LAM : TAbstractMem;
+  LAMs : TList<TAMZone>;
+  i,j, loops : Integer;
+  LStrings : TStrings;
+  LAbstractMemZoneInfoList : TList<TAbstractMemZoneInfo>;
+  LTotalUsedSize, LTotalUsedBlocksCount, LTotalLeaksSize, LTotalLeaksBlocksCount : Integer;
+begin
+  LAM := TMem.Create(0,False);
+  try
+    LAMs := TList<TAMZone>.Create;
+    Try
+      for loops := 1 to 2 do begin
+
+      LAMs.Clear;
+
+      for j := 1 to 10000 do begin
+        LAMs.Add( LAM.New(Random(1000)+10) );
+      end;
+
+      //
+      for i := 0 to LAMs.Count-1 do begin
+        LAM.Dispose( LAMs.Items[i] );
+      end;
+
+      end;
+
+      LStrings := TStringList.Create;
+      LAbstractMemZoneInfoList := TList<TAbstractMemZoneInfo>.Create;
+      try
+        if Not LAM.CheckConsistency(LStrings,LAbstractMemZoneInfoList,LTotalUsedSize, LTotalUsedBlocksCount, LTotalLeaksSize, LTotalLeaksBlocksCount) then raise Exception.Create(LStrings.Text);
+      finally
+        LAbstractMemZoneInfoList.Free;
+        LStrings.Free;
+      end;
+    Finally
+      LAMs.Free;
+    End;
+  finally
+    LAM.Free;
+  end;
+end;
+
 initialization
-//  RegisterTest(TestTAbstractMem{$IFNDEF FPC}.Suite{$ENDIF});
+  RegisterTest(TestTAbstractMem{$IFNDEF FPC}.Suite{$ENDIF});
 end.

src/libraries/abstractmem/tests/src/UAbstractMemBTree.Tests.pas

@@ -114,7 +114,7 @@ procedure TestTAbstractMemBTree.DoCheckAbstractMem(AAbstractMem: TAbstractMem; A
 var
   LTotalUsedSize, LTotalUsedBlocksCount, LTotalLeaksSize, LTotalLeaksBlocksCount : Integer;
 begin
-  Assert(AAbstractMem.CheckConsistency(Nil,LTotalUsedSize, LTotalUsedBlocksCount, LTotalLeaksSize, LTotalLeaksBlocksCount));
+  Assert(AAbstractMem.CheckConsistency(Nil,Nil,LTotalUsedSize, LTotalUsedBlocksCount, LTotalLeaksSize, LTotalLeaksBlocksCount));
   Assert(LTotalUsedSize=AUsedBytes,Format('Total used %d bytes (%d blocks) different from expected %d bytes - Total free %d bytes (%d blocks)',[LTotalUsedSize, AUsedBytes, LTotalUsedBlocksCount, LTotalLeaksSize, LTotalLeaksBlocksCount]));
 end;