View Issue Details

IDProjectCategoryView StatusLast Update
0038252pas2jsrtlpublic2021-01-23 11:37
Reporterhenrique Assigned ToMichael Van Canneyt  
PrioritynormalSeverityminorReproducibilityalways
Status resolvedResolutionfixed 
PlatformPas2JsOSWindows 
Fixed in Versiontrunk 
Summary0038252: New way to find a type in RTTI
DescriptionI created a new function to search for a type by its qualified name.

I had to put a snippet in asm because the compiler didn't recognize the class as a JSObject.
TagsNo tags attached.
Fixed in Revision1069
Attached Files

Activities

henrique

2020-12-23 20:48

reporter  

0001-Busca-de-tipo-pelo-nome.patch (2,528 bytes)   
From 6cb243a88e5e358cb1fbc95d1894b4d1f7ccdc1c Mon Sep 17 00:00:00 2001
From: Henrique Gottardi Werlang <henriquewerlang@hotmail.com>
Date: Wed, 23 Dec 2020 16:20:24 -0300
Subject: [PATCH] Busca de tipo pelo nome.

---
 packages/rtl/rtti.pas    | 28 ++++++++++++++++++++++++++++
 packages/rtl/typinfo.pas |  6 ++++++
 2 files changed, 34 insertions(+)

diff --git a/packages/rtl/rtti.pas b/packages/rtl/rtti.pas
index 50e72ce..33c614d 100644
--- a/packages/rtl/rtti.pas
+++ b/packages/rtl/rtti.pas
@@ -78,6 +78,7 @@ type
     class function Create: TRTTIContext; static;
     procedure Free;
 
+    function FindType(const AQualifiedName: String): TRttiType;
     function GetType(aTypeInfo: PTypeInfo): TRTTIType; overload;
     function GetType(aClass: TClass): TRTTIType; overload;
   end;
@@ -373,6 +374,7 @@ implementation
 
 var
   GRttiContext: TRTTIContext;
+  pas: TJSObject; external name 'pas';
 
 procedure CreateVirtualCorbaInterface(InterfaceTypeInfo: Pointer;
   const MethodImplementation: TVirtualInterfaceInvokeEvent; out IntfVar); assembler;
@@ -1019,6 +1021,32 @@ begin
   Result:=GetType(TypeInfo(aClass));
 end;
 
+function TRTTIContext.FindType(const AQualifiedName: String): TRttiType;
+var
+  ModuleName, UnitName: String;
+
+  Module: TTypeInfoModule;
+
+  TypeFound: PTypeInfo;
+
+begin
+  ModuleName := Copy(AQualifiedName, 1, Pos('.', AQualifiedName) - 1);
+  UnitName := Copy(AQualifiedName, Pos('.', AQualifiedName) + 1, Length(AQualifiedName));
+  Result := nil;
+
+  if pas.HasOwnProperty(ModuleName) then
+  begin
+    Module := TTypeInfoModule(pas[ModuleName]);
+
+    asm
+      if (Module.$rtti.hasOwnProperty(UnitName))
+        TypeFound = Module.$rtti[UnitName];
+    end;
+
+    Result := GetType(TypeFound);
+  end;
+end;
+
 { TRttiObject }
 
 function TRttiObject.GetAttributes: TCustomAttributeArray;
diff --git a/packages/rtl/typinfo.pas b/packages/rtl/typinfo.pas
index 6a3361b..88679de 100644
--- a/packages/rtl/typinfo.pas
+++ b/packages/rtl/typinfo.pas
@@ -25,11 +25,17 @@ type
   TCallConv = (ccReg, ccCdecl, ccPascal, ccStdCall, ccSafeCall, ccCppdecl,
     ccFar16, ccOldFPCCall, ccInternProc, ccSysCall, ccSoftFloat, ccMWPascal);
 
+
+  { TSectionRTTI }
+  TSectionRTTI = class external name 'rtl.tSectionRTTI'
+
+  end;
   { TTypeInfoModule }
 
   TTypeInfoModule = class external name 'pasmodule'
   public
     Name: String external name '$name';
+    RTTI: TSectionRTTI external name '$rtti';
   end;
 
   TTypeInfoAttributes = type TJSValueDynArray;
-- 
2.29.2.windows.2

Sven Barth

2020-12-24 18:14

developer   ~0127791

Three points:
- declare TSectionRTTI as "class external name 'rtl.tSectionRTTI' (TJSObject)" and you can simply use "Module.RTTI.HasOwnProperty(...)" directly instead of wrapping it in asm code
- you could save the Pos() so that it doesn't need to be calculated twice
- your code will fail with namespaced units (Namespace1.Unit1 or Namespace1.Sub.Unit1) or nested types (TType1.TType2) or a combination of both

henrique

2020-12-28 12:02

reporter   ~0127851

1 - Nice! I would ask if there was a way to do that!
2 - Correct, but as you commented in the next item, it will not work.
3 - I will try another solution, because this one will really have problems.

