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

fcl-passrc: useanalyzer: fixed typeinfo(Result)

Browse Source
This commit is contained in:
mattias 2025-01-20 14:52:31 +01:00
parent 6164532196
commit 08f44aff2c
2 changed files with 39 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
packages/fcl-passrc/src/pasuseanalyzer.pas
View File

@ -1308,6 +1308,8 @@ begin
if (El is TPasFunctionType) and (TPasFunctionType(El).ResultEl<>nil) then if (El is TPasFunctionType) and (TPasFunctionType(El).ResultEl<>nil) then
UseSubEl(TPasFunctionType(El).ResultEl.ResultType); UseSubEl(TPasFunctionType(El).ResultEl.ResultType);
end end
else if C=TPasResultElement then
UseSubEl(TPasResultElement(El).ResultType)
else if C=TPasSpecializeType then else if C=TPasSpecializeType then
begin begin
SpecType:=TPasSpecializeType(El); SpecType:=TPasSpecializeType(El);

37
packages/fcl-passrc/tests/tcuseanalyzer.pas
View File

@ -87,6 +87,7 @@ type
procedure TestM_Class_MethodOverride; procedure TestM_Class_MethodOverride;
procedure TestM_Class_MethodOverride2; procedure TestM_Class_MethodOverride2;
procedure TestM_Class_NestedClass; procedure TestM_Class_NestedClass;
procedure TestM_Class_Function;
procedure TestM_ClassInterface_Corba; procedure TestM_ClassInterface_Corba;
procedure TestM_ClassInterface_NoHintsForMethod; procedure TestM_ClassInterface_NoHintsForMethod;
procedure TestM_ClassInterface_NoHintsForImpl; procedure TestM_ClassInterface_NoHintsForImpl;
@ -1360,6 +1361,42 @@ begin
CheckUseAnalyzerUnexpectedHints; CheckUseAnalyzerUnexpectedHints;
end; end;
procedure TTestUseAnalyzer.TestM_Class_Function;
begin
Parser.Options:=Parser.Options+[po_CheckDirectiveRTTI];
StartUnit(true,[supTObject]);
Add([
'{$mode objfpc}',
'{$RTTI explicit methods([vcPublic])}',
'interface',
'type',
' TInterfacedObject = class',
' end;',
' IUnknown = interface',
' end;',
' ITestInterface = interface',
' procedure Test1;',
' function Test2: word;',
' end;',
' TTestInterfaceClass = class(TInterfacedObject, ITestInterface)',
' public',
' procedure Test1;',
' function Test2: word;',
' end;',
'implementation',
'procedure TTestInterfaceClass.Test1;',
'begin',
'end;',
'function TTestInterfaceClass.Test2: word;',
'begin',
' Result:=0;',
' if typeinfo(Result)<>nil then ;',
'end;',
'']);
AnalyzeUnit;
CheckUseAnalyzerUnexpectedHints;
end;
procedure TTestUseAnalyzer.TestM_ClassInterface_Corba; procedure TTestUseAnalyzer.TestM_ClassInterface_Corba;
begin begin
StartProgram(false); StartProgram(false);