Added another bunch of tests. Partly they still need to be verified in Delphi.

git-svn-id: branches/svenbarth/classhelpers@16830 -

.gitattributes

@@ -9313,7 +9313,20 @@ tests/test/tchlp33.pp svneol=native#text/pascal
 tests/test/tchlp34.pp svneol=native#text/pascal
 tests/test/tchlp35.pp svneol=native#text/pascal
 tests/test/tchlp36.pp svneol=native#text/pascal
+tests/test/tchlp37.pp svneol=native#text/pascal
+tests/test/tchlp38.pp svneol=native#text/pascal
+tests/test/tchlp39.pp svneol=native#text/pascal
 tests/test/tchlp4.pp svneol=native#text/pascal
+tests/test/tchlp40.pp svneol=native#text/pascal
+tests/test/tchlp41.pp svneol=native#text/pascal
+tests/test/tchlp42.pp svneol=native#text/pascal
+tests/test/tchlp43.pp svneol=native#text/pascal
+tests/test/tchlp44.pp svneol=native#text/pascal
+tests/test/tchlp45.pp svneol=native#text/pascal
+tests/test/tchlp46.pp svneol=native#text/pascal
+tests/test/tchlp47.pp svneol=native#text/pascal
+tests/test/tchlp48.pp svneol=native#text/pascal
+tests/test/tchlp49.pp svneol=native#text/pascal
 tests/test/tchlp5.pp svneol=native#text/pascal
 tests/test/tchlp6.pp svneol=native#text/pascal
 tests/test/tchlp7.pp svneol=native#text/pascal
@@ -9856,6 +9869,7 @@ tests/test/uchlp33a.pp svneol=native#text/pascal
 tests/test/uchlp33b.pp svneol=native#text/pascal
 tests/test/uchlp33c.pp svneol=native#text/pascal
 tests/test/uchlp35.pp svneol=native#text/pascal
+tests/test/uchlp45.pp svneol=native#text/pascal
 tests/test/uenum2a.pp svneol=native#text/plain
 tests/test/uenum2b.pp svneol=native#text/plain
 tests/test/ugeneric10.pp svneol=native#text/plain

tests/test/tchlp37.pp

