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

fcl-passrc: fixed searching overload in mode delphi

Browse Source
This commit is contained in:
mattias 2022-06-04 10:52:20 +02:00
parent 49ad3b0d2c
commit 309d8a90fd
2 changed files with 76 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1556,8 +1556,8 @@ type
TFindCallElData = record
Params: TParamsExpr;
TemplCnt: integer;
Found: TPasElement; // TPasProcedure or TPasUnresolvedSymbolRef(built in proc) or TPasType (typecast)
LastProc: TPasProcedure;
Found: TPasElement; // TPasProcedure or TPasUnresolvedSymbolRef(built in proc) or TPasType (typecast), best candidate so far
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
LastExactProc:=TPasProcedure(Data^.Find.Found)
else
LastExactProc:=nil;
if not IsProcOverload(Data^.LastProc,LastExactProc,Proc) then
if not IsProcOverloading(Data^.LastProc,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,
CurProc: TPasProcedure): boolean;
function TPasResolver.IsProcOverloading(LastProc, CurProc: TPasProcedure
): 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;

40
packages/fcl-passrc/tests/tcresolver.pas
View File

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