paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-18 15:59:45 +02:00
Code Issues Packages Projects Releases Wiki Activity

fcl-passrc: resolver: fixed checking override of override

Browse Source 
git-svn-id: trunk@37352 -
This commit is contained in:
Mattias Gaertner 2017-09-28 15:09:15 +00:00
parent 8b63f97173
commit 567f3e412e
2 changed files with 44 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1375,6 +1375,7 @@ type
function IsArrayType(const ResolvedEl: TPasResolverResult): boolean;
function IsTypeCast(Params: TParamsExpr): boolean;
function ProcNeedsParams(El: TPasProcedureType): boolean;
function IsProcOverride(AncestorProc, DescendantProc: TPasProcedure): boolean;
function GetRangeLength(RangeExpr: TPasExpr): MaxPrecInt;
function EvalRangeLimit(RangeExpr: TPasExpr; Flags: TResEvalFlags;
EvalLow: boolean; ErrorEl: TPasElement): TResEvalValue; virtual; // compute low() or high()
@ -2744,8 +2745,7 @@ begin
end;
// check if previous found proc is override of found proc
if (PrevProc.IsOverride)
and (TPasProcedureScope(PrevProc.CustomData).OverriddenProc=Proc) then
if IsProcOverride(Proc,PrevProc) then
begin
// previous found proc is override of found proc -> skip
exit;
@ -13689,6 +13689,22 @@ begin
Result:=(El.Args.Count>0) and (TPasArgument(El.Args[0]).ValueExpr=nil);
end;
function TPasResolver.IsProcOverride(AncestorProc, DescendantProc: TPasProcedure
): boolean;
var
Proc, OverriddenProc: TPasProcedure;
begin
Result:=false;
Proc:=DescendantProc;
if not Proc.IsOverride then exit;
if not AncestorProc.IsOverride and not AncestorProc.IsVirtual then exit;
repeat
OverriddenProc:=TPasProcedureScope(Proc.CustomData).OverriddenProc;
if AncestorProc=OverriddenProc then exit(true);
Proc:=OverriddenProc;
until Proc=nil;
end;
function TPasResolver.GetRangeLength(RangeExpr: TPasExpr): MaxPrecInt;
var
Range: TResEvalValue;

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

@ -399,6 +399,7 @@ type
Procedure TestClass_MethodOverrideDiffResultTypeFail;
Procedure TestClass_MethodOverloadAncestor;
Procedure TestClass_MethodOverloadArrayOfTClass;
Procedure TestClass_ConstructorOverride;
Procedure TestClass_MethodScope;
Procedure TestClass_IdentifierSelf;
Procedure TestClassCallInherited;
@ -5944,6 +5945,31 @@ begin
ParseProgram;
end;
procedure TTestResolver.TestClass_ConstructorOverride;
begin
StartProgram(false);
Add([
'type',
' TObject = class',
' constructor Create(o: tobject); virtual;',
' end;',
' TBird = class',
' constructor Create(o: tobject); override;',
' end;',
' TEagle = class(TBird)',
' constructor Create(o: tobject); override;',
' end;',
'constructor tobject.Create(o: tobject); begin end;',
'constructor tbird.Create(o: tobject); begin end;',
'constructor teagle.Create(o: tobject); begin end;',
'var o: TEagle;',
'begin',
' o:=TEagle.Create(nil);',
' o:=TEagle.Create(o);',
'']);
ParseProgram;
end;
procedure TTestResolver.TestClass_MethodScope;
begin
StartProgram(false);