codetools: tests for parent class helpers

git-svn-id: trunk@49985 -

.gitattributes

@@ -996,6 +996,8 @@ components/codetools/tests/fdtbase.pas svneol=native#text/plain
 components/codetools/tests/finddeclarationtest.lpi svneol=native#text/plain
 components/codetools/tests/finddeclarationtest.lpr svneol=native#text/plain
 components/codetools/tests/fpctests/tchlp41.pp svneol=native#text/plain
+components/codetools/tests/fpctests/tchlp46.pp svneol=native#text/plain
+components/codetools/tests/fpctests/tchlp47.pp svneol=native#text/plain
 components/codetools/tests/parsertbase.pas svneol=native#text/plain
 components/codetools/tests/parsertest.lpi svneol=native#text/plain
 components/codetools/tests/parsertest.lpr svneol=native#text/plain

components/codetools/tests/fdtbase.pas

@@ -4,10 +4,14 @@
    ./finddeclarationtest --format=plain --suite=TestFindDeclaration_Basic
    ./finddeclarationtest --format=plain --suite=TestFindDeclaration_NestedClasses
    ./finddeclarationtest --format=plain --suite=TestFindDeclaration_ClassHelper
-   ./finddeclarationtest --format=plain --suite=TestFindDeclaration_tchlp41
    ./finddeclarationtest --format=plain --suite=TestFindDeclaration_TypeHelper
    ./finddeclarationtest --format=plain --suite=TestFindDeclaration_ObjCClass
    ./finddeclarationtest --format=plain --suite=TestFindDeclaration_ObjCCategory
+
+ FPC tests:
+   ./finddeclarationtest --format=plain --suite=TestFindDeclaration_tchlp41
+   ./finddeclarationtest --format=plain --suite=TestFindDeclaration_tchlp46
+   ./finddeclarationtest --format=plain --suite=TestFindDeclaration_tchlp47
 }
 unit fdtbase;
 
@@ -33,12 +37,14 @@ type
     procedure TestFindDeclaration_Basic;
     procedure TestFindDeclaration_NestedClasses;
     procedure TestFindDeclaration_ClassHelper;
-    procedure TestFindDeclaration_tchlp41;
     procedure TestFindDeclaration_TypeHelper;
     {$IFDEF Darwin}
     procedure TestFindDeclaration_ObjCClass;
     procedure TestFindDeclaration_ObjCCategory;
     {$ENDIF}
+    procedure TestFindDeclaration_tchlp41;
+    procedure TestFindDeclaration_tchlp46;
+    procedure TestFindDeclaration_tchlp47;
   end;
 
 var
@@ -211,11 +217,6 @@ begin
   FindDeclarations('fdt_classhelper.pas');
 end;
 
-procedure TTestFindDeclaration.TestFindDeclaration_tchlp41;
-begin
-  FindDeclarations('fpctests/tchlp41.pp');
-end;
-
 procedure TTestFindDeclaration.TestFindDeclaration_TypeHelper;
 begin
   FindDeclarations('fdt_typehelper.pas');
@@ -233,6 +234,21 @@ begin
 end;
 {$ENDIF}
 
+procedure TTestFindDeclaration.TestFindDeclaration_tchlp41;
+begin
+  FindDeclarations('fpctests/tchlp41.pp');
+end;
+
+procedure TTestFindDeclaration.TestFindDeclaration_tchlp46;
+begin
+  FindDeclarations('fpctests/tchlp46.pp');
+end;
+
+procedure TTestFindDeclaration.TestFindDeclaration_tchlp47;
+begin
+  FindDeclarations('fpctests/tchlp47.pp');
+end;
+
 initialization
   GetTestRegistry.TestName := 'All tests';
   BugsTestSuite := TTestSuite.Create('Bugs');

components/codetools/tests/fpctests/tchlp41.pp

@@ -33,7 +33,7 @@ end;
 function TTestHelperSub.Test(aRecurse: Boolean): Integer;
 begin
   if aRecurse then
-    Result := inherited Test{declaration:tchlp41.TTest.test}(False)
+    Result := inherited Test{declaration:TTest.Test}(False)
   else
     Result := 3;
 end;
@@ -43,7 +43,7 @@ var
   res: Integer;
 begin
   t := TTest.Create;
-  res := t.Test{declaration:tchlp41.TTestHelperSub.Test}(True);
+  res := t.Test{declaration:TTestHelperSub.Test}(True);
   Writeln('t.Test: ', res);
   if res <> 1 then
     Halt(1);

components/codetools/tests/fpctests/tchlp46.pp

@@ -0,0 +1,46 @@
+{ test that helpers can access the methods of the parent helper using
+  "inherited" }
+program tchlp46;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+{$apptype console}
+
+type
+  TTest = class
+
+  end;
+
+  TTestHelper = class helper for TTest
+    function Test(aRecurse: Boolean): Integer;
+  end;
+
+  TTestHelperSub = class helper(TTestHelper) for TTest
+    function Test(aRecurse: Boolean): Integer;
+  end;
+
+function TTestHelper.Test(aRecurse: Boolean): Integer;
+begin
+  Result := 1;
+end;
+
+function TTestHelperSub.Test(aRecurse: Boolean): Integer;
+begin
+  if aRecurse then
+    Result := inherited Test{declaration:TTestHelper.Test}(False)
+  else
+    Result := 2;
+end;
+
+var
+  t: TTest;
+  res: Integer;
+begin
+  t := TTest.Create;
+  res := t.Test{declaration:TTestHelperSub.test}(True);
+  Writeln('t.Test: ', res);
+  if res <> 1 then
+    Halt(1);
+  Writeln('ok');
+end.

components/codetools/tests/fpctests/tchlp47.pp

@@ -0,0 +1,51 @@
+{ a method defined in a parent helper has higher priority than a method defined
+  in the parent of the extended class - test 1}
+program tchlp47;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+{$apptype console}
+
+type
+  TTest = class
+    function Test: Integer;
+  end;
+
+  TTestSub = class(TTest)
+  end;
+
+  TTestSubHelper = class helper for TTestSub
+    function Test: Integer;
+  end;
+
+  TTestSubHelperSub = class helper(TTestSubHelper) for TTestSub
+    function AccessTest: Integer;
+  end;
+
+function TTest.Test: Integer;
+begin
+  Result := 1;
+end;
+
+function TTestSubHelper.Test: Integer;
+begin
+  Result := 2;
+end;
+
+function TTestSubHelperSub.AccessTest: Integer;
+begin
+  Result := Test{declaration:TTestSubHelper.Test};
+end;
+
+var
+  t: TTestSub;
+  res: Integer;
+begin
+  t := TTestSub.Create;
+  res := t.AccessTest{declaration:TTestSubHelperSub.AccessTest};
+  Writeln('t.AccessTest: ', res);
+  if res <> 2 then
+    Halt(1);
+  Writeln('ok');
+end.