mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-14 00:59:08 +02:00
fcl-passrc: resolver: fixed checking override of override
git-svn-id: trunk@37352 -
This commit is contained in:
parent
8b63f97173
commit
567f3e412e
@ -1375,6 +1375,7 @@ type
|
|||||||
function IsArrayType(const ResolvedEl: TPasResolverResult): boolean;
|
function IsArrayType(const ResolvedEl: TPasResolverResult): boolean;
|
||||||
function IsTypeCast(Params: TParamsExpr): boolean;
|
function IsTypeCast(Params: TParamsExpr): boolean;
|
||||||
function ProcNeedsParams(El: TPasProcedureType): boolean;
|
function ProcNeedsParams(El: TPasProcedureType): boolean;
|
||||||
|
function IsProcOverride(AncestorProc, DescendantProc: TPasProcedure): boolean;
|
||||||
function GetRangeLength(RangeExpr: TPasExpr): MaxPrecInt;
|
function GetRangeLength(RangeExpr: TPasExpr): MaxPrecInt;
|
||||||
function EvalRangeLimit(RangeExpr: TPasExpr; Flags: TResEvalFlags;
|
function EvalRangeLimit(RangeExpr: TPasExpr; Flags: TResEvalFlags;
|
||||||
EvalLow: boolean; ErrorEl: TPasElement): TResEvalValue; virtual; // compute low() or high()
|
EvalLow: boolean; ErrorEl: TPasElement): TResEvalValue; virtual; // compute low() or high()
|
||||||
@ -2744,8 +2745,7 @@ begin
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
// check if previous found proc is override of found proc
|
// check if previous found proc is override of found proc
|
||||||
if (PrevProc.IsOverride)
|
if IsProcOverride(Proc,PrevProc) then
|
||||||
and (TPasProcedureScope(PrevProc.CustomData).OverriddenProc=Proc) then
|
|
||||||
begin
|
begin
|
||||||
// previous found proc is override of found proc -> skip
|
// previous found proc is override of found proc -> skip
|
||||||
exit;
|
exit;
|
||||||
@ -13689,6 +13689,22 @@ begin
|
|||||||
Result:=(El.Args.Count>0) and (TPasArgument(El.Args[0]).ValueExpr=nil);
|
Result:=(El.Args.Count>0) and (TPasArgument(El.Args[0]).ValueExpr=nil);
|
||||||
end;
|
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;
|
function TPasResolver.GetRangeLength(RangeExpr: TPasExpr): MaxPrecInt;
|
||||||
var
|
var
|
||||||
Range: TResEvalValue;
|
Range: TResEvalValue;
|
||||||
|
@ -399,6 +399,7 @@ type
|
|||||||
Procedure TestClass_MethodOverrideDiffResultTypeFail;
|
Procedure TestClass_MethodOverrideDiffResultTypeFail;
|
||||||
Procedure TestClass_MethodOverloadAncestor;
|
Procedure TestClass_MethodOverloadAncestor;
|
||||||
Procedure TestClass_MethodOverloadArrayOfTClass;
|
Procedure TestClass_MethodOverloadArrayOfTClass;
|
||||||
|
Procedure TestClass_ConstructorOverride;
|
||||||
Procedure TestClass_MethodScope;
|
Procedure TestClass_MethodScope;
|
||||||
Procedure TestClass_IdentifierSelf;
|
Procedure TestClass_IdentifierSelf;
|
||||||
Procedure TestClassCallInherited;
|
Procedure TestClassCallInherited;
|
||||||
@ -5944,6 +5945,31 @@ begin
|
|||||||
ParseProgram;
|
ParseProgram;
|
||||||
end;
|
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;
|
procedure TTestResolver.TestClass_MethodScope;
|
||||||
begin
|
begin
|
||||||
StartProgram(false);
|
StartProgram(false);
|
||||||
|
Loading…
Reference in New Issue
Block a user