paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-21 20:29:32 +02:00
Code Issues Packages Projects Releases Wiki Activity

fcl-passrc: resolver: emit nMethodHidesMethodOfBaseType only for virtuals

Browse Source 
git-svn-id: trunk@37721 -
This commit is contained in:
Mattias Gaertner 2017-12-12 13:10:02 +00:00
parent 87d020c07b
commit a423d6be91
2 changed files with 23 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
packages/fcl-passrc/src/pasresolver.pp
View File

@ -3187,12 +3187,14 @@ begin
and not ProcHasGroupOverload(Data^.Proc)) then
begin
// give a hint, that proc is hiding a proc in other scope
if Data^.Kind=fopkMethod then
if (Data^.Kind=fopkMethod) and (Proc.IsVirtual or Proc.IsOverride) then
LogMsg(20170216151712,mtWarning,nMethodHidesMethodOfBaseType,
sMethodHidesMethodOfBaseType,
[Data^.Proc.Name,Proc.Parent.Name,GetElementSourcePosStr(Proc)],Data^.Proc.ProcType)
else
LogMsg(20171118214523,mtHint,nFunctionHidesIdentifier,sFunctionHidesIdentifier,
// Delphi/FPC do not give a message when hiding a non virtual method
// -> emit only an Info
LogMsg(20171118214523,mtInfo,nFunctionHidesIdentifier,sFunctionHidesIdentifier,
[GetElementSourcePosStr(Proc)],Data^.Proc.ProcType);
Abort:=true;
end;

19
packages/fcl-passrc/tests/tcresolver.pas
View File

@ -422,6 +422,7 @@ type
Procedure TestClass_MethodOverloadMissingInDelphi;
Procedure TestClass_MethodOverloadAncestor;
Procedure TestClass_MethodOverloadUnit;
Procedure TestClass_MethodOverloadNonVirtualInfo;
Procedure TestClass_MethodReintroduce;
Procedure TestClass_MethodOverloadArrayOfTClass;
Procedure TestClass_ConstructorHidesAncestorWarning;
@ -6556,6 +6557,24 @@ begin
CheckResolverUnexpectedHints;
end;
procedure TTestResolver.TestClass_MethodOverloadNonVirtualInfo;
begin
StartProgram(false);
Add([
'type',
' TObject = class',
' procedure DoIt(p: pointer);',
' end;',
' TBird = class',
' procedure DoIt(i: longint);',
' end;',
'procedure TObject.DoIt(p: pointer); begin end;',
'procedure TBird.DoIt(i: longint); begin end;',
'begin']);
ParseProgram;
CheckResolverHint(mtInfo,nFunctionHidesIdentifier,'function hides identifier at "afile.pp(4,19)"');
end;
procedure TTestResolver.TestClass_MethodReintroduce;
begin
StartProgram(false);