فهرست منبع

I don't know why, but the tests 3-34 weren't commited the first time although I selected all of them

git-svn-id: branches/svenbarth/classhelpers@16731 -
svenbarth 14 سال پیش
والد
کامیت
9b05909944

+ 32 - 0
.gitattributes

@@ -9279,9 +9279,41 @@ tests/test/tcase8.pp svneol=native#text/pascal
 tests/test/tcase9.pp svneol=native#text/pascal
 tests/test/tcg1.pp svneol=native#text/plain
 tests/test/tchlp1.pp svneol=native#text/pascal
+tests/test/tchlp10.pp svneol=native#text/pascal
+tests/test/tchlp11.pp svneol=native#text/pascal
+tests/test/tchlp12.pp svneol=native#text/pascal
+tests/test/tchlp13.pp svneol=native#text/pascal
+tests/test/tchlp14.pp svneol=native#text/pascal
+tests/test/tchlp15.pp svneol=native#text/pascal
+tests/test/tchlp16.pp svneol=native#text/pascal
+tests/test/tchlp17.pp svneol=native#text/pascal
+tests/test/tchlp18.pp svneol=native#text/pascal
+tests/test/tchlp19.pp svneol=native#text/pascal
 tests/test/tchlp2.pp svneol=native#text/pascal
+tests/test/tchlp20.pp svneol=native#text/pascal
+tests/test/tchlp21.pp svneol=native#text/pascal
+tests/test/tchlp22.pp svneol=native#text/pascal
+tests/test/tchlp23.pp svneol=native#text/pascal
+tests/test/tchlp24.pp svneol=native#text/pascal
+tests/test/tchlp25.pp svneol=native#text/pascal
+tests/test/tchlp26.pp svneol=native#text/pascal
+tests/test/tchlp27.pp svneol=native#text/pascal
+tests/test/tchlp28.pp svneol=native#text/pascal
+tests/test/tchlp29.pp svneol=native#text/pascal
+tests/test/tchlp3.pp svneol=native#text/pascal
+tests/test/tchlp30.pp svneol=native#text/pascal
+tests/test/tchlp31.pp svneol=native#text/pascal
+tests/test/tchlp32.pp svneol=native#text/pascal
+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/tchlp4.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
+tests/test/tchlp8.pp svneol=native#text/pascal
+tests/test/tchlp9.pp svneol=native#text/pascal
 tests/test/tcint64.pp svneol=native#text/plain
 tests/test/tclass1.pp svneol=native#text/plain
 tests/test/tclass10.pp svneol=native#text/pascal

+ 25 - 0
tests/test/tchlp10.pp

@@ -0,0 +1,25 @@
+{ %NORUN }
+
+{ first simple scope test for class helpers }
+program tchlp10;
+
+{$ifdef fpc}
+  {$mode objfpc}
+{$endif}
+
+type
+  TObjectHelper = class helper for TObject
+    procedure SomeMethod;
+  end;
+
+procedure TObjectHelper.SomeMethod;
+begin
+
+end;
+
+var
+  o: TObject;
+begin
+  o.SomeMethod;
+end.
+

+ 23 - 0
tests/test/tchlp11.pp

@@ -0,0 +1,23 @@
+{ %NORUN }
+
+{ second simple scope test for class helpers }
+program tchlp11;
+
+{$ifdef fpc}
+  {$mode objfpc}
+{$endif}
+
+type
+  TObjectHelper = class helper for TObject
+    class procedure SomeMethod;
+  end;
+
+class procedure TObjectHelper.SomeMethod;
+begin
+
+end;
+
+begin
+  TObject.SomeMethod;
+end.
+

+ 34 - 0
tests/test/tchlp12.pp

@@ -0,0 +1,34 @@
+{ class helpers hide methods of the extended class }
+program tchlp12;
+
+{$ifdef fpc}
+  {$mode objfpc}
+{$endif}
+
+type
+  TFoo = class
+    function Test: Integer;
+  end;
+
+  TFooHelper = class helper for TFoo
+    function Test: Integer;
+  end;
+
+function TFoo.Test: Integer;
+begin
+  Result := 1;
+end;
+
+function TFooHelper.Test: Integer;
+begin
+  Result := 2;
+end;
+
+var
+  f: TFoo;
+begin
+  f := TFoo.Create;
+  if f.Test <> 2 then
+    Halt(1);
+end.
+

