Browse Source

fcl-passrc: fixed method combining overload and override

mattias 3 years ago
parent
commit
72f852f653
2 changed files with 50 additions and 8 deletions
  1. 19 8
      packages/fcl-passrc/src/pasresolver.pp
  2. 31 0
      packages/fcl-passrc/tests/tcresolver.pas

+ 19 - 8
packages/fcl-passrc/src/pasresolver.pp

@@ -1594,7 +1594,7 @@ type
     procedure OnFindProcDeclaration(El: TPasElement; ElScope, StartScope: TPasScope;
       FindProcData: Pointer; var Abort: boolean); virtual;
     function IsSameProcContext(ProcParentA, ProcParentB: TPasElement): boolean;
-    function IsProcOverload(LastProc, CurProc: TPasProcedure): boolean;
+    function IsProcOverload(LastProc, LastExactProc, CurProc: TPasProcedure): boolean;
     function FindProcSameSignature(const ProcName: string; Proc: TPasProcedure;
       Scope: TPasIdentifierScope; OnlyLocal: boolean): TPasProcedure;
   protected
@@ -5011,7 +5011,7 @@ procedure TPasResolver.OnFindFirst_GenericEl(El: TPasElement; ElScope,
 var
   Data: PPRFindGenericData absolute FindFirstGenericData;
   GenericTemplateTypes: TFPList;
-  Proc: TPasProcedure;
+  Proc, LastExactProc: TPasProcedure;
   ProcScope: TPasProcedureScope;
 begin
   Proc:=nil;
@@ -5028,10 +5028,17 @@ begin
       El:=Proc;
       end;
 
-    if (Data^.LastProc<>nil) and not IsProcOverload(Data^.LastProc,Proc) then
+    if (Data^.LastProc<>nil) then
       begin
-      Abort:=true;
-      exit;
+      if Data^.Find.Found is TPasProcedure then
+        LastExactProc:=TPasProcedure(Data^.Find.Found)
+      else
+        LastExactProc:=nil;
+      if not IsProcOverload(Data^.LastProc,LastExactProc,Proc) then
+        begin
+        Abort:=true;
+        exit;
+        end;
       end;
     Data^.LastProc:=Proc;
 
@@ -5125,7 +5132,7 @@ begin
         exit;
         end;
 
-      if not IsProcOverload(Data^.LastProc,Proc) then
+      if not IsProcOverload(Data^.LastProc,PrevProc,Proc) then
         begin
         Abort:=true;
         exit;
@@ -5616,7 +5623,8 @@ begin
   Result:=false;
 end;
 
-function TPasResolver.IsProcOverload(LastProc, CurProc: TPasProcedure): boolean;
+function TPasResolver.IsProcOverload(LastProc, LastExactProc,
+  CurProc: TPasProcedure): boolean;
 begin
   if msDelphi in TPasProcedureScope(LastProc.CustomData).ModeSwitches then
     begin
@@ -5637,7 +5645,7 @@ begin
     end;
 
   // check if previous found proc is override of found proc
-  if IsProcOverride(CurProc,LastProc) then
+  if (LastExactProc<>nil) and IsProcOverride(CurProc,LastExactProc) then
     begin
     // previous found proc is override of found proc -> skip
     exit(false);
@@ -22963,6 +22971,9 @@ begin
     RaiseMsg(20190210143257,nExprTypeMustBeClassOrRecordTypeGot,sExprTypeMustBeClassOrRecordTypeGot,
       [BaseTypeNames[ExprResolved.BaseType]],ErrorEl);
 
+  if not (rrfReadable in ExprResolved.Flags) then
+    CheckUseAsType(ExprResolved.LoTypeEl,20220210140100,Expr);
+
   Flags:=[];
   ClassRecScope:=nil;
   ExprScope:=nil;

+ 31 - 0
packages/fcl-passrc/tests/tcresolver.pas

@@ -568,6 +568,7 @@ type
     Procedure TestClass_MethodInvalidOverload;
     Procedure TestClass_MethodOverride;
     Procedure TestClass_MethodOverride2;
+    Procedure TestClass_MethodOverrideAndOverload;
     Procedure TestClass_MethodOverrideFixCase;
     Procedure TestClass_MethodOverrideSameResultType;
     Procedure TestClass_MethodOverrideDiffResultTypeFail;
@@ -9644,6 +9645,36 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolver.TestClass_MethodOverrideAndOverload;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode delphi}',
+  'type',
+  '  TObject = class',
+  '  public',
+  '    procedure Fly(b: boolean); virtual; abstract; overload;',
+  '    procedure Fly(c: word); virtual; abstract; overload;',
+  '  end;',
+  '  TBird = class(TObject)',
+  '  public',
+  '    procedure Fly(b: boolean); override; overload;',
+  '    procedure Fly(c: word); override; overload;',
+  '  end;',
+  'procedure TBird.Fly(b: boolean);',
+  'begin end;',
+  'procedure TBird.Fly(c: word);',
+  'begin end;',
+  'var',
+  '  b: TBird;',
+  'begin',
+  '  b.Fly(true);',
+  '  b.Fly(1);',
+  'end.',
+  '']);
+  ParseProgram;
+end;
+
 procedure TTestResolver.TestClass_MethodOverrideFixCase;
 
   procedure CheckOverrideName(aLabel: string);