Browse Source

* Add TObject lifetime tracking possibility

Michaël Van Canneyt 6 days ago
parent
commit
09b029ba9b
2 changed files with 17 additions and 0 deletions
  1. 8 0
      rtl/inc/objpas.inc
  2. 9 0
      rtl/inc/objpash.inc

+ 8 - 0
rtl/inc/objpas.inc

@@ -438,6 +438,10 @@ end;
 
 
       destructor TObject.Destroy;
       destructor TObject.Destroy;
         begin
         begin
+          {$IFDEF ENABLE_OBJECTHOOK}
+          if assigned(DestroyObjectHook) then
+            DestroyObjectHook(Self);
+          {$ENDIF}
         end;
         end;
 
 
       procedure TObject.Free;
       procedure TObject.Free;
@@ -538,6 +542,10 @@ end;
 {$endif def FPC_HAS_FEATURE_RTTI}
 {$endif def FPC_HAS_FEATURE_RTTI}
 
 
            InitInstance:=TObject(Instance);
            InitInstance:=TObject(Instance);
+           {$IFDEF ENABLE_OBJECTHOOK}
+           If Assigned(AllocateObjectHook) then
+             AllocateObjectHook(TObject(Instance));
+           {$ENDIF}
         end;
         end;
 
 
       class function TObject.ClassParent : tclass;
       class function TObject.ClassParent : tclass;

+ 9 - 0
rtl/inc/objpash.inc

@@ -252,6 +252,15 @@
        protected
        protected
           function GetDisposed : Boolean; inline;
           function GetDisposed : Boolean; inline;
           Property Disposed : Boolean Read GetDisposed;
           Property Disposed : Boolean Read GetDisposed;
+      {$IFDEF ENABLE_OBJECTHOOK}
+       public
+          Type
+             TObjectHook = procedure(aObject : TObject);
+          class var
+             AllocateObjectHook : TObjectHook;
+             DestroyObjectHook : TObjectHook;
+       {$ENDIF}
+
        public
        public
           { please don't change the order of virtual methods, because
           { please don't change the order of virtual methods, because
             their vmt offsets are used by some assembler code which uses
             their vmt offsets are used by some assembler code which uses