+ 43 - 0
tests/test/tchlp13.pp

@@ -0,0 +1,43 @@
+{ class helpers don't hide methods of the subclasses of the extended class }
+program tchlp13;
+
+{$ifdef fpc}
+  {$mode objfpc}
+{$endif}
+
+type
+  TFoo = class
+    function Test: Integer;
+  end;
+
+  TFooHelper = class helper for TFoo
+    function Test: Integer;
+  end;
+
+  TFooSub = class(TFoo)
+    function Test: Integer;
+  end;
+
+function TFoo.Test: Integer;
+begin
+  Result := 1;
+end;
+
+function TFooHelper.Test: Integer;
+begin
+  Result := 2;
+end;
+
+function TFooSub.Test: Integer;
+begin
+  Result := 3;
+end;
+
+var
+  f: TFooSub;
+begin
+  f := TFooSub.Create;
+  if f.Test <> 3 then
+    Halt(1);
+end.
+

+ 32 - 0
tests/test/tchlp14.pp

@@ -0,0 +1,32 @@
+{ %FAIL }
+
+{ class helpers must not override virtual methods of the extended class }
+program tchlp14;
+
+{$ifdef fpc}
+  {$mode objfpc}
+{$endif}
+
+type
+  TFoo = class
+    function Test: Integer; virtual;
+  end;
+
+  TFooHelper = class helper for TFoo
+    function Test: Integer; override;
+  end;
+
+function TFoo.Test: Integer;
+begin
+  Result := 1;
+end;
+
+function TFooHelper.Test: Integer;
+begin
+  Result := 2;
+end;
+
+begin
+
+end.
+

+ 34 - 0
tests/test/tchlp15.pp

@@ -0,0 +1,34 @@
+{ class helpers may hide virtual methods of the extended class }
+program tchlp15;
+
+{$ifdef fpc}
+  {$mode objfpc}
+{$endif}
+
+type
+  TFoo = class
+    function Test: Integer; virtual;
+  end;
+
+  TFooHelper = class helper for TFoo
+    function Test: Integer;
+  end;
+
+function TFoo.Test: Integer;
+begin
+  Result := 1;
+end;
+
+function TFooHelper.Test: Integer;
+begin
+  Result := 2;
+end;
+
+var
+  f: TFoo;
+begin
+  f := TFoo.Create;
+  if f.Test <> 2 then
+    Halt(1);
+end.
+

+ 18 - 0
tests/test/tchlp16.pp

@@ -0,0 +1,18 @@
+{ %FAIL }
+
+{ class helpers may not be referenced in any way - test 1 }
+program tchlp16;
+
+{$ifdef fpc}
+  {$mode objfpc}
+{$endif}
+
+type
+  TObjectHelper = class helper for TObject
+  end;
+
+var
+  o: TObjectHelper;
+begin
+end.
+

+ 17 - 0
tests/test/tchlp17.pp

@@ -0,0 +1,17 @@
+{ %FAIL }
+
+{ class helpers may not be referenced in any way - test 2 }
+program tchlp17;
+
+{$ifdef fpc}
+  {$mode objfpc}
+{$endif}
+
+type
+  TObjectHelper = class helper for TObject
+  end;
+
+begin
+  with TObjectHelper.Create do ;
+end.
+

+ 23 - 0
tests/test/tchlp18.pp

@@ -0,0 +1,23 @@
+{ %FAIL }
+
+{ class helpers may not be referenced in any way - test 3 }
+program tchlp18;
+
+{$ifdef fpc}
+  {$mode objfpc}
+{$endif}
+
+type
+  TObjectHelper = class helper for TObject
+    class procedure Test;
+  end;
+
+class procedure TObjectHelper.Test;
+begin
+
+end;
+
+begin
+  TObjectHelper.Test;
+end.
+

+ 21 - 0
tests/test/tchlp19.pp

@@ -0,0 +1,21 @@
+{ %FAIL }
+
+{ class helpers may not be referenced in any way - test 4 }
+program tchlp19;
+
+{$ifdef fpc}
+  {$mode objfpc}
+{$endif}
+
+type
+  TObjectHelper = class helper for TObject
+  end;
+
+procedure SomeProc(aHelper: TObjectHelper);
+begin
+
+end;
+
+begin
+end.
+

+ 20 - 0
tests/test/tchlp20.pp

@@ -0,0 +1,20 @@
+{ %FAIL }
+
+{ class helpers may not be referenced in any way - test 5 }
+program tchlp20;
+
+{$ifdef fpc}
+  {$mode objfpc}
+{$endif}
+
+type
+  TObjectHelper = class helper for TObject
+  end;
+
+  TSomeRec = record
+    helper: TObjectHelper;
+  end;
+
+begin
+end.
+

+ 19 - 0
tests/test/tchlp21.pp

@@ -0,0 +1,19 @@
+{ %FAIL }
+
+{ class helpers may not be referenced in any way - test 6 }
+program tchlp21;
+
+{$ifdef fpc}
+  {$mode objfpc}
+{$endif}
+
+type
+  TObjectHelper = class helper for TObject
+  end;
+
+  TObjectHelperHelper = class helper for TObjectHelper
+  end;
+
+begin
+end.
+

+ 35 - 0
tests/test/tchlp22.pp

@@ -0,0 +1,35 @@
+{ %FAIL }
+
+{ in mode Delphi overloading isn't enabled by default }
+program tchlp22;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+type
+  TFoo = class
+    procedure Test(const aTest: String);
+  end;
+
+  TFooHelper = class helper for TFoo
+    procedure Test;
+  end;
+
+procedure TFoo.Test(const aTest: String);
+begin
+
+end;
+
+procedure TFooHelper.Test;
+begin
+
+end;
+
+var
+  f: TFoo;
+begin
+  f := TFoo.Create;
+  f.Test('Foo');
+end.
+

+ 32 - 0
tests/test/tchlp23.pp

@@ -0,0 +1,32 @@
+{ in mode ObjFPC overloading is enabled by default }
+program tchlp23;
+
+{$mode objfpc}
+
+type
+  TFoo = class
+    procedure Test(const aTest: String);
+  end;
+
+  TFooHelper = class helper for TFoo
+    procedure Test;
+  end;
+
+procedure TFoo.Test(const aTest: String);
+begin
+
+end;
+
+procedure TFooHelper.Test;
+begin
+
+end;
+
+var
+  f: TFoo;
+begin
+  f := TFoo.Create;
+  f.Test;
+  f.Test('Foo');
+end.
+

+ 19 - 0
tests/test/tchlp24.pp

@@ -0,0 +1,19 @@
+{ %FAIL }
+
+{ class helpers may not be referenced in any way - test 7 }
+program tchlp24;
+
+{$ifdef fpc}
+  {$mode objfpc}
+{$endif}
+
+type
+  TObjectHelper = class helper for TObject
+  end;
+
+  TObjectHelperSub = class(TObjectHelper)
+  end;
+
+begin
+end.
+

+ 17 - 0
tests/test/tchlp25.pp

@@ -0,0 +1,17 @@
+{ %FAIL }
+
+{ class helpers may not contain any fields }
+program tchlp25;
+
+{$ifdef fpc}
+  {$mode objfpc}
+{$endif}
+
+type
+  TObjectHelper = class helper for TObject
+    Test: Integer;
+  end;
+
+begin
+end.
+

+ 23 - 0
tests/test/tchlp26.pp

@@ -0,0 +1,23 @@
+{ %FAIL }
+
+{ class helpers must extend the same class if inheriting }
+program tchlp26;
+
+{$ifdef fpc}
+  {$mode objfpc}
+{$endif}
+
+type
+  TObjectHelperA = class helper for TObject
+  end;
+
+  TFoo = class
+  end;
+
+  TObjectHelperB = class helper(TObjectHelperA) for TFoo
+  end;
+
+begin
+
+end.
+

+ 21 - 0
tests/test/tchlp27.pp

@@ -0,0 +1,21 @@
+{ extensive scoping test - test 1 }
+program tchlp27;
+
+{$ifdef fpc}
+  {$mode objfpc}
+{$endif}
+
+uses
+  uchlp27a, uchlp27b;
+
+var
+  f: TFoo;
+  res: Integer;
+begin
+  f := TFoo.Create;
+  res := f.Test;
+  Writeln('f.Test: ', res);
+  if res <> 2 then
+    Halt(1);
+end.
+

+ 28 - 0
tests/test/tchlp28.pp

@@ -0,0 +1,28 @@
+{ extensive scoping test - test 2 }
+program tchlp28;
+
+{$ifdef fpc}
+  {$mode objfpc}
+{$endif}
+
+uses
+  uchlp27a, uchlp27b, uchlp27c;
+
+var
+  f: TFoo;
+  b: TBar;
+  res: Integer;
+begin
+  f := TBar.Create;
+  res := f.Test;
+  Writeln('f.Test: ', res);
+  if res <> 2 then
+    Halt(1);
+
+  b := TBar.Create;
+  res := b.Test;
+  Writeln('b.Test: ', res);
+  if res <> 3 then
+    Halt(2);
+end.
+

+ 28 - 0
tests/test/tchlp29.pp

@@ -0,0 +1,28 @@
+{ extensive scoping test - test 3 }
+program tchlp29;
+
+{$ifdef fpc}
+  {$mode objfpc}
+{$endif}
+
+uses
+  uchlp27a, uchlp27c, uchlp27b;
+
+var
+  f: TFoo;
+  b: TBar;
+  res: Integer;
+begin
+  f := TBar.Create;
+  res := f.Test;
+  Writeln('f.Test: ', res);
+  if res <> 2 then
+    Halt(1);
+
+  b := TBar.Create;
+  res := b.Test;
+  Writeln('b.Test: ', res);
+  if res <> 3 then
+    Halt(2);
+end.
+

+ 19 - 0
tests/test/tchlp3.pp

@@ -0,0 +1,19 @@
+{%FAIL}
+
+{ forward declarations are not allowed }
+program tchlp3;
+
+{$ifdef fpc}
+  {$mode objfpc}
+{$endif}
+
+type
+  TObjectHelper = class helper for TObject;
+
+  TObjectHelper = class helper for TObject
+  end;
+
+begin
+
+end.
+

+ 21 - 0
tests/test/tchlp30.pp

@@ -0,0 +1,21 @@
+{ extensive scoping test - test 4 }
+program tchlp30;
+
+{$ifdef fpc}
+  {$mode objfpc}
+{$endif}
+
+uses
+  uchlp27b, uchlp27a;
+
+var
+  f: TFoo;
+  res: Integer;
+begin
+  f := TFoo.Create;
+  res := f.Test;
+  Writeln('f.Test: ', res);
+  if res <> 2 then
+    Halt(1);
+end.
+

+ 21 - 0
tests/test/tchlp31.pp

@@ -0,0 +1,21 @@
+{ extensive scoping test - test 5 }
+program tchlp31;
+
+{$ifdef fpc}
+  {$mode objfpc}
+{$endif}
+
+uses
+  uchlp27b, uchlp27c;
+
+var
+  b: TBar;
+  res: Integer;
+begin
+  b := TBar.Create;
+  res := b.Test;
+  Writeln('b.Test: ', res);
+  if res <> 3 then
+    Halt(1);
+end.
+

+ 19 - 0
tests/test/tchlp32.pp

@@ -0,0 +1,19 @@
+{ %FAIL }
+
+{ only the last available class helper for a class must be used - test 1 }
+program tchlp32;
+
+{$ifdef fpc}
+  {$mode objfpc}
+{$endif}
+
+uses
+  uchlp32a, uchlp32b, uchlp32c;
+
+var
+  f: TFoo;
+begin
+  f := TFoo.Create;
+  f.Method1;
+end.
+

+ 21 - 0
tests/test/tchlp33.pp

@@ -0,0 +1,21 @@
+{ only the last available class helper for a class must be used - test 2 }
+program tchlp33;
+
+{$ifdef fpc}
+  {$mode objfpc}
+{$endif}
+
+uses
+  uchlp33a, uchlp33c, uchlp33b;
+
+var
+  f: TFoo;
+  res: Integer;
+begin
+  f := TFoo.Create;
+  res := f.Test;
+  Writeln('f.Test: ', res);
+  if res <> 1 then
+    Halt(1);
+end.
+

+ 20 - 0
tests/test/tchlp34.pp

@@ -0,0 +1,20 @@
+{ %FAIL }
+
+{ a class helper can only inherit from another class helper }
+program tchlp34;
+
+{$ifdef fpc}
+  {$mode objfpc}
+{$endif}
+
+type
+  TFoo = class
+
+  end;
+
+  TObjectHelper = class helper(TFoo) for TObject
+  end;
+
+begin
+end.
+

+ 18 - 0
tests/test/tchlp4.pp

@@ -0,0 +1,18 @@
+{%FAIL}
+
+{ destructors are not allowed }
+program tchlp4;
+
+{$ifdef fpc}
+  {$mode objfpc}
+{$endif}
+
+type
+  TObjectHelper = class helper for TObject
+    destructor Destroy; override;
+  end;
+
+begin
+
+end.
+

+ 18 - 0
tests/test/tchlp5.pp

@@ -0,0 +1,18 @@
+{%FAIL}
+
+{ class destructors are not allowed }
+program tchlp5;
+
+{$ifdef fpc}
+  {$mode objfpc}
+{$endif}
+
+type
+  TObjectHelper = class helper for TObject
+    class destructor Destroy; override;
+  end;
+
+begin
+
+end.
+

+ 27 - 0
tests/test/tchlp6.pp

@@ -0,0 +1,27 @@
+{%NORUN}
+
+{ message methods are allowed in mode Delphi }
+program tchlp6;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+type
+  TMessage = record
+    ID: LongWord;
+  end;
+
+  TObjectHelper = class helper for TObject
+    procedure SomeMessage(var aMessage: TMessage); message 42;
+  end;
+
+procedure TObjectHelper.SomeMessage(var aMessage: TMessage);
+begin
+
+end;
+
+begin
+
+end.
+

+ 25 - 0
tests/test/tchlp7.pp

@@ -0,0 +1,25 @@
+{%FAIL}
+
+{ message methods are not allowed in mode ObjFPC }
+program tchlp7;
+
+{$mode objfpc}
+
+type
+  TMessage = record
+    ID: LongWord;
+  end;
+
+  TObjectHelper = class helper for TObject
+    procedure SomeMessage(var aMessage: TMessage); message 42;
+  end;
+
+procedure TObjectHelper.SomeMessage(var aMessage: TMessage);
+begin
+
+end;
+
+begin
+
+end.
+

+ 18 - 0
tests/test/tchlp8.pp

@@ -0,0 +1,18 @@
+{%FAIL}
+
+{ abstract methods are not allowed }
+program tchlp8;
+
+{$ifdef fpc}
+  {$mode objfpc}
+{$endif}
+
+type
+  TObjectHelper = class helper for TObject
+    procedure SomeMethod; virtual; abstract;
+  end;
+
+begin
+
+end.
+

+ 32 - 0
tests/test/tchlp9.pp

@@ -0,0 +1,32 @@
+{%NORUN}
+
+{ class helper inheritance syntax }
+program tchlp9;
+
+{$ifdef fpc}
+  {$mode objfpc}
+{$endif}
+
+type
+  TObjectHelperA = class helper for TObject
+    procedure SomeMethodA;
+  end;
+
+  TObjectHelperB = class helper(TObjectHelperA) for TObject
+    procedure SomeMethodB;
+  end;
+
+procedure TObjectHelperA.SomeMethodA;
+begin
+
+end;
+
+procedure TObjectHelperB.SomeMethodB;
+begin
+
+end;
+
+begin
+
+end.
+