浏览代码

Added some more tests
* one default properties test
* visibility of extended type's symbols
* class constructors (I don't know currently whether they are supported or not, because Delphi XE does not bring the "class constructor not allowed" error, but an internal error is created; maybe I should file a bug about this, too)

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

svenbarth 14 年之前
父节点
当前提交
bb55a59aaf

+ 11 - 0
.gitattributes

@@ -9416,7 +9416,17 @@ tests/test/tchlp78.pp svneol=native#text/pascal
 tests/test/tchlp79.pp svneol=native#text/pascal
 tests/test/tchlp79.pp svneol=native#text/pascal
 tests/test/tchlp8.pp svneol=native#text/pascal
 tests/test/tchlp8.pp svneol=native#text/pascal
 tests/test/tchlp80.pp svneol=native#text/pascal
 tests/test/tchlp80.pp svneol=native#text/pascal
+tests/test/tchlp81.pp svneol=native#text/pascal
+tests/test/tchlp82.pp svneol=native#text/pascal
+tests/test/tchlp83.pp svneol=native#text/pascal
+tests/test/tchlp84.pp svneol=native#text/pascal
+tests/test/tchlp85.pp svneol=native#text/pascal
+tests/test/tchlp86.pp svneol=native#text/pascal
+tests/test/tchlp87.pp svneol=native#text/pascal
+tests/test/tchlp88.pp svneol=native#text/pascal
+tests/test/tchlp89.pp svneol=native#text/pascal
 tests/test/tchlp9.pp svneol=native#text/pascal
 tests/test/tchlp9.pp svneol=native#text/pascal
+tests/test/tchlp90.pp svneol=native#text/pascal
 tests/test/tcint64.pp svneol=native#text/plain
 tests/test/tcint64.pp svneol=native#text/plain
 tests/test/tclass1.pp svneol=native#text/plain
 tests/test/tclass1.pp svneol=native#text/plain
 tests/test/tclass10.pp svneol=native#text/pascal
 tests/test/tclass10.pp svneol=native#text/pascal
@@ -9964,6 +9974,7 @@ tests/test/uchlp50.pp svneol=native#text/pascal
 tests/test/uchlp51a.pp svneol=native#text/pascal
 tests/test/uchlp51a.pp svneol=native#text/pascal
 tests/test/uchlp51b.pp svneol=native#text/pascal
 tests/test/uchlp51b.pp svneol=native#text/pascal
 tests/test/uchlp51c.pp svneol=native#text/pascal
 tests/test/uchlp51c.pp svneol=native#text/pascal
+tests/test/uchlp82.pp svneol=native#text/pascal
 tests/test/uenum2a.pp svneol=native#text/plain
 tests/test/uenum2a.pp svneol=native#text/plain
 tests/test/uenum2b.pp svneol=native#text/plain
 tests/test/uenum2b.pp svneol=native#text/plain
 tests/test/ugeneric10.pp svneol=native#text/plain
 tests/test/ugeneric10.pp svneol=native#text/plain

+ 38 - 0
tests/test/tchlp81.pp

@@ -0,0 +1,38 @@
+{ helpers may introduce new default properties (includes default properties
+  introudced by the helper's parent) }
+program tchlp81;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+{$apptype console}
+
+type
+  TFoo = class
+
+  end;
+
+  TObjectHelper = class helper for TObject
+    function GetTest(aIndex: Integer): Integer;
+    property Test[Index: Integer]: Integer read GetTest; default;
+  end;
+
+  TFooHelper = class helper(TObjectHelper) for TFoo
+  end;
+
+function TObjectHelper.GetTest(aIndex: Integer): Integer;
+begin
+  Result := aIndex;
+end;
+
+var
+  f: TFoo;
+  res: Integer;
+begin
+  f := TFoo.Create;
+  res := f[3];
+  Writeln('value: ', res);
+  if res <> 3 then
+    Halt(1);
+  Writeln('ok');
+end.

+ 26 - 0
tests/test/tchlp82.pp

@@ -0,0 +1,26 @@
+{ %FAIL }
+
+{ test visibility of symbols in the extended type - strict private }
+program tchlp82;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+{$apptype console}
+
+uses
+  uchlp82;
+
+type
+  TFooHelper = class helper for TFoo
+    function AccessField: Integer;
+  end;
+
+function TFooHelper.AccessField: Integer;
+begin
+  Result := Test1;
+end;
+
+begin
+
+end.

+ 26 - 0
tests/test/tchlp83.pp

@@ -0,0 +1,26 @@
+{ %FAIL }
+
+{ test visibility of symbols in the extended type - private }
+program tchlp83;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+{$apptype console}
+
+uses
+  uchlp82;
+
+type
+  TFooHelper = class helper for TFoo
+    function AccessField: Integer;
+  end;
+
+function TFooHelper.AccessField: Integer;
+begin
+  Result := Test2;
+end;
+
+begin
+
+end.

+ 26 - 0
tests/test/tchlp84.pp

@@ -0,0 +1,26 @@
+{ %NORUN }
+
+{ test visibility of symbols in the extended type - strict protected }
+program tchlp84;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+{$apptype console}
+
+uses
+  uchlp82;
+
+type
+  TFooHelper = class helper for TFoo
+    function AccessField: Integer;
+  end;
+
+function TFooHelper.AccessField: Integer;
+begin
+  Result := Test3;
+end;
+
+begin
+
+end.

+ 26 - 0
tests/test/tchlp85.pp

@@ -0,0 +1,26 @@
+{ %NORUN }
+
+{ test visibility of symbols in the extended type - protected }
+program tchlp85;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+{$apptype console}
+
+uses
+  uchlp82;
+
+type
+  TFooHelper = class helper for TFoo
+    function AccessField: Integer;
+  end;
+
+function TFooHelper.AccessField: Integer;
+begin
+  Result := Test4;
+end;
+
+begin
+
+end.

+ 30 - 0
tests/test/tchlp86.pp

@@ -0,0 +1,30 @@
+{ %FAIL } {???}
+
+program tchlp86;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+{$apptype console}
+
+type
+  TFoo = class
+    class var
+      Test: Integer;
+  end;
+
+  TFooHelper = class helper for TFoo
+    class constructor Create;
+  end;
+
+class constructor TFooHelper.Create;
+begin
+  TFoo.Test := 42;
+end;
+
+begin
+  Writeln('TFoo.Test: ', TFoo.Test);
+  if TFoo.Test <> 42 then
+    Halt(1);
+  Writeln('ok');
+end.

+ 33 - 0
tests/test/tchlp87.pp

@@ -0,0 +1,33 @@
+{ %NORUN }
+
+{ class helpers of a parent are available in a subclass as well }
+program tchlp87;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+{$apptype console}
+
+type
+  TFoo = class
+
+  end;
+
+  TBar = class(TFoo)
+
+  end;
+
+  TFooHelper = class helper for TFoo
+    procedure TestFoo;
+  end;
+
+procedure TFooHelper.TestFoo;
+begin
+
+end;
+
+var
+  b: TBar;
+begin
+  b.TestFoo;
+end.

+ 42 - 0
tests/test/tchlp88.pp

@@ -0,0 +1,42 @@
+{ a helper of a parent class hides the parent's methods }
+program tchlp88;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+{$apptype console}
+
+type
+  TFoo = class
+    function TestFoo: Integer;
+  end;
+
+  TBar = class(TFoo)
+
+  end;
+
+  TFooHelper = class helper for TFoo
+    function TestFoo: Integer;
+  end;
+
+function TFoo.TestFoo: Integer;
+begin
+  Result := 1;
+end;
+
+function TFooHelper.TestFoo: Integer;
+begin
+  Result := 2;
+end;
+
+var
+  b: TBar;
+  res: Integer;
+begin
+  b := TBar.Create;
+  res := b.TestFoo;
+  Writeln('b.TestFoo: ', res);
+  if res <> 2 then
+    Halt(1);
+  Writeln('ok');
+end.

+ 47 - 0
tests/test/tchlp89.pp

@@ -0,0 +1,47 @@
+{ a helper of a parent class does not hide methods in the child class }
+program tchlp89;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+{$apptype console}
+
+type
+  TFoo = class
+    function TestFoo: Integer;
+  end;
+
+  TBar = class(TFoo)
+     function TestFoo: Integer;
+  end;
+
+  TFooHelper = class helper for TFoo
+    function TestFoo: Integer;
+  end;
+
+function TFoo.TestFoo: Integer;
+begin
+  Result := 1;
+end;
+
+function TBar.TestFoo: Integer;
+begin
+  Result := 4;
+end;
+
+function TFooHelper.TestFoo: Integer;
+begin
+  Result := 2;
+end;
+
+var
+  b: TBar;
+  res: Integer;
+begin
+  b := TBar.Create;
+  res := b.TestFoo;
+  Writeln('b.TestFoo: ', res);
+  if res <> 4 then
+    Halt(1);
+  Writeln('ok');
+end.

+ 51 - 0
tests/test/tchlp90.pp

@@ -0,0 +1,51 @@
+{ a helper of a parent class hides methods in the child class if its also a
+  parent of the helper for the child class }
+program tchlp90;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+{$apptype console}
+
+type
+  TFoo = class
+    function TestFoo: Integer;
+  end;
+
+  TBar = class(TFoo)
+     function TestFoo: Integer;
+  end;
+
+  TFooHelper = class helper for TFoo
+    function TestFoo: Integer;
+  end;
+
+  TBarHelper = class helper(TFooHelper) for TBar
+  end;
+
+function TFoo.TestFoo: Integer;
+begin
+  Result := 1;
+end;
+
+function TBar.TestFoo: Integer;
+begin
+  Result := 4;
+end;
+
+function TFooHelper.TestFoo: Integer;
+begin
+  Result := 2;
+end;
+
+var
+  b: TBar;
+  res: Integer;
+begin
+  b := TBar.Create;
+  res := b.TestFoo;
+  Writeln('b.TestFoo: ', res);
+  if res <> 2 then
+    Halt(1);
+  Writeln('ok');
+end.

+ 24 - 0
tests/test/uchlp82.pp

@@ -0,0 +1,24 @@
+unit uchlp82; 
+
+{$ifdef fpc}
+  {$mode objfpc}{$H+}
+{$endif}
+
+interface
+
+type
+  TFoo = class
+  strict private
+    Test1: Integer;
+  private
+    Test2: Integer;
+  strict protected
+    Test3: Integer;
+  protected
+    Test4: Integer;
+  end;
+
+implementation
+
+end.
+