fcl-passrc: fixed overload double override

packages/fcl-passrc/src/pasresolver.pp

@@ -5059,14 +5059,15 @@ begin
         exit;
       end;
 
+    if (Data^.Found is TPasProcedure) and IsProcOverride(Proc,TPasProcedure(Data^.Found)) then
+      begin
+      // already checked the override -> skip
+      Data^.LastProc:=Proc;
+      exit;
+      end;
+
     if (Data^.LastProc<>nil) then
       begin
-      if (TPasProcedureScope(Data^.LastProc.CustomData).OverriddenProc=Proc) then
-        begin
-        // already checked the override -> skip
-        Data^.LastProc:=Proc;
-        exit;
-        end;
       if not IsProcOverloading(Data^.LastProc,Proc) then
         begin
         Abort:=true;
@@ -5079,7 +5080,7 @@ begin
       // there is already a previous proc
       PrevProc:=TPasProcedure(Data^.Found);
 
-      if (TPasProcedureScope(PrevProc.CustomData).OverriddenProc=Proc) then
+      if IsProcOverride(Proc,TPasProcedureScope(PrevProc.CustomData).OverriddenProc) then
         begin
         // already checked the override -> skip
         Data^.LastProc:=Proc;
@@ -5466,12 +5467,16 @@ begin
     begin
     // different scopes
     if DataProc.IsOverride then
+      // overrides are not overloads
     else if DataProc.IsReintroduced then
+      // reintroduce do not warn
+    else if ProcHasGroupOverload(DataProc) then
+      // overload
     else
       begin
       if Store
-          or ((Data^.FoundInSameScope=1) // missing 'overload' hints only for the first proc in a scope
-             and not ProcHasGroupOverload(DataProc)) then
+          or (Data^.FoundInSameScope=1) // missing 'overload' hints only for the first proc in a scope
+             then
         begin
         if (Data^.Kind=fpkMethod) and (Proc.IsVirtual or Proc.IsOverride) then
           // give a hint, that method hides a virtual method in ancestor
@@ -29670,6 +29675,8 @@ var
   Proc, OverriddenProc: TPasProcedure;
 begin
   Result:=false;
+  if AncestorProc=nil then exit;
+  if DescendantProc=nil then exit;
   Proc:=DescendantProc;
   if not Proc.IsOverride then exit;
   if not AncestorProc.IsOverride and not AncestorProc.IsVirtual then exit;

packages/fcl-passrc/tests/tcresolver.pas

@@ -578,6 +578,7 @@ type
     Procedure TestClass_MethodOverride;
     Procedure TestClass_MethodOverride2;
     Procedure TestClass_MethodOverrideAndOverload;
+    Procedure TestClass_MethodOverrideTwiceAndOverload;
     Procedure TestClass_MethodOverrideFixCase;
     Procedure TestClass_MethodOverrideSameResultType;
     Procedure TestClass_MethodOverrideDiffResultTypeFail;
@@ -9851,6 +9852,57 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolver.TestClass_MethodOverrideTwiceAndOverload;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode delphi}',
+  'type',
+  '  TObject = class end;',
+  '  TAnimal = class',
+  '    procedure {#a}Fly(AValue: TAnimal); overload; virtual;',
+  '  end;',
+  '  TBird = class(TAnimal)',
+  '    procedure {#b}Fly(w: word); overload; virtual;',
+  '    procedure {#c}Fly(AValue: TAnimal); overload; override;',
+  '  end;',
+  '  TEagle = class(TBird)',
+  '    procedure {#d}Fly(b: boolean); overload; virtual;',
+  '    procedure {#e}Fly(AValue: TAnimal); overload; override;',
+  '  end;',
+  'procedure TAnimal.Fly(AValue: TAnimal);',
+  'begin',
+  'end;',
+  'procedure TBird.Fly(w: word);',
+  'begin',
+  'end;',
+  'procedure TBird.Fly(AValue: TAnimal);',
+  'begin',
+  '  {@c}Fly(Self);',
+  '  {@b}Fly(3);',
+  '  inherited {@a}Fly(Self);',
+  'end;',
+  'procedure TEagle.Fly(b: boolean);',
+  'begin',
+  'end;',
+  'procedure TEagle.Fly(AValue: TAnimal);',
+  'begin',
+  '  {@e}Fly(Self);',
+  '  {@b}Fly(13);',
+  '  {@d}Fly(true);',
+  '  inherited {@c}Fly(Self);',
+  '  inherited {@b}Fly(17);',
+  'end;',
+  'var',
+  '  e: TEagle;',
+  'begin',
+  '  e.{@e}Fly(e);',
+  '  e.{@b}Fly(25);',
+  '  e.{@d}Fly(true);',
+  '']);
+  ParseProgram;
+end;
+
 procedure TTestResolver.TestClass_MethodOverrideFixCase;
 
   procedure CheckOverrideName(aLabel: string);