* Patch from Henrique Werlang to fix RTTI info and improve readability (Bug ID 37655)

This commit is contained in:
michael 2020-08-28 17:12:23 +00:00
parent 15fc4fd5c1
commit b141aed060

View File

@ -110,11 +110,14 @@ type
FTypeInfo: TTypeMember; FTypeInfo: TTypeMember;
FParent: TRttiType; FParent: TRttiType;
protected protected
function GetMemberTypeInfo: TTypeMember;
function GetName: string; override; function GetName: string; override;
function GetVisibility: TMemberVisibility; virtual; function GetVisibility: TMemberVisibility; virtual;
public public
constructor Create(AParent: TRttiType; ATypeInfo: TTypeMember); constructor Create(AParent: TRttiType; ATypeInfo: TTypeMember);
function GetAttributes: TCustomAttributeArray; override; function GetAttributes: TCustomAttributeArray; override;
property MemberTypeInfo: TTypeMember read GetMemberTypeInfo;
property Visibility: TMemberVisibility read GetVisibility; property Visibility: TMemberVisibility read GetVisibility;
property Parent: TRttiType read FParent; property Parent: TRttiType read FParent;
end; end;
@ -136,6 +139,7 @@ type
TRttiMethod = class(TRttiMember) TRttiMethod = class(TRttiMember)
private private
function GetMethodTypeInfo: TTypeMemberMethod;
function GetIsClassMethod: boolean; function GetIsClassMethod: boolean;
function GetIsConstructor: boolean; function GetIsConstructor: boolean;
function GetIsDestructor: boolean; function GetIsDestructor: boolean;
@ -145,6 +149,7 @@ type
function GetMethodKind: TMethodKind; function GetMethodKind: TMethodKind;
function GetReturnType: TRttiType; function GetReturnType: TRttiType;
public public
property MethodTypeInfo: TTypeMemberMethod read GetMethodTypeInfo;
property ReturnType: TRttiType read GetReturnType; property ReturnType: TRttiType read GetReturnType;
property MethodKind: TMethodKind read GetMethodKind; property MethodKind: TMethodKind read GetMethodKind;
property IsConstructor: boolean read GetIsConstructor; property IsConstructor: boolean read GetIsConstructor;
@ -161,14 +166,17 @@ type
TRttiProperty = class(TRttiMember) TRttiProperty = class(TRttiMember)
private private
function GetPropertyTypeInfo: TTypeMemberProperty;
function GetPropertyType: TRttiType; function GetPropertyType: TRttiType;
function GetIsWritable: boolean; function GetIsWritable: boolean;
function GetIsReadable: boolean; function GetIsReadable: boolean;
protected protected
function GetVisibility: TMemberVisibility; override; function GetVisibility: TMemberVisibility; override;
public public
constructor Create(AParent: TRttiType; ATypeInfo: TTypeMember);
function GetValue(Instance: TObject): TValue; function GetValue(Instance: TObject): TValue;
procedure SetValue(Instance: TObject; const AValue: TValue); procedure SetValue(Instance: TObject; const AValue: TValue);
property PropertyTypeInfo: TTypeMemberProperty read GetPropertyTypeInfo;
property PropertyType: TRttiType read GetPropertyType; property PropertyType: TRttiType read GetPropertyType;
property IsReadable: boolean read GetIsReadable; property IsReadable: boolean read GetIsReadable;
property IsWritable: boolean read GetIsWritable; property IsWritable: boolean read GetIsWritable;
@ -749,7 +757,11 @@ end;
constructor TRttiMember.Create(AParent: TRttiType; ATypeInfo: TTypeMember); constructor TRttiMember.Create(AParent: TRttiType; ATypeInfo: TTypeMember);
begin begin
if not (ATypeInfo is TTypeMember) then
raise EInvalidCast.Create('');
inherited Create(); inherited Create();
FParent := AParent; FParent := AParent;
FTypeInfo:=ATypeInfo; FTypeInfo:=ATypeInfo;
end; end;
@ -759,6 +771,11 @@ begin
Result:=inherited GetAttributes; Result:=inherited GetAttributes;
end; end;
function TRttiMember.GetMemberTypeInfo: TTypeMember;
begin
Result := TTypeMember(FTypeInfo);
end;
{ TRttiField } { TRttiField }
function TRttiField.GetFieldType: TRttiType; function TRttiField.GetFieldType: TRttiType;
@ -768,71 +785,89 @@ end;
{ TRttiMethod } { TRttiMethod }
function TRttiMethod.GetMethodTypeInfo: TTypeMemberMethod;
begin
Result := TTypeMemberMethod(FTypeInfo);
end;
function TRttiMethod.GetIsClassMethod: boolean; function TRttiMethod.GetIsClassMethod: boolean;
begin begin
Result:=TTypeMemberMethod(FTypeInfo).MethodKind in [mkClassFunction,mkClassProcedure]; Result:=MethodTypeInfo.MethodKind in [mkClassFunction,mkClassProcedure];
end; end;
function TRttiMethod.GetIsConstructor: boolean; function TRttiMethod.GetIsConstructor: boolean;
begin begin
Result:=TTypeMemberMethod(FTypeInfo).MethodKind=mkConstructor; Result:=MethodTypeInfo.MethodKind=mkConstructor;
end; end;
function TRttiMethod.GetIsDestructor: boolean; function TRttiMethod.GetIsDestructor: boolean;
begin begin
Result:=TTypeMemberMethod(FTypeInfo).MethodKind=mkDestructor; Result:=MethodTypeInfo.MethodKind=mkDestructor;
end; end;
function TRttiMethod.GetIsExternal: boolean; function TRttiMethod.GetIsExternal: boolean;
begin begin
Result:=(TTypeMemberMethod(FTypeInfo).ProcSig.Flags and 4)>0; // pfExternal Result:=(MethodTypeInfo.ProcSig.Flags and 4)>0; // pfExternal
end; end;
function TRttiMethod.GetIsStatic: boolean; function TRttiMethod.GetIsStatic: boolean;
begin begin
Result:=(TTypeMemberMethod(FTypeInfo).ProcSig.Flags and 1)>0; // pfStatic Result:=(MethodTypeInfo.ProcSig.Flags and 1)>0; // pfStatic
end; end;
function TRttiMethod.GetIsVarArgs: boolean; function TRttiMethod.GetIsVarArgs: boolean;
begin begin
Result:=(TTypeMemberMethod(FTypeInfo).ProcSig.Flags and 2)>0; // pfVarargs Result:=(MethodTypeInfo.ProcSig.Flags and 2)>0; // pfVarargs
end; end;
function TRttiMethod.GetMethodKind: TMethodKind; function TRttiMethod.GetMethodKind: TMethodKind;
begin begin
Result:=TTypeMemberMethod(FTypeInfo).MethodKind;; Result:=MethodTypeInfo.MethodKind;;
end; end;
function TRttiMethod.GetReturnType: TRttiType; function TRttiMethod.GetReturnType: TRttiType;
begin begin
Result := GRttiContext.GetType(TTypeMemberMethod(FTypeInfo).ProcSig.ResultType); Result := GRttiContext.GetType(MethodTypeInfo.ProcSig.ResultType);
end; end;
{ TRttiProperty } { TRttiProperty }
constructor TRttiProperty.Create(AParent: TRttiType; ATypeInfo: TTypeMember);
begin
if not (ATypeInfo is TTypeMemberProperty) then
raise EInvalidCast.Create('');
inherited;
end;
function TRttiProperty.GetPropertyTypeInfo: TTypeMemberProperty;
begin
Result := TTypeMemberProperty(FTypeInfo);
end;
function TRttiProperty.GetValue(Instance: TObject): TValue; function TRttiProperty.GetValue(Instance: TObject): TValue;
begin begin
Result := TValue.FromJSValue(GetJSValueProp(Instance, TTypeMemberProperty(FTypeInfo))); Result := TValue.FromJSValue(GetJSValueProp(Instance, PropertyTypeInfo));
end; end;
procedure TRttiProperty.SetValue(Instance: TObject; const AValue: TValue); procedure TRttiProperty.SetValue(Instance: TObject; const AValue: TValue);
begin begin
SetJSValueProp(Instance, TTypeMemberProperty(FTypeInfo), AValue); SetJSValueProp(Instance, PropertyTypeInfo, AValue);
end; end;
function TRttiProperty.GetPropertyType: TRttiType; function TRttiProperty.GetPropertyType: TRttiType;
begin begin
Result := GRttiContext.GetType(FTypeInfo); Result := GRttiContext.GetType(PropertyTypeInfo.TypeInfo);
end; end;
function TRttiProperty.GetIsWritable: boolean; function TRttiProperty.GetIsWritable: boolean;
begin begin
Result := TTypeMemberProperty(FTypeInfo).Setter<>''; Result := PropertyTypeInfo.Setter<>'';
end; end;
function TRttiProperty.GetIsReadable: boolean; function TRttiProperty.GetIsReadable: boolean;
begin begin
Result := TTypeMemberProperty(FTypeInfo).Getter<>''; Result := PropertyTypeInfo.Getter<>'';
end; end;
function TRttiProperty.GetVisibility: TMemberVisibility; function TRttiProperty.GetVisibility: TMemberVisibility;