Forráskód Böngészése

Create the class for the RTTI pointer type.

Henrique Gottardi Werlang 2 éve
szülő
commit
94b7823972
3 módosított fájl, 42 hozzáadás és 6 törlés
  1. 36 3
      packages/rtl/rtti.pas
  2. 2 1
      packages/rtl/system.pas
  3. 4 2
      packages/rtl/typinfo.pas

+ 36 - 3
packages/rtl/rtti.pas

@@ -470,6 +470,19 @@ type
     property ElementType: TRttiType read GetElementType;
   end;
 
+  { TRttiPointerType }
+
+  TRttiPointerType = class(TRttiType)
+  private
+    function GetRefType: TRttiType;
+    function GetRefTypeInfo: TTypeInfoPointer;
+  public
+    constructor Create(AParent: TRttiObject; ATypeInfo: PTypeInfo); override;
+
+    property RefType: TRttiType read GetRefType;
+    property RefTypeInfo: TTypeInfoPointer read GetRefTypeInfo;
+  end;
+
   EInvoke = EJS;
 
   TVirtualInterfaceInvokeEvent = reference to procedure(Method: TRttiMethod; const Args: specialize TArray<TValue>; out Result: TValue);
@@ -623,7 +636,7 @@ var
     TRttiRecordType, // tkRecord
     TRttiInstanceType, // tkClass
     TRttiClassRefType, // tkClassRef
-    TRttiType, // tkPointer
+    TRttiPointerType, // tkPointer
     TRttiType, // tkJSValue
     TRttiType, // tkRefToProcVar
     TRttiInterfaceType, // tkInterface
@@ -1581,7 +1594,7 @@ function TRTTIContext.GetTypes: specialize TArray<TRttiType>;
 var
   ModuleName, ClassName: String;
 
-  ModuleTypes: TJSObject;
+  ModuleTypes: TSectionRTTI;
 
 begin
   for ModuleName in TJSObject.Keys(pas) do
@@ -1589,7 +1602,7 @@ begin
     ModuleTypes := TTypeInfoModule(pas[ModuleName]).RTTI;
 
     for ClassName in ModuleTypes do
-      if TJSObject(ModuleTypes[ClassName]).HasOwnProperty('name') and (ClassName[1] <> '$') then
+      if ClassName[1] <> '$' then
         GetType(PTypeInfo(ModuleTypes[ClassName]));
   end;
 
@@ -2094,6 +2107,26 @@ begin
   Result := Format('%s.%s', [DeclaringUnitName, Name]);
 end;
 
+{ TRttiPointerType }
+
+constructor TRttiPointerType.Create(AParent: TRttiObject; ATypeInfo: PTypeInfo);
+begin
+  if not (TTypeInfo(ATypeInfo) is TTypeInfoPointer) then
+    raise EInvalidCast.Create('');
+
+  inherited;
+end;
+
+function TRttiPointerType.GetRefType: TRttiType;
+begin
+  Result := Pool.GetType(RefTypeInfo.RefType);
+end;
+
+function TRttiPointerType.GetRefTypeInfo: TTypeInfoPointer;
+begin
+  Result := TTypeInfoPointer(inherited Handle);
+end;
+
 { TVirtualInterface }
 
 constructor TVirtualInterface.Create(InterfaceTypeInfo: TTypeInfoInterface);

+ 2 - 1
packages/rtl/system.pas

@@ -111,12 +111,13 @@ type
   end;
   TGUIDString = type string;
 
-  PMethod = ^TMethod;
   TMethod = record
     Code : CodePointer;
     Data : Pointer;
   end;
 
+  PMethod = ^TMethod;
+
   TClass = class of TObject;
 
   { TObject }

+ 4 - 2
packages/rtl/typinfo.pas

@@ -25,14 +25,16 @@ type
   TCallConv = (ccReg, ccCdecl, ccPascal, ccStdCall, ccSafeCall, ccCppdecl,
     ccFar16, ccOldFPCCall, ccInternProc, ccSysCall, ccSoftFloat, ccMWPascal);
 
+  TTypeInfoModule = class;
 
   { TSectionRTTI }
-  TSectionRTTI = class external name 'rtl.tSectionRTTI'(TJSObject)
+  TSectionRTTI = class external name 'rtl.tSectionRTTI' (TJSObject)
+    Module: TTypeInfoModule external name '$module';
   end;
 
   { TTypeInfoModule }
 
-  TTypeInfoModule = class external name 'pasmodule'(TJSObject)
+  TTypeInfoModule = class external name 'Object'
   public
     Name: String external name '$name';
     RTTI: TSectionRTTI external name '$rtti';