henrique

2020-12-28 15:12

reporter   ~0127862

New patch!

Fixed the TSectionRTTI declaration and changed the implementation, to find the type by the name of the modules inside of "pas" variable.
0001-Busca-de-tipo-pelo-nome-2.patch (2,543 bytes)   
From 0471c9f48846af090e3d09e450920e306f40b1a3 Mon Sep 17 00:00:00 2001
From: Henrique Gottardi Werlang <henriquewerlang@hotmail.com>
Date: Wed, 23 Dec 2020 16:20:24 -0300
Subject: [PATCH] Busca de tipo pelo nome.

---
 packages/rtl/rtti.pas    | 28 ++++++++++++++++++++++++++++
 packages/rtl/typinfo.pas |  6 ++++++
 2 files changed, 34 insertions(+)

diff --git a/packages/rtl/rtti.pas b/packages/rtl/rtti.pas
index 50e72ce..fcbc282 100644
--- a/packages/rtl/rtti.pas
+++ b/packages/rtl/rtti.pas
@@ -78,6 +78,7 @@ type
     class function Create: TRTTIContext; static;
     procedure Free;
 
+    function FindType(const AQualifiedName: String): TRttiType;
     function GetType(aTypeInfo: PTypeInfo): TRTTIType; overload;
     function GetType(aClass: TClass): TRTTIType; overload;
   end;
@@ -373,6 +374,7 @@ implementation
 
 var
   GRttiContext: TRTTIContext;
+  pas: TJSObject; external name 'pas';
 
 procedure CreateVirtualCorbaInterface(InterfaceTypeInfo: Pointer;
   const MethodImplementation: TVirtualInterfaceInvokeEvent; out IntfVar); assembler;
@@ -1019,6 +1021,32 @@ begin
   Result:=GetType(TypeInfo(aClass));
 end;
 
+function TRTTIContext.FindType(const AQualifiedName: String): TRttiType;
+var
+  ModuleName, TypeName: String;
+
+  Module: TTypeInfoModule;
+
+  TypeFound: PTypeInfo;
+
+begin
+  Result := nil;
+
+  for ModuleName in TJSObject.Keys(pas) do
+    if AQualifiedName.StartsWith(ModuleName) then
+    begin
+      Module := TTypeInfoModule(pas[ModuleName]);
+      TypeName := Copy(AQualifiedName, Length(ModuleName) + 2, Length(AQualifiedName));
+
+      if Module.RTTI.HasOwnProperty(TypeName) then
+      begin
+        TypeFound := PTypeInfo(Module.RTTI[TypeName]);
+
+        Exit(GetType(TypeFound));
+      end;
+    end;
+end;
+
 { TRttiObject }
 
 function TRttiObject.GetAttributes: TCustomAttributeArray;
diff --git a/packages/rtl/typinfo.pas b/packages/rtl/typinfo.pas
index 6a3361b..81cc9a1 100644
--- a/packages/rtl/typinfo.pas
+++ b/packages/rtl/typinfo.pas
@@ -25,11 +25,17 @@ type
   TCallConv = (ccReg, ccCdecl, ccPascal, ccStdCall, ccSafeCall, ccCppdecl,
     ccFar16, ccOldFPCCall, ccInternProc, ccSysCall, ccSoftFloat, ccMWPascal);
 
+
+  { TSectionRTTI }
+  TSectionRTTI = class external name 'rtl.tSectionRTTI'(TJSObject)
+  end;
+
   { TTypeInfoModule }
 
   TTypeInfoModule = class external name 'pasmodule'
   public
     Name: String external name '$name';
+    RTTI: TSectionRTTI external name '$rtti';
   end;
 
   TTypeInfoAttributes = type TJSValueDynArray;
-- 
2.29.2.windows.2

Sven Barth

2020-12-28 16:30

developer   ~0127865

You should do a check for ModuleName + '.' as otherwise a search for Foo.Test with units Foo and FooBar (both containing a type Test) would match FooBar.Test as well (especially if unit FooBar should be listed before unit Foo).

henrique

2020-12-28 17:55

reporter   ~0127867

Correct again, fixing...

henrique

2020-12-30 18:14

reporter   ~0127949

Fixed.
0001-Busca-de-tipo-pelo-nome-3.patch (2,549 bytes)   
From 7622ac684e955c547871347a01b8c97aa33423e7 Mon Sep 17 00:00:00 2001
From: Henrique Gottardi Werlang <henriquewerlang@hotmail.com>
Date: Wed, 23 Dec 2020 16:20:24 -0300
Subject: [PATCH] Busca de tipo pelo nome.

---
 packages/rtl/rtti.pas    | 28 ++++++++++++++++++++++++++++
 packages/rtl/typinfo.pas |  6 ++++++
 2 files changed, 34 insertions(+)

