Explorar el Código

* Add TObject lifetime tracking possibility

Michaël Van Canneyt hace 5 días
padre
commit
09b029ba9b
Se han modificado 2 ficheros con 17 adiciones y 0 borrados
  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;
         begin
+          {$IFDEF ENABLE_OBJECTHOOK}
+          if assigned(DestroyObjectHook) then
+            DestroyObjectHook(Self);
+          {$ENDIF}
         end;
 
       procedure TObject.Free;
@@ -538,6 +542,10 @@ end;
 {$endif def FPC_HAS_FEATURE_RTTI}
 
            InitInstance:=TObject(Instance);
+           {$IFDEF ENABLE_OBJECTHOOK}
+           If Assigned(AllocateObjectHook) then
+             AllocateObjectHook(TObject(Instance));
+           {$ENDIF}
         end;
 
       class function TObject.ClassParent : tclass;

+ 9 - 0
rtl/inc/objpash.inc

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