@@ -0,0 +1,42 @@
+{ a parent class helper's methods are available in a child class helper }
+program tchlp37;
+
+{$ifdef fpc}
+  {$mode objfpc}
+{$endif}
+{$apptype console}
+
+type
+  TFoo = class
+    function Test: Integer;
+  end;
+
+  TFooHelper = class helper for TFoo
+    function Test: Integer;
+  end;
+
+  TFooBarHelper = class helper(TFooHelper) for TFoo
+    property AccessTest: Integer read Test;
+  end;
+
+function TFoo.Test: Integer;
+begin
+  Result := 1;
+end;
+
+function TFooHelper.Test: Integer;
+begin
+  Result := 2;
+end;
+
+var
+  f: TFoo;
+  res: Integer;
+begin
+  f := TFoo.Create;
+  res := f.AccessTest;
+  Writeln(res);
+  if res <> 2 then
+    Halt(1);
+  Writeln('ok');
+end.

tests/test/tchlp38.pp

@@ -0,0 +1,41 @@
+{ methods of the extended class can be called using "inherited" }
+program tchlp38;
+
+{$ifdef fpc}
+  {$mode objfpc}
+{$endif}
+{$apptype console}
+
+type
+  TFoo = class
+    function Test(aRecurse: Boolean): Integer;
+  end;
+
+  TFooHelper = class helper for TFoo
+    function Test(aRecurse: Boolean): Integer;
+  end;
+
+function TFoo.Test(aRecurse: Boolean): Integer;
+begin
+  Result := 1;
+end;
+
+function TFooHelper.Test(aRecurse: Boolean): Integer;
+begin
+  if aRecurse then
+    Result := inherited Test(False)
+  else
+    Result := 2;
+end;
+
+var
+  f: TFoo;
+  res: Integer;
+begin
+  f := TFoo.Create;
+  res := f.Test(True);
+  Writeln('f.Test: ', res);
+  if res <> 1 then
+    Halt(1);
+  Writeln('ok');
+end.

tests/test/tchlp39.pp

@@ -0,0 +1,51 @@
+{ the parent of a class helper has higher priority than the extended class when
+  searching for symbols }
+program tchlp39;
+
+{$ifdef fpc}
+  {$mode objfpc}
+{$endif}
+{$apptype console}
+
+type
+  TFoo = class
+    function Test(aRecurse: Boolean): Integer;
+  end;
+
+  TFooHelper = class helper for TFoo
+    function Test(aRecurse: Boolean): Integer;
+  end;
+
+  TFooSubHelper = class helper(TFooHelper) for TFoo
+    function Test(aRecurse: Boolean): Integer;
+  end;
+
+function TFoo.Test(aRecurse: Boolean): Integer;
+begin
+  Result := 1;
+end;
+
+function TFooHelper.Test(aRecurse: Boolean): Integer;
+begin
+  Result := 2;
+end;
+
+function TFooSubHelper.Test(aRecurse: Boolean): Integer;
+begin
+  if aRecurse then
+    Result := Test(False)
+  else
+    Result := 3;
+end;
+
+var
+  f: TFoo;
+  res: Integer;
+begin
+  f := TFoo.Create;
+  res := f.Test(True);
+  Writeln('f.Test: ', res);
+  if res <> 2 then
+    Halt(1);
+  Writeln('ok');
+end.

tests/test/tchlp40.pp

@@ -0,0 +1,39 @@
+{ published is allowed in mode Delphi, but unusable }
+program tchlp40;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+{$apptype console}
+
+type
+  {$M+}
+  TFoo = class
+  end;
+  {$M-}
+
+  TFooHelper = class helper for TFoo
+  published
+    function Test: Integer;
+  end;
+
+function TFooHelper.Test: Integer;
+begin
+  Result := 1;
+end;
+
+var
+  f: TFoo;
+  res: Pointer;
+begin
+  f := TFoo.Create;
+  res := f.MethodAddress('Test');
+{$ifdef fpc}
+  Writeln('Address of TFoo.Test: ', res);
+{$else}
+  Writeln('Address of TFoo.Test: ', Integer(res));
+{$endif}
+  if res <> Nil then
+    Halt(1);
+  Writeln('ok');
+end.

tests/test/tchlp41.pp

@@ -0,0 +1,25 @@
+{ %FAIL }
+
+{ puplished members are not allowed in mode objfpc }
+program tchlp41;
+
+{$mode objfpc}
+
+type
+  {$M+}
+  TFoo = class
+  end;
+  {$M-}
+
+  TFooHelper = class helper for TFoo
+  published
+    function Test: Integer;
+  end;
+
+function TFooHelper.Test: Integer;
+begin
+  Result := 1;
+end;
+
+begin
+end.

tests/test/tchlp42.pp

@@ -0,0 +1,74 @@
+{ a class helper may introduce a enumerator }
+program tchlp42;
+
+{$ifdef fpc}
+  {$mode objfpc}
+{$endif}
+{$apptype console}
+
+type
+  TContainer = class
+    Contents: array[0..5] of Integer;
+    constructor Create;
+  end;
+
+  TContainerEnum = class
+  private
+    fIndex: Integer;
+    fContainer: TContainer;
+  public
+    constructor Create(aContainer: TContainer);
+    function GetCurrent: Integer;
+    function MoveNext: Boolean;
+    property Current: Integer read GetCurrent;
+  end;
+
+  TContainerHelper = class helper for TContainer
+    function GetEnumerator: TContainerEnum;
+  end;
+
+{ TContainer }
+
+constructor TContainer.Create;
+var
+  i: Integer;
+begin
+  for i := Low(Contents) to High(Contents) do
+    Contents[i] := High(Contents) - i;
+end;
+
+{ TContainerHelper }
+
+function TContainerHelper.GetEnumerator: TContainerEnum;
+begin
+  Result := TContainerEnum.Create(Self);
+end;
+
+{ TContainerEnum }
+
+constructor TContainerEnum.Create(aContainer: TContainer);
+begin
+  fContainer := aContainer;
+  fIndex := Low(fContainer.Contents) - 1;
+end;
+
+function TContainerEnum.GetCurrent: Integer;
+begin
+  Result := fContainer.Contents[fIndex];
+end;
+
+function TContainerEnum.MoveNext: Boolean;
+begin
+  Inc(fIndex);
+  Result := fIndex <= High(fContainer.Contents);
+end;
+
+var
+  cont: TContainer;
+  i: Integer;
+begin
+  cont := TContainer.Create;
+  for i in cont do
+    Writeln(i);
+  Writeln('ok');
+end.

tests/test/tchlp43.pp

@@ -0,0 +1,47 @@
+program tchlp43;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+{$apptype console}
+
+type
+  TFoo = class
+    function Test(aRecurse: Boolean): Integer; virtual;
+  end;
+
+  TObjectHelper = class helper for TObject
+    function Test(aRecurse: Boolean): Integer; virtual;
+  end;
+
+  TFooHelper = class helper(TObjectHelper) for TFoo
+    function Test(aRecurse: Boolean): Integer; override;
+  end;
+
+function TFoo.Test(aRecurse: Boolean): Integer;
+begin
+  Result := 1;
+end;
+
+function TObjectHelper.Test(aRecurse: Boolean): Integer;
+begin
+  Result := 2;
+end;
+
+function TFooHelper.Test(aRecurse: Boolean): Integer;
+begin
+  if aRecurse then
+    Result := inherited Test(False)
+  else
+    Result := 3;
+end;
+
+var
+  f: TFoo;
+begin
+  f := TFoo.Create;
+  res := f.Test(True);
+  if res <> 2 then
+    Halt(1);
+  Writeln('ok');
+end.

tests/test/tchlp44.pp

@@ -0,0 +1,50 @@
+{ in a parent class helper Self always is of the type of the extended class }
+program tchlp44;
+
+{$ifdef fpc}
+  {$mode objfpc}
+{$endif}
+{$apptype console}
+
+type
+  TFoo = class
+    function Test: Integer;
+  end;
+
+  TBar = class(TFoo)
+    function Test: Integer;
+  end;
+
+  TFooHelper = class helper for TFoo
+    function AccessTest: Integer;
+  end;
+
+  TBarHelper = class helper(TFooHelper) for TBar
+  end;
+
+function TFoo.Test: Integer;
+begin
+  Result := 1;
+end;
+
+function TBar.Test: Integer;
+begin
+  Result := 2;
+end;
+
+function TFooHelper.AccessTest: Integer;
+begin
+  Result := Test;
+end;
+
+var
+  b: TBar;
+  res: Integer;
+begin
+  b := TBar.Create;
+  res := b.AccessTest;
+  Writeln('b.AccessTest: ', res);
+  if res <> 1 then
+    Halt(1);
+  Writeln('ok');
+end.

tests/test/tchlp45.pp

@@ -0,0 +1,19 @@
+{ %FAIL }
+
+{ access to methods must adhere to visibility rules }
+program tchlp45;
+
+{$ifdef fpc}
+  {$mode objfpc}
+{$endif}
+{$apptype console}
+
+uses
+  uchlp45;
+
+var
+  f: TFoo;
+begin
+  f := TFoo.Create;
+  f.Test;
+end.

tests/test/tchlp46.pp

@@ -0,0 +1,18 @@
+{ %FAIL }
+
+{ access to methods must adhere to visibility rules (here: private)}
+program tchlp46;
+
+{$ifdef fpc}
+  {$mode objfpc}
+{$endif}
+
+uses
+  uchlp45;
+
+var
+  f: TFoo;
+begin
+  f := TFoo.Create;
+  f.Test2;
+end.

tests/test/tchlp47.pp

@@ -0,0 +1,18 @@
+{ %FAIL }
+
+{ access to methods must adhere to visibility rules (here: strict protected)}
+program tchlp47;
+
+{$ifdef fpc}
+  {$mode objfpc}
+{$endif}
+
+uses
+  uchlp45;
+
+var
+  f: TFoo;
+begin
+  f := TFoo.Create;
+  f.Test3;
+end.

tests/test/tchlp48.pp

@@ -0,0 +1,18 @@
+{ %FAIL }
+
+{ access to methods must adhere to visibility rules (here: protected)}
+program tchlp48;
+
+{$ifdef fpc}
+  {$mode objfpc}
+{$endif}
+
+uses
+  uchlp45;
+
+var
+  f: TFoo;
+begin
+  f := TFoo.Create;
+  f.Test4;
+end.

tests/test/tchlp49.pp

@@ -0,0 +1,18 @@
+{ %NORUN }
+
+{ access to methods must adhere to visibility rules (here: public)}
+program tchlp49;
+
+{$ifdef fpc}
+  {$mode objfpc}
+{$endif}
+
+uses
+  uchlp45;
+
+var
+  f: TFoo;
+begin
+  f := TFoo.Create;
+  f.Test5;
+end.

tests/test/uchlp45.pp

@@ -0,0 +1,54 @@
+unit uchlp45; 
+
+{$ifdef fpc}
+  {$mode objfpc}{$H+}
+{$endif}
+
+interface
+
+type
+  TFoo = class
+  end;
+
+  TFooHelper = class helper for TFoo
+  strict private
+    procedure Test1;
+  private
+    procedure Test2;
+  strict protected
+    procedure Test3;
+  protected
+    procedure Test4;
+  public
+    procedure Test5;
+  end;
+
+implementation
+
+procedure TFooHelper.Test1;
+begin
+
+end;
+
+procedure TFooHelper.Test2;
+begin
+
+end;
+
+procedure TFooHelper.Test3;
+begin
+
+end;
+
+procedure TFooHelper.Test4;
+begin
+
+end;
+
+procedure TFooHelper.Test5;
+begin
+
+end;
+
+end.
+