Browse Source

+ add base types for the RTTI of methods and parameters

git-svn-id: trunk@37756 -
svenbarth 7 years ago
parent
commit
28640ba350
1 changed files with 150 additions and 0 deletions
  1. 150 0
      packages/rtl-objpas/src/inc/rtti.pp

+ 150 - 0
packages/rtl-objpas/src/inc/rtti.pp

@@ -267,6 +267,59 @@ type
     property Visibility: TMemberVisibility read GetVisibility;
   end;
 
+  TRttiParameter = class(TRttiNamedObject)
+  private
+    FString: String;
+  protected
+    function GetParamType: TRttiType; virtual; abstract;
+    function GetFlags: TParamFlags; virtual; abstract;
+  public
+    property ParamType: TRttiType read GetParamType;
+    property Flags: TParamFlags read GetFlags;
+    function ToString: String; override;
+  end;
+
+  TDispatchKind = (
+    dkStatic,
+    dkVtable,
+    dkDynamic,
+    dkMessage,
+    dkInterface,
+    { the following are FPC-only and will be moved should Delphi add more }
+    dkMessageString
+  );
+
+  TRttiMethod = class(TRttiMember)
+  private
+    FString: String;
+  protected
+    function GetCallingConvention: TCallConv; virtual; abstract;
+    function GetCodeAddress: CodePointer; virtual; abstract;
+    function GetDispatchKind: TDispatchKind; virtual; abstract;
+    function GetHasExtendedInfo: Boolean; virtual;
+    function GetIsClassMethod: Boolean; virtual; abstract;
+    function GetIsConstructor: Boolean; virtual; abstract;
+    function GetIsDestructor: Boolean; virtual; abstract;
+    function GetIsStatic: Boolean; virtual; abstract;
+    function GetMethodKind: TMethodKind; virtual; abstract;
+    function GetReturnType: TRttiType; virtual; abstract;
+    function GetVirtualIndex: SmallInt; virtual; abstract;
+  public
+    property CallingConvention: TCallConv read GetCallingConvention;
+    property CodeAddress: CodePointer read GetCodeAddress;
+    property DispatchKind: TDispatchKind read GetDispatchKind;
+    property HasExtendedInfo: Boolean read GetHasExtendedInfo;
+    property IsClassMethod: Boolean read GetIsClassMethod;
+    property IsConstructor: Boolean read GetIsConstructor;
+    property IsDestructor: Boolean read GetIsDestructor;
+    property IsStatic: Boolean read GetIsStatic;
+    property MethodKind: TMethodKind read GetMethodKind;
+    property ReturnType: TRttiType read GetReturnType;
+    property VirtualIndex: SmallInt read GetVirtualIndex;
+    function ToString: String; override;
+    function GetParameters: specialize TArray<TRttiParameter>; virtual; abstract;
+  end;
+
   TRttiStructuredType = class(TRttiType)
 
   end;
@@ -1737,6 +1790,103 @@ begin
   Make(@AValue, System.TypeInfo(AValue), Result);
 end;
 
+{ TRttiParameter }
+
+function TRttiParameter.ToString: String;
+var
+  f: TParamFlags;
+  n: String;
+  t: TRttiType;
+begin
+  if FString = '' then begin
+    f := Flags;
+
+    if pfVar in f then
+      FString := 'var'
+    else if pfConst in f then
+      FString := 'const'
+    else if pfOut in f then
+      FString := 'out'
+    else if pfConstRef in f then
+      FString := 'constref';
+    if FString <> '' then
+      FString := FString + ' ';
+
+    n := Name;
+    if n = '' then
+      n := '<unknown>';
+    FString := FString + n;
+
+    t := ParamType;
+    if Assigned(t) then begin
+      FString := FString + ': ';
+      if pfArray in flags then
+        FString := 'array of ';
+      FString := FString + t.Name;
+    end;
+  end;
+
+  Result := FString;
+end;
+
+{ TRttiMethod }
+
+function TRttiMethod.GetHasExtendedInfo: Boolean;
+begin
+  Result := False;
+end;
+
+function TRttiMethod.ToString: String;
+var
+  ret: TRttiType;
+  n: String;
+  params: specialize TArray<TRttiParameter>;
+  i: LongInt;
+begin
+  if FString = '' then begin
+    n := Name;
+    if n = '' then
+      n := '<unknown>';
+    if not HasExtendedInfo then begin
+      FString := 'method ' + n;
+    end else begin
+      ret := ReturnType;
+
+      if IsClassMethod then
+        FString := 'class ';
+      if IsConstructor then
+        FString := FString + 'constructor'
+      else if IsDestructor then
+        FString := FString + 'destructor'
+      else if Assigned(ret) then
+        FString := FString + 'function'
+      else
+        FString := FString + 'procedure';
+
+      FString := FString + ' ' + n;
+
+      params := GetParameters;
+      if Length(params) > 0 then begin
+        FString := FString + '(';
+        for i := 0 to High(params) do begin
+          if i > 0 then
+            FString := FString + '; ';
+          FString := FString + params[i].ToString;
+        end;
+        FString := FString + ')';
+      end;
+
+      if Assigned(ret) then
+        FString := FString + ': ' + ret.Name;
+
+      if IsStatic then
+        FString := FString + '; static';
+    end;
+  end;
+
+  Result := FString;
+end;
+
 { TRttiStringType }
 
 function TRttiStringType.GetStringKind: TRttiStringKind;