Browse Source

fcl-passrc: added test overload override

git-svn-id: trunk@37682 -
Mattias Gaertner 7 years ago
parent
commit
0bbf072b1a
1 changed files with 48 additions and 0 deletions
  1. 48 0
      packages/fcl-passrc/tests/tcresolver.pas

+ 48 - 0
packages/fcl-passrc/tests/tcresolver.pas

@@ -347,6 +347,7 @@ type
     Procedure TestProcOverloadDelphiUnitNoOverloadFail;
     Procedure TestProcOverloadDelphiUnitNoOverloadFail;
     Procedure TestProcOverloadObjFPCUnitWithoutOverloadMod;
     Procedure TestProcOverloadObjFPCUnitWithoutOverloadMod;
     Procedure TestProcOverloadDelphiWithObjFPC;
     Procedure TestProcOverloadDelphiWithObjFPC;
+    Procedure TestProcOverloadDelphiOverride;
     Procedure TestProcDuplicate;
     Procedure TestProcDuplicate;
     Procedure TestNestedProc;
     Procedure TestNestedProc;
     Procedure TestFuncAssignFail;
     Procedure TestFuncAssignFail;
@@ -5199,6 +5200,53 @@ begin
   ParseProgram;
   ParseProgram;
 end;
 end;
 
 
+procedure TTestResolver.TestProcOverloadDelphiOverride;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode delphi}',
+  'type',
+  '  TObject = class end;',
+  '  TBird = class',
+  '    function {#a}GetValue: longint; overload; virtual;',
+  '    function {#b}GetValue(AValue: longint): longint; overload; virtual;',
+  '  end;',
+  '  TEagle = class(TBird)',
+  '    function {#c}GetValue: longint; overload; override;',
+  '    function {#d}GetValue(AValue: longint): longint; overload; override;',
+  '  end;',
+  '  TBear = class',
+  '    procedure DoIt;',
+  '  end;',
+  'function TBird.GetValue: longint;',
+  'begin',
+  '  if 3={@a}GetValue then ;',
+  '  if 4={@b}GetValue(5) then ;',
+  'end;',
+  'function TBird.GetValue(AValue: longint): longint;',
+  'begin',
+  'end;',
+  'function TEagle.GetValue: longint;',
+  'begin',
+  '  if 13={@c}GetValue then ;',
+  '  if 14={@d}GetValue(15) then ;',
+  '  if 15=inherited {@a}GetValue then ;',
+  '  if 16=inherited {@b}GetValue(17) then ;',
+  'end;',
+  'function TEagle.GetValue(AValue: longint): longint;',
+  'begin',
+  'end;',
+  'procedure TBear.DoIt;',
+  'var',
+  '  e: TEagle;',
+  'begin',
+  '  if 23=e.{@c}GetValue then ;',
+  '  if 24=e.{@d}GetValue(25) then ;',
+  'end;',
+  'begin']);
+  ParseProgram;
+end;
+
 procedure TTestResolver.TestProcDuplicate;
 procedure TTestResolver.TestProcDuplicate;
 begin
 begin
   StartProgram(false);
   StartProgram(false);