fcl-passrc: separate hint for method hides ancestor method exactly

git-svn-id: trunk@41713 -

packages/fcl-passrc/src/pasresolveeval.pas

@@ -188,6 +188,7 @@ const
   nAttributeIgnoredBecauseAbstractX = 3122;
   nCreatingAnInstanceOfAbstractClassY = 3123;
   nIllegalExpressionAfterX = 3124;
+  nMethodHidesNonVirtualMethodExactly = 3125;
 
   // using same IDs as FPC
   nVirtualMethodXHasLowerVisibility = 3250; // was 3050
@@ -323,6 +324,7 @@ resourcestring
   sAttributeIgnoredBecauseAbstractX = 'attribute ignored because abstract %s';
   sCreatingAnInstanceOfAbstractClassY = 'Creating an instance of abstract class "%s"';
   sIllegalExpressionAfterX = 'illegal expression after %s';
+  sMethodHidesNonVirtualMethodExactly = 'method hides identifier at "%s". Use reintroduce';
 
 type
   { TResolveData - base class for data stored in TPasElement.CustomData }

packages/fcl-passrc/src/pasresolver.pp

@@ -4820,6 +4820,13 @@ begin
               else if (Proc is TPasConstructor)
                   and (Data^.Proc.ClassType=Proc.ClassType) then
                 // do not give a hint for hiding a constructor
+              else if Store then
+                begin
+                // method hides ancestor method with same signature
+                LogMsg(20190316152656,mtHint,
+                  nMethodHidesNonVirtualMethodExactly,sMethodHidesNonVirtualMethodExactly,
+                  [GetElementSourcePosStr(Proc)],Data^.Proc.ProcType);
+                end
               else
                 begin
                 //writeln('TPasResolver.OnFindProc Proc=',Proc.PathName,' Data^.Proc=',Data^.Proc.PathName,' ',Proc.Visibility);

packages/fcl-passrc/tests/tcresolver.pas

@@ -557,6 +557,7 @@ type
     Procedure TestClass_MethodOverloadUnit;
     Procedure TestClass_HintMethodHidesNonVirtualMethod;
     Procedure TestClass_HintMethodHidesNonVirtualMethodWithoutBody_NoHint;
+    Procedure TestClass_HintMethodHidesNonVirtualMethodExact;
     Procedure TestClass_NoHintMethodHidesPrivateMethod;
     Procedure TestClass_MethodReintroduce;
     Procedure TestClass_MethodOverloadArrayOfTClass;
@@ -9509,6 +9510,31 @@ begin
   CheckResolverUnexpectedHints(true);
 end;
 
+procedure TTestResolver.TestClass_HintMethodHidesNonVirtualMethodExact;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch externalclass}',
+  'type',
+  '  TJSObject = class external name ''JSObject''',
+  '    procedure DoIt(p: pointer);',
+  '  end;',
+  '  TBird = class external name ''Bird''(TJSObject)',
+  '    procedure DoIt(p: pointer);',
+  '  end;',
+  'procedure TJSObject.DoIt(p: pointer);',
+  'begin',
+  '  if p=nil then ;',
+  'end;',
+  'procedure TBird.DoIt(p: pointer); begin end;',
+  'var b: TBird;',
+  'begin',
+  '  b.DoIt(nil);']);
+  ParseProgram;
+  CheckResolverHint(mtHint,nMethodHidesNonVirtualMethodExactly,
+   'method hides identifier at "afile.pp(5,19)". Use reintroduce');
+end;
+
 procedure TTestResolver.TestClass_NoHintMethodHidesPrivateMethod;
 begin
   AddModuleWithIntfImplSrc('unit2.pas',
@@ -12967,7 +12993,8 @@ begin
   '  end;',
   'begin']);
   ParseProgram;
-  CheckResolverHint(mtHint,nFunctionHidesIdentifier_NonVirtualMethod,'function hides identifier at "afile.pp(4,19)". Use overload or reintroduce');
+  CheckResolverHint(mtHint,nMethodHidesNonVirtualMethodExactly,
+    'method hides identifier at "afile.pp(4,19)". Use reintroduce');
 end;
 
 procedure TTestResolver.TestClassInterface_OverloadNoHint;