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 -
This commit is contained in:
svenbarth 2011-01-07 22:02:01 +00:00
parent 18ed600cbe
commit 9b05909944
33 changed files with 803 additions and 0 deletions

32
.gitattributes vendored
View File

@ -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
tests/test/tchlp10.pp Normal file
View File

@ -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
tests/test/tchlp11.pp Normal file
View File

@ -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
tests/test/tchlp12.pp Normal file
View File

@ -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
tests/test/tchlp13.pp Normal file
View File

@ -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
tests/test/tchlp14.pp Normal file
View File

@ -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
tests/test/tchlp15.pp Normal file
View File

@ -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
tests/test/tchlp16.pp Normal file
View File

@ -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
tests/test/tchlp17.pp Normal file
View File

@ -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
tests/test/tchlp18.pp Normal file
View File

@ -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
tests/test/tchlp19.pp Normal file
View File

@ -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
tests/test/tchlp20.pp Normal file
View File

@ -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
tests/test/tchlp21.pp Normal file
View File

@ -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
tests/test/tchlp22.pp Normal file
View File

@ -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
tests/test/tchlp23.pp Normal file
View File

@ -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
tests/test/tchlp24.pp Normal file
View File

@ -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
tests/test/tchlp25.pp Normal file
View File

@ -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
tests/test/tchlp26.pp Normal file
View File

@ -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
tests/test/tchlp27.pp Normal file
View File

@ -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
tests/test/tchlp28.pp Normal file
View File

@ -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
tests/test/tchlp29.pp Normal file
View File

@ -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
tests/test/tchlp3.pp Normal file
View File

@ -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
tests/test/tchlp30.pp Normal file
View File

@ -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
tests/test/tchlp31.pp Normal file
View File

@ -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
tests/test/tchlp32.pp Normal file
View File

@ -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
tests/test/tchlp33.pp Normal file
View File

@ -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
tests/test/tchlp34.pp Normal file
View File

@ -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
tests/test/tchlp4.pp Normal file
View File

@ -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
tests/test/tchlp5.pp Normal file
View File

@ -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
tests/test/tchlp6.pp Normal file
View File

@ -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
tests/test/tchlp7.pp Normal file
View File

@ -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
tests/test/tchlp8.pp Normal file
View File

@ -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
tests/test/tchlp9.pp Normal file
View File

@ -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.