fcl-passrc: fixed searching overload in mode delphi

packages/fcl-passrc/src/pasresolver.pp

@@ -1556,8 +1556,8 @@ type
       TFindCallElData = record
         Params: TParamsExpr;
         TemplCnt: integer;
-        Found: TPasElement; // TPasProcedure or TPasUnresolvedSymbolRef(built in proc) or TPasType (typecast)
+        Found: TPasElement; // TPasProcedure or TPasUnresolvedSymbolRef(built in proc) or TPasType (typecast), best candidate so far
-        LastProc: TPasProcedure;
+        LastProc: TPasProcedure; // last checked TPasProcedure
         ElScope, StartScope: TPasScope;
         Distance: integer; // compatibility distance
         Count: integer;
@@ -1595,7 +1595,7 @@ type
     procedure OnFindProcDeclaration(El: TPasElement; ElScope, StartScope: TPasScope;
       FindProcData: Pointer; var Abort: boolean); virtual;
     function IsSameProcContext(ProcParentA, ProcParentB: TPasElement): boolean;
-    function IsProcOverload(LastProc, LastExactProc, CurProc: TPasProcedure): boolean;
+    function IsProcOverloading(LastProc, CurProc: TPasProcedure): boolean;
     function FindProcSameSignature(const ProcName: string; Proc: TPasProcedure;
       Scope: TPasIdentifierScope; OnlyLocal: boolean): TPasProcedure;
   protected
@@ -5018,7 +5018,7 @@ procedure TPasResolver.OnFindFirst_GenericEl(El: TPasElement; ElScope,
 var
   Data: PPRFindGenericData absolute FindFirstGenericData;
   GenericTemplateTypes: TFPList;
-  Proc, LastExactProc: TPasProcedure;
+  Proc: TPasProcedure;
   ProcScope: TPasProcedureScope;
 begin
   Proc:=nil;
@@ -5037,11 +5037,7 @@ begin
 
     if (Data^.LastProc<>nil) then
       begin
-      if Data^.Find.Found is TPasProcedure then
+      if not IsProcOverloading(Data^.LastProc,Proc) then
-        LastExactProc:=TPasProcedure(Data^.Find.Found)
-      else
-        LastExactProc:=nil;
-      if not IsProcOverload(Data^.LastProc,LastExactProc,Proc) then
         begin
         Abort:=true;
         exit;
@@ -5126,11 +5122,40 @@ begin
       El:=Proc;
       end;
 
+    if (msDelphi in ProcScope.ModeSwitches) and not IsProcOverload(Proc) then
+      begin
+      Abort:=true; // stop searching after this proc
+      if Data^.LastProc<>nil then
+        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;
+        exit;
+        end;
+      end;
+
     if Data^.Found is TPasProcedure then
       begin
       // there is already a previous proc
       PrevProc:=TPasProcedure(Data^.Found);
 
+      if (TPasProcedureScope(PrevProc.CustomData).OverriddenProc=Proc) then
+        begin
+        // already checked the override -> skip
+        Data^.LastProc:=Proc;
+        exit;
+        end;
+
       if (Data^.Distance=cExact) and (PrevProc.Parent<>Proc.Parent)
           and (PrevProc.Parent.ClassType=TPasClassType) then
         begin
@@ -5138,18 +5163,8 @@ begin
         Abort:=true;
         exit;
         end;
-
-      if not IsProcOverload(Data^.LastProc,PrevProc,Proc) then
-        begin
-        Abort:=true;
-        exit;
-        end;
-
       end;
 
-    if (msDelphi in ProcScope.ModeSwitches) and not IsProcOverload(Proc) then
-      Abort:=true; // stop searching after this proc
-
     CandidateFound:=true;
     if Data^.TemplCnt>0 then
       begin
@@ -5639,8 +5654,8 @@ begin
   Result:=false;
 end;
 
-function TPasResolver.IsProcOverload(LastProc, LastExactProc,
+function TPasResolver.IsProcOverloading(LastProc, CurProc: TPasProcedure
-  CurProc: TPasProcedure): boolean;
+  ): boolean;
 begin
   if msDelphi in TPasProcedureScope(LastProc.CustomData).ModeSwitches then
     begin
@@ -5660,13 +5675,6 @@ begin
       end;
     end;
 
-  // check if previous found proc is override of found proc
-  if (LastExactProc<>nil) and IsProcOverride(CurProc,LastExactProc) then
-    begin
-    // previous found proc is override of found proc -> skip
-    exit(false);
-    end;
-
   Result:=true;
 end;
 

packages/fcl-passrc/tests/tcresolver.pas

@@ -431,6 +431,7 @@ type
     Procedure TestProcOverloadObjFPCUnitWithoutOverloadMod;
     Procedure TestProcOverloadDelphiWithObjFPC;
     Procedure TestProcOverloadDelphiOverride;
+    Procedure TestProcOverloadDelphiOverrideOne;
     Procedure TestProcDuplicate;
     Procedure TestNestedProc;
     Procedure TestNestedProc_ResultString;
@@ -7085,6 +7086,45 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolver.TestProcOverloadDelphiOverrideOne;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode delphi}',
+  'type',
+  '  TObject = class',
+  '    constructor Create(b: boolean); virtual;',
+  '  end;',
+  '  TBird = class',
+  '    // add first an overload',
+  '    constructor Create(w: word); overload;',
+  '    // and then override the previous',
+  '    constructor Create(b: boolean); override; overload;',
+  '  end;',
+  '  TEagle = class(TBird)',
+  '    constructor Create(b: boolean); override; overload;',
+  '  end;',
+  'constructor TObject.Create(b: boolean);',
+  'begin',
+  'end;',
+  'constructor TBird.Create(w: word);',
+  'begin',
+  'end;',
+  'constructor TBird.Create(b: boolean);',
+  'begin',
+  'end;',
+  'constructor TEagle.Create(b: boolean);',
+  'begin',
+  'end;',
+  'begin',
+  '  TBird.Create(false);',
+  '  TBird.Create(2);',
+  '  TEagle.Create(true);',
+  '  TEagle.Create(3);',
+  '']);
+  ParseProgram;
+end;
+
 procedure TTestResolver.TestProcDuplicate;
 begin
   StartProgram(false);