paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-04 09:02:22 +01:00
Code Issues Packages Projects Releases Wiki Activity

fcl-passrc: fixed method combining overload and override

Browse Source
This commit is contained in:
mattias 2022-02-10 14:02:46 +01:00
parent 2ec382e68c
commit 72f852f653
2 changed files with 50 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -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
packages/fcl-passrc/tests/tcresolver.pas
View File

@ -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);