diff --git a/packages/rtl/rtti.pas b/packages/rtl/rtti.pas
index 50e72ce..bfe93c6 100644
--- a/packages/rtl/rtti.pas
+++ b/packages/rtl/rtti.pas
@@ -78,6 +78,7 @@ type
     class function Create: TRTTIContext; static;
     procedure Free;
 
+    function FindType(const AQualifiedName: String): TRttiType;
     function GetType(aTypeInfo: PTypeInfo): TRTTIType; overload;
     function GetType(aClass: TClass): TRTTIType; overload;
   end;
@@ -373,6 +374,7 @@ implementation
 
 var
   GRttiContext: TRTTIContext;
+  pas: TJSObject; external name 'pas';
 
 procedure CreateVirtualCorbaInterface(InterfaceTypeInfo: Pointer;
   const MethodImplementation: TVirtualInterfaceInvokeEvent; out IntfVar); assembler;
@@ -1019,6 +1021,32 @@ begin
   Result:=GetType(TypeInfo(aClass));
 end;
 
+function TRTTIContext.FindType(const AQualifiedName: String): TRttiType;
+var
+  ModuleName, TypeName: String;
+
+  Module: TTypeInfoModule;
+
+  TypeFound: PTypeInfo;
+
+begin
+  Result := nil;
+
+  for ModuleName in TJSObject.Keys(pas) do
+    if AQualifiedName.StartsWith(ModuleName + '.') then
+    begin
+      Module := TTypeInfoModule(pas[ModuleName]);
+      TypeName := Copy(AQualifiedName, Length(ModuleName) + 2, Length(AQualifiedName));
+
+      if Module.RTTI.HasOwnProperty(TypeName) then
+      begin
+        TypeFound := PTypeInfo(Module.RTTI[TypeName]);
+
+        Exit(GetType(TypeFound));
+      end;
+    end;
+end;
+
 { TRttiObject }
 
 function TRttiObject.GetAttributes: TCustomAttributeArray;
diff --git a/packages/rtl/typinfo.pas b/packages/rtl/typinfo.pas
index 6a3361b..81cc9a1 100644
--- a/packages/rtl/typinfo.pas
+++ b/packages/rtl/typinfo.pas
@@ -25,11 +25,17 @@ type
   TCallConv = (ccReg, ccCdecl, ccPascal, ccStdCall, ccSafeCall, ccCppdecl,
     ccFar16, ccOldFPCCall, ccInternProc, ccSysCall, ccSoftFloat, ccMWPascal);
 
+
+  { TSectionRTTI }
+  TSectionRTTI = class external name 'rtl.tSectionRTTI'(TJSObject)
+  end;
+
   { TTypeInfoModule }
 
   TTypeInfoModule = class external name 'pasmodule'
   public
     Name: String external name '$name';
+    RTTI: TSectionRTTI external name '$rtti';
   end;
 
   TTypeInfoAttributes = type TJSValueDynArray;
-- 
2.29.2.windows.2

henrique

2021-01-05 12:56

reporter   ~0128089

It's okey now?

henrique

2021-01-11 12:23

reporter   ~0128261

😢

Michael Van Canneyt

2021-01-11 12:49

administrator   ~0128263

Patience please, I have exams of Chinese this week, that currently has top priority.
I will look at this and the other reports after that.

Michael Van Canneyt

2021-01-23 11:37

administrator   ~0128509

Checked and applied the patch, thank you very much !

Issue History

Date Modified Username Field Change
2020-12-23 20:48 henrique New Issue
2020-12-23 20:48 henrique File Added: 0001-Busca-de-tipo-pelo-nome.patch
2020-12-23 22:01 Mattias Gaertner Assigned To => Michael Van Canneyt
2020-12-23 22:01 Mattias Gaertner Status new => assigned
2020-12-24 18:14 Sven Barth Note Added: 0127791
2020-12-28 12:02 henrique Note Added: 0127851
2020-12-28 15:12 henrique Note Added: 0127862
2020-12-28 15:12 henrique File Added: 0001-Busca-de-tipo-pelo-nome-2.patch
2020-12-28 16:30 Sven Barth Note Added: 0127865
2020-12-28 17:55 henrique Note Added: 0127867
2020-12-30 18:14 henrique Note Added: 0127949
2020-12-30 18:14 henrique File Added: 0001-Busca-de-tipo-pelo-nome-3.patch
2021-01-05 12:56 henrique Note Added: 0128089
2021-01-11 12:23 henrique Note Added: 0128261
2021-01-11 12:49 Michael Van Canneyt Note Added: 0128263
2021-01-23 11:37 Michael Van Canneyt Status assigned => resolved
2021-01-23 11:37 Michael Van Canneyt Resolution open => fixed
2021-01-23 11:37 Michael Van Canneyt Fixed in Version => trunk
2021-01-23 11:37 Michael Van Canneyt Fixed in Revision => 1069
2021-01-23 11:37 Michael Van Canneyt Note Added: 0128509