fcl-passrc: resolver: fixed checking override of override

git-svn-id: trunk@37352 -

packages/fcl-passrc/src/pasresolver.pp

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

packages/fcl-passrc/tests/tcresolver.pas

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