paweld/pas2js
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/pas2js.git synced 2025-08-17 15:09:06 +02:00
Code Issues Packages Projects Releases Wiki Activity

rtl: fixed TRttiMethod.LoadParameters flags, issue 38823, from Henrique Gottardi Werlang

Browse Source
This commit is contained in:
mattias 2021-04-30 09:19:57 +00:00
parent 0dd3a997c1
commit a3b1d0b22a
1 changed files with 23 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
packages/rtl/rtti.pas
View File

@ -146,6 +146,8 @@ type
TRttiFieldArray = specialize TArray<TRttiField>; TRttiFieldArray = specialize TArray<TRttiField>;
{ TRttiParameter }
TRttiParameter = class(TRttiNamedObject) TRttiParameter = class(TRttiNamedObject)
private private
FParamType: TRttiType; FParamType: TRttiType;
@ -165,6 +167,7 @@ type
TRttiMethod = class(TRttiMember) TRttiMethod = class(TRttiMember)
private private
FParameters: TRttiParameterArray; FParameters: TRttiParameterArray;
FParametersLoaded: Boolean;
function GetIsAsyncCall: Boolean; function GetIsAsyncCall: Boolean;
function GetIsClassMethod: Boolean; function GetIsClassMethod: Boolean;
@ -1373,10 +1376,12 @@ end;
function TRttiMethod.GetProcedureFlags: TProcedureFlags; function TRttiMethod.GetProcedureFlags: TProcedureFlags;
const const
PROCEDURE_FLAGS: array of NativeInt = (1, 2, 4, 8, 16); PROCEDURE_FLAGS: array[TProcedureFlag] of NativeInt = (1, 2, 4, 8, 16);
var var
Flag, ProcedureFlags: NativeInt; Flag: TProcedureFlag;
ProcedureFlags: NativeInt;
begin begin
ProcedureFlags := MethodTypeInfo.ProcSig.Flags; ProcedureFlags := MethodTypeInfo.ProcSig.Flags;
@ -1384,7 +1389,7 @@ begin
for Flag := Low(PROCEDURE_FLAGS) to High(PROCEDURE_FLAGS) do for Flag := Low(PROCEDURE_FLAGS) to High(PROCEDURE_FLAGS) do
if PROCEDURE_FLAGS[Flag] and ProcedureFlags > 0 then if PROCEDURE_FLAGS[Flag] and ProcedureFlags > 0 then
Result := Result + [TProcedureFlag(Flag)]; Result := Result + [Flag];
end; end;
function TRttiMethod.GetReturnType: TRttiType; function TRttiMethod.GetReturnType: TRttiType;
@ -1394,28 +1399,35 @@ end;
procedure TRttiMethod.LoadParameters; procedure TRttiMethod.LoadParameters;
const const
FLAGS_CONVERSION: array[TParamFlag] of Integer = (1, 2, 4, 8, 16, 32); FLAGS_CONVERSION: array[TParamFlag] of NativeInt = (1, 2, 4, 8, 16, 32);
var var
A, Flag: Integer; A: Integer;
Flag: TParamFlag;
Param: TProcedureParam; Param: TProcedureParam;
RttiParam: TRttiParameter; RttiParam: TRttiParameter;
MethodParams: TProcedureParams;
begin begin
SetLength(FParameters, Length(MethodTypeInfo.ProcSig.Params)); FParametersLoaded := True;
MethodParams := MethodTypeInfo.ProcSig.Params;
SetLength(FParameters, Length(MethodParams));
for A := Low(FParameters) to High(FParameters) do for A := Low(FParameters) to High(FParameters) do
begin begin
Param := MethodTypeInfo.ProcSig.Params[A]; Param := MethodParams[A];
RttiParam := TRttiParameter.Create; RttiParam := TRttiParameter.Create;
RttiParam.FName := Param.Name; RttiParam.FName := Param.Name;
RttiParam.FParamType := GRttiContext.GetType(Param.TypeInfo); RttiParam.FParamType := GRttiContext.GetType(Param.TypeInfo);
for Flag in FLAGS_CONVERSION do for Flag := Low(FLAGS_CONVERSION) to High(FLAGS_CONVERSION) do
if Flag and Param.Flags > 0 then if FLAGS_CONVERSION[Flag] and Param.Flags > 0 then
RttiParam.FFlags := RttiParam.FFlags + [TParamFlag(A)]; RttiParam.FFlags := RttiParam.FFlags + [Flag];
FParameters[A] := RttiParam; FParameters[A] := RttiParam;
end; end;
@ -1423,7 +1435,7 @@ end;
function TRttiMethod.GetParameters: TRttiParameterArray; function TRttiMethod.GetParameters: TRttiParameterArray;
begin begin
if not Assigned(FParameters) then if not FParametersLoaded then
LoadParameters; LoadParameters;
Result := FParameters; Result := FParameters;