paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-05 11:38:19 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Correctly pass UsePublishedOnly on to sub-contexts. Fixes issue #40828

Browse Source
This commit is contained in:
Michaël Van Canneyt 2024-07-24 18:07:09 +02:00
parent fef7d7b683
commit 342d3338e5
2 changed files with 42 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
packages/rtl-objpas/src/inc/rtti.pp
View File

@ -4590,7 +4590,7 @@ begin
if not Assigned(IntfData^.Parent) then
Exit(Nil);
context := TRttiContext.Create;
context := TRttiContext.Create(FUsePublishedOnly);
try
Result := context.GetType(IntfData^.Parent^) as TRttiInterfaceType;
finally
@ -4638,7 +4638,7 @@ begin
if not Assigned(IntfData^.Parent) then
Exit(Nil);
context := TRttiContext.Create;
context := TRttiContext.Create(FUsePublishedOnly);
try
Result := context.GetType(IntfData^.Parent^) as TRttiInterfaceType;
finally
@ -4820,7 +4820,7 @@ begin
if not Assigned(FIntfMethodEntry^.ResultType) then
Exit(Nil);
context := TRttiContext.Create;
context := TRttiContext.Create(FUsePublishedOnly);
try
Result := context.GetType(FIntfMethodEntry^.ResultType^);
finally
@ -4882,7 +4882,7 @@ begin
SetLength(FParams, FIntfMethodEntry^.ParamCount);
SetLength(FParamsAll, FIntfMethodEntry^.ParamCount);
context := TRttiContext.Create;
context := TRttiContext.Create(FUsePublishedOnly);
try
total := 0;
visible := 0;
@ -5572,7 +5572,7 @@ begin
SetLength(FParams, visible);
if FTypeData^.ParamCount > 0 then begin
context := TRttiContext.Create;
context := TRttiContext.Create(FUsePublishedOnly);
try
paramtypes := PPPTypeInfo(AlignTypeData(ptr));
visible := 0;
@ -5716,7 +5716,7 @@ begin
if not Assigned(FTypeData^.ProcSig.ResultTypeRef) then
Exit(Nil);
context := TRttiContext.Create;
context := TRttiContext.Create(FUsePublishedOnly);
try
Result := context.GetType(FTypeData^.ProcSig.ResultTypeRef^);
finally
@ -5814,7 +5814,7 @@ begin
SetLength(fDeclaredMethods, methtable^.Count);
context := TRttiContext.Create;
context := TRttiContext.Create(FUsePublishedOnly);
try
method := methtable^.Method[0];
count := methtable^.Count;
@ -6021,9 +6021,8 @@ begin
FreeMem(Tbl);
exit;
end;
Ctx:=TRttiContext.Create;
Ctx:=TRttiContext.Create(FUsePublishedOnly);
try
Ctx.UsePublishedOnly:=False;
For I:=0 to Len-1 do
begin
aData:=Tbl^[i];
@ -6167,9 +6166,8 @@ Var
Ctx : TRttiContext;
begin
Ctx:=TRttiContext.Create;
Ctx:=TRttiContext.Create(FUsePublishedOnly);
try
Ctx.UsePublishedOnly:=False;
FMethodsResolved:=True;
Len:=GetMethodList(FTypeInfo,Tbl,[]);
if not FUsePublishedOnly then
@ -6934,6 +6932,7 @@ begin
if not Assigned(FContextToken) then
FContextToken := TPoolToken.Create(UsePublishedOnly);
(FContextToken as IPooltoken).RttiPool.AddObject(AObject);
AObject.FUsePublishedOnly := UsePublishedOnly;
end;
function TRttiContext.GetType(ATypeInfo: PTypeInfo): TRttiType;

32
tests/webtbs/tw40828.pp Normal file
View File

@ -0,0 +1,32 @@
program tw40828;
{$ifdef fpc}
{$mode delphi}
{$endif}
uses
SysUtils, Rtti;
type
TCurrencyHandler = procedure (Sender: TObject; Cur: Currency) of object;
procedure DoTest;
var
Context: TRttiContext;
Ty: TRttiType;
P: TRttiParameter;
begin
Context := TRttiContext.Create(True);
try
Ty := Context.GetType(TypeInfo(TCurrencyHandler));
for P in (Ty as TRttiMethodType).GetParameters() do
WriteLn(P.Name, ': ', P.ParamType.Name);
finally
Context.Free;
end;
end;
begin
DoTest;
WriteLn('OK');
end.