Converted DMT tests to DmtTestsUnit:

- new HVRTTIUtilsTestsUnit with the decitions on TestInsight/GUI/Console usage as the IDE keeps messing up the IFDEFs in the .dpr file - new DmtTestsUnit with DMT tests - new HVDMT unit with common DMT code - modified TestDmt and TestMethodTable projects to use HVDMT
jpluimers · Mar 20, 2017 · 49ed9fd · 49ed9fd
1 parent 21f8572
commit 49ed9fd
Show file tree

Hide file tree

Showing 8 changed files with 771 additions and 162 deletions.
diff --git a/HVDMT.pas b/HVDMT.pas
@@ -0,0 +1,94 @@
+unit HVDMT;
+
+interface
+
+uses
+  HVVMT;
+
+function GetDmt(const AClass: TClass): PDmt;
+
+function GetDynamicMethodCount(const AClass: TClass): Integer;
+
+function GetDynamicMethodIndex(const AClass: TClass; const Slot: Integer): Integer;
+
+function GetDynamicMethodProc(const AClass: TClass; const Slot: Integer): Pointer;
+
+function FindDynamicMethod(const AClass: TClass; const DMTIndex: TDMTIndex): Pointer;
+
+implementation
+
+function GetDmt(const AClass: TClass): PDmt;
+var
+  Vmt: PVmt;
+begin
+  Vmt := GetVmt(AClass);
+  if Assigned(Vmt) then
+    Result := Vmt.DynamicTable
+  else
+    Result := nil;
+end;
+
+function GetDynamicMethodCount(const AClass: TClass): Integer;
+var
+  Dmt: PDmt;
+begin
+  Dmt := GetDmt(AClass);
+  if Assigned(Dmt) then
+    Result := Dmt.Count
+  else
+    Result := 0;
+end;
+
+function GetDynamicMethodIndex(const AClass: TClass; const Slot: Integer): Integer;
+var
+  Dmt: PDmt;
+begin
+  Dmt := GetDmt(AClass);
+  if Assigned(Dmt) and (Slot < Dmt.Count) then
+    Result := Dmt.Indicies[Slot]
+  else
+    Result := 0; // Or raise exception
+end;
+
+function GetDynamicMethodProc(const AClass: TClass; const Slot: Integer): Pointer;
+var
+  Dmt: PDmt;
+  DmtMethods: PDmtMethods;
+begin
+  Dmt := GetDmt(AClass);
+  if Assigned(Dmt) and (Slot < Dmt.Count) then
+  begin
+    DmtMethods := @Dmt.Indicies[Dmt.Count];
+    Result := DmtMethods[Slot];
+  end
+  else
+    Result := nil; // Or raise exception
+end;
+
+function FindDynamicMethod(const AClass: TClass; const DMTIndex: TDMTIndex): Pointer;
+// Pascal variant of the faster BASM version in System.GetDynaMethod
+var
+  CurrentClass: TClass;
+  Dmt: PDmt;
+  DmtMethods: PDmtMethods;
+  i: Integer;
+begin
+  CurrentClass := AClass;
+  while Assigned(CurrentClass) do
+  begin
+    Dmt := GetDmt(CurrentClass);
+    if Assigned(Dmt) then
+      for i := 0 to Dmt.Count - 1 do
+        if DMTIndex = Dmt.Indicies[i] then
+        begin
+          DmtMethods := @Dmt.Indicies[Dmt.Count];
+          Result := DmtMethods[i];
+          Exit;
+        end;
+    // Not in this class, try the parent class
+    CurrentClass := CurrentClass.ClassParent;
+  end;
+  Result := nil;
+end;
+
+end.
diff --git a/TestDmt.dpr b/TestDmt.dpr
@@ -5,7 +5,10 @@ program TestDmt;
 uses
   Classes,
   SysUtils,
-  HVVMT in 'HVVMT.pas';
+  HVVMT in 'HVVMT.pas',
+  HVDMT in 'HVDMT.pas';
+
+{ << examples based on the RTL, but not used in our code }
 
 procedure GetDynaMethod;
 { function GetDynaMethod(vmt: TClass; selector: Smallint) : Pointer; }
@@ -81,54 +84,6 @@ type
     Methods: PDmtMethods; // really [0..Count-1]
   end;
 
