Browse Source

* Add unit initialization tracking hook

Michaël Van Canneyt 5 days ago
parent
commit
7eeb313376
2 changed files with 13 additions and 0 deletions
  1. 7 0
      rtl/inc/system.inc
  2. 6 0
      rtl/inc/systemh.inc

+ 7 - 0
rtl/inc/system.inc

@@ -1168,6 +1168,13 @@ begin
       begin
         if assigned(Procs[i].InitProc) then
          Procs[i].InitProc();
+        {$ifdef FPC_INITFINAL_HASUNITNAME}
+        {$ifdef ENABLE_UNIT_INIT_TRACKING}
+        if assigned(UnitInitTrackingProc) then
+          UnitInitTrackingProc(i,Procs[i].unitname^);
+        {$endif ENABLE_UNIT_INIT_TRACKING}
+        {$endif FPC_INITFINAL_HASUNITNAME}
+
         InitCount:=i;
       end;
    end;

+ 6 - 0
rtl/inc/systemh.inc

@@ -1736,6 +1736,9 @@ Type
   TAbstractErrorProc = Procedure;
   TAssertErrorProc = Procedure(const msg,fname:ShortString;lineno:longint;erroraddr:pointer);
   TSafeCallErrorProc = Procedure(error : HResult;addr : pointer);
+  {$ifdef ENABLE_UNIT_INIT_TRACKING}
+  TUnitInitTrackProc = procedure(aSequence : SmallInt; const aUnitName : ShortString);
+  {$endif ENABLE_UNIT_INIT_TRACKING}
 
 
 const
@@ -1748,6 +1751,9 @@ const
   ExceptObjProc     : Pointer = nil; { Used to convert OS exceptions to FPC exceptions. }
   ExceptClsProc     : Pointer = nil;
 {$endif FPC_HAS_FEATURE_EXCEPTIONS}
+{$ifdef ENABLE_UNIT_INIT_TRACKING}
+  UnitInitTrackingProc : TUnitInitTrackProc;
+{$endif ENABLE_UNIT_INIT_TRACKING}
 
 {*****************************************************************************
                           SetJmp/LongJmp