mirror of
https://gitlab.com/freepascal.org/fpc/pas2js.git
synced 2025-08-17 16:19:08 +02:00
* Patch from Henrique Werlang to fix RTTI info and improve readability (Bug ID 37655)
This commit is contained in:
parent
15fc4fd5c1
commit
b141aed060
@ -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;
|
||||||
|
Loading…
Reference in New Issue
Block a user