-function GetDmt(const AClass: TClass): PDmt;
-var
-  Vmt: PVmt;
-begin
-  Vmt := GetVmt(AClass);
-  if Assigned(Vmt) then
-    Result := Vmt.DynamicTable
-  else
-    Result := nil;
-end;
-
-function GetDynamicMethodCount(const AClass: TClass): Integer;
-var
-  Dmt: PDmt;
-begin
-  Dmt := GetDmt(AClass);
-  if Assigned(Dmt) then
-    Result := Dmt.Count
-  else
-    Result := 0;
-end;
-
-function GetDynamicMethodIndex(const AClass: TClass; const Slot: Integer): Integer;
-var
-  Dmt: PDmt;
-begin
-  Dmt := GetDmt(AClass);
-  if Assigned(Dmt) and (Slot < Dmt.Count) then
-    Result := Dmt.Indicies[Slot]
-  else
-    Result := 0; // Or raise exception
-end;
-
-function GetDynamicMethodProc(const AClass: TClass; const Slot: Integer): Pointer;
-var
-  Dmt: PDmt;
-  DmtMethods: PDmtMethods;
-begin
-  Dmt := GetDmt(AClass);
-  if Assigned(Dmt) and (Slot < Dmt.Count) then
-  begin
-    DmtMethods := @Dmt.Indicies[Dmt.Count];
-    Result := DmtMethods[Slot];
-  end
-  else
-    Result := nil; // Or raise exception
-end;
-
 function GetDynamicMethodTable(const AClass: TClass): TDynamicMethodTable;
 var
   Dmt: PDmt;
@@ -144,31 +99,7 @@ begin
     Result.Count := 0;
 end;
 
-function FindDynamicMethod(const AClass: TClass; const DMTIndex: TDMTIndex): Pointer;
-// Pascal variant of the faster BASM version in System.GetDynaMethod
-var
-  CurrentClass: TClass;
-  Dmt: PDmt;
-  DmtMethods: PDmtMethods;
-  i: Integer;
-begin
-  CurrentClass := AClass;
-  while Assigned(CurrentClass) do
-  begin
-    Dmt := GetDmt(CurrentClass);
-    if Assigned(Dmt) then
-      for i := 0 to Dmt.Count - 1 do
-        if DMTIndex = Dmt.Indicies[i] then
-        begin
-          DmtMethods := @Dmt.Indicies[Dmt.Count];
-          Result := DmtMethods[i];
-          Exit;
-        end;
-    // Not in this class, try the parent class
-    CurrentClass := CurrentClass.ClassParent;
-  end;
-  Result := nil;
-end;
+{ >> examples based on the RTL, but not used in our code }
 
 procedure DumpDynamicMethods(const AClass: TClass);
 var
@@ -232,10 +163,12 @@ begin
   // Writeln(ClassName, ': TMyClass.FirstDynamic');
 end;
 
-{ procedure TMyClass.SecondDynamic;
-  begin
+{
+procedure TMyClass.SecondDynamic;
+begin
   Writeln(ClassName, '.SecondDynamic');
-  end; }
+end;
+}
 
 class procedure TMyClass.ThirdDynamic;
 begin

diff --git a/TestMethodTable.dpr b/TestMethodTable.dpr
@@ -123,17 +123,6 @@ type
     Methods: PDmtMethods; // really [0..Count-1]
   end;
 
-function GetDmt(const AClass: TClass): PDmt;
-var
-  Vmt: PVmt;
-begin
-  Vmt := GetVmt(AClass);
-  if Assigned(Vmt) then
-    Result := Vmt.DynamicTable
-  else
-    Result := nil;
-end;
-
 procedure DumpPublishedMethods(const AClass: TClass);
 var
   CurrentClass: TClass;
@@ -175,47 +164,6 @@ begin
   end;
 end;
 
-function FindDynamicMethod(AClass: TClass; DMTIndex: TDMTIndex): Pointer;
-// Pascal variant of the faster BASM version in System.GetDynaMethod
-var
-  Dmt: PDmt;
-  DmtMethods: PDmtMethods;
-  i: Integer;
-begin
-  while Assigned(AClass) do
-  begin
-    Dmt := GetDmt(AClass);
-    if Assigned(Dmt) then
-      for i := 0 to Dmt.Count - 1 do
-        if DMTIndex = Dmt.Indicies[i] then
-        begin
-          DmtMethods := @Dmt.Indicies[Dmt.Count];
-          Result := DmtMethods[i];
-          Exit;
-        end;
-    // Not in this class, try the parent class
-    AClass := AClass.ClassParent;
-  end;
-  Result := nil;
-end;
-
-procedure DumpFoundDynamicMethods(AClass: TClass);
-  procedure Dump(DMTIndex: TDMTIndex);
-  var
-    Proc: Pointer;
-  begin
-    Proc := FindDynamicMethod(AClass, DMTIndex);
-    Writeln(Format('Dynamic Method Index = %2d, Method = %p', //
-      [DMTIndex, Proc]));
-  end;
-
-begin
-  Dump(-1);
-  Dump(1);
-  Dump(13);
-  Dump(42);
-end;
-
 type
   {.$M+}// Compiler bug: includes published methods in VMT RTTI info even in $M- mode!!
 {$M-}