mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-07 06:28:55 +02:00
Completely restructured the test for the helper feature. The tests were split into three categories:
* general tests for the helper feature (thlp*) * tests for class helpers (tchlp*) * tests for record helpers (trhlp*) With my current yet-to-be-commited implementation nearly all tests pass, but some fail because of missing FPC features: * thlp30.pp currently fails because of generic constraints, but should fail despite the constraints * thlp29.pp fails, because generic methods are not yet supported * trhlp8.pp, trhlp9.pp, trhlp10.pp fail, because one can't use default properties using the abbreviated syntax * trhlp17.pp, trhlp18.pp, trhlp19.pp fail, because nested types are not supported for records git-svn-id: branches/svenbarth/classhelpers@17237 -
This commit is contained in:
svenbarth
parent
f7f357f18e
commit
553d357d64
146
.gitattributes
vendored
146
.gitattributes
vendored
@ -9567,45 +9567,10 @@ tests/test/tchlp51.pp svneol=native#text/pascal
|
||||
tests/test/tchlp52.pp svneol=native#text/pascal
|
||||
tests/test/tchlp53.pp svneol=native#text/pascal
|
||||
tests/test/tchlp54.pp svneol=native#text/pascal
|
||||
tests/test/tchlp55.pp svneol=native#text/pascal
|
||||
tests/test/tchlp56.pp svneol=native#text/pascal
|
||||
tests/test/tchlp57.pp svneol=native#text/pascal
|
||||
tests/test/tchlp58.pp svneol=native#text/pascal
|
||||
tests/test/tchlp59.pp svneol=native#text/pascal
|
||||
tests/test/tchlp6.pp svneol=native#text/pascal
|
||||
tests/test/tchlp61.pp svneol=native#text/pascal
|
||||
tests/test/tchlp62.pp svneol=native#text/pascal
|
||||
tests/test/tchlp63.pp svneol=native#text/pascal
|
||||
tests/test/tchlp64.pp svneol=native#text/pascal
|
||||
tests/test/tchlp65.pp svneol=native#text/pascal
|
||||
tests/test/tchlp66.pp svneol=native#text/pascal
|
||||
tests/test/tchlp67.pp svneol=native#text/pascal
|
||||
tests/test/tchlp68.pp svneol=native#text/pascal
|
||||
tests/test/tchlp69.pp svneol=native#text/pascal
|
||||
tests/test/tchlp7.pp svneol=native#text/pascal
|
||||
tests/test/tchlp70.pp svneol=native#text/pascal
|
||||
tests/test/tchlp71.pp svneol=native#text/pascal
|
||||
tests/test/tchlp72.pp svneol=native#text/pascal
|
||||
tests/test/tchlp73.pp svneol=native#text/pascal
|
||||
tests/test/tchlp74.pp svneol=native#text/pascal
|
||||
tests/test/tchlp75.pp svneol=native#text/pascal
|
||||
tests/test/tchlp76.pp svneol=native#text/pascal
|
||||
tests/test/tchlp77.pp svneol=native#text/pascal
|
||||
tests/test/tchlp78.pp svneol=native#text/pascal
|
||||
tests/test/tchlp79.pp svneol=native#text/pascal
|
||||
tests/test/tchlp8.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/tchlp90.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
|
||||
@ -9765,6 +9730,50 @@ tests/test/theap.pp svneol=native#text/plain
|
||||
tests/test/theapthread.pp svneol=native#text/plain
|
||||
tests/test/thintdir.pp svneol=native#text/plain
|
||||
tests/test/thintdir1.pp svneol=native#text/pascal
|
||||
tests/test/thlp1.pp svneol=native#text/pascal
|
||||
tests/test/thlp10.pp svneol=native#text/pascal
|
||||
tests/test/thlp11.pp svneol=native#text/pascal
|
||||
tests/test/thlp12.pp svneol=native#text/pascal
|
||||
tests/test/thlp13.pp svneol=native#text/pascal
|
||||
tests/test/thlp14.pp svneol=native#text/pascal
|
||||
tests/test/thlp15.pp svneol=native#text/pascal
|
||||
tests/test/thlp16.pp svneol=native#text/pascal
|
||||
tests/test/thlp17.pp svneol=native#text/pascal
|
||||
tests/test/thlp18.pp svneol=native#text/pascal
|
||||
tests/test/thlp19.pp svneol=native#text/pascal
|
||||
tests/test/thlp2.pp svneol=native#text/pascal
|
||||
tests/test/thlp20.pp svneol=native#text/pascal
|
||||
tests/test/thlp21.pp svneol=native#text/pascal
|
||||
tests/test/thlp22.pp svneol=native#text/pascal
|
||||
tests/test/thlp23.pp svneol=native#text/pascal
|
||||
tests/test/thlp24.pp svneol=native#text/pascal
|
||||
tests/test/thlp25.pp svneol=native#text/pascal
|
||||
tests/test/thlp26.pp svneol=native#text/pascal
|
||||
tests/test/thlp27.pp svneol=native#text/pascal
|
||||
tests/test/thlp28.pp svneol=native#text/pascal
|
||||
tests/test/thlp29.pp svneol=native#text/pascal
|
||||
tests/test/thlp3.pp svneol=native#text/pascal
|
||||
tests/test/thlp30.pp svneol=native#text/pascal
|
||||
tests/test/thlp31.pp svneol=native#text/pascal
|
||||
tests/test/thlp32.pp svneol=native#text/pascal
|
||||
tests/test/thlp33.pp svneol=native#text/pascal
|
||||
tests/test/thlp34.pp svneol=native#text/pascal
|
||||
tests/test/thlp35.pp svneol=native#text/pascal
|
||||
tests/test/thlp36.pp svneol=native#text/pascal
|
||||
tests/test/thlp37.pp svneol=native#text/pascal
|
||||
tests/test/thlp38.pp svneol=native#text/pascal
|
||||
tests/test/thlp39.pp svneol=native#text/pascal
|
||||
tests/test/thlp4.pp svneol=native#text/pascal
|
||||
tests/test/thlp40.pp svneol=native#text/pascal
|
||||
tests/test/thlp41.pp svneol=native#text/pascal
|
||||
tests/test/thlp42.pp svneol=native#text/pascal
|
||||
tests/test/thlp43.pp svneol=native#text/pascal
|
||||
tests/test/thlp44.pp svneol=native#text/pascal
|
||||
tests/test/thlp5.pp svneol=native#text/pascal
|
||||
tests/test/thlp6.pp svneol=native#text/pascal
|
||||
tests/test/thlp7.pp svneol=native#text/pascal
|
||||
tests/test/thlp8.pp svneol=native#text/pascal
|
||||
tests/test/thlp9.pp svneol=native#text/pascal
|
||||
tests/test/timplements1.pp svneol=native#text/plain
|
||||
tests/test/timplements2.pp svneol=native#text/plain
|
||||
tests/test/timplements3.pp svneol=native#text/plain
|
||||
@ -10031,6 +10040,47 @@ tests/test/trecreg2.pp svneol=native#text/plain
|
||||
tests/test/trecreg3.pp svneol=native#text/plain
|
||||
tests/test/trecreg4.pp svneol=native#text/plain
|
||||
tests/test/tresstr.pp svneol=native#text/plain
|
||||
tests/test/trhlp1.pp svneol=native#text/pascal
|
||||
tests/test/trhlp10.pp svneol=native#text/pascal
|
||||
tests/test/trhlp11.pp svneol=native#text/pascal
|
||||
tests/test/trhlp12.pp svneol=native#text/pascal
|
||||
tests/test/trhlp13.pp svneol=native#text/pascal
|
||||
tests/test/trhlp14.pp svneol=native#text/pascal
|
||||
tests/test/trhlp15.pp svneol=native#text/pascal
|
||||
tests/test/trhlp16.pp svneol=native#text/pascal
|
||||
tests/test/trhlp17.pp svneol=native#text/pascal
|
||||
tests/test/trhlp18.pp svneol=native#text/pascal
|
||||
tests/test/trhlp19.pp svneol=native#text/pascal
|
||||
tests/test/trhlp2.pp svneol=native#text/pascal
|
||||
tests/test/trhlp20.pp svneol=native#text/pascal
|
||||
tests/test/trhlp21.pp svneol=native#text/pascal
|
||||
tests/test/trhlp22.pp svneol=native#text/pascal
|
||||
tests/test/trhlp23.pp svneol=native#text/pascal
|
||||
tests/test/trhlp24.pp svneol=native#text/pascal
|
||||
tests/test/trhlp25.pp svneol=native#text/pascal
|
||||
tests/test/trhlp26.pp svneol=native#text/pascal
|
||||
tests/test/trhlp27.pp svneol=native#text/pascal
|
||||
tests/test/trhlp28.pp svneol=native#text/pascal
|
||||
tests/test/trhlp29.pp svneol=native#text/pascal
|
||||
tests/test/trhlp3.pp svneol=native#text/pascal
|
||||
tests/test/trhlp30.pp svneol=native#text/pascal
|
||||
tests/test/trhlp31.pp svneol=native#text/pascal
|
||||
tests/test/trhlp32.pp svneol=native#text/pascal
|
||||
tests/test/trhlp33.pp svneol=native#text/pascal
|
||||
tests/test/trhlp34.pp svneol=native#text/pascal
|
||||
tests/test/trhlp35.pp svneol=native#text/pascal
|
||||
tests/test/trhlp36.pp svneol=native#text/pascal
|
||||
tests/test/trhlp37.pp svneol=native#text/pascal
|
||||
tests/test/trhlp38.pp svneol=native#text/pascal
|
||||
tests/test/trhlp39.pp svneol=native#text/pascal
|
||||
tests/test/trhlp4.pp svneol=native#text/pascal
|
||||
tests/test/trhlp40.pp svneol=native#text/pascal
|
||||
tests/test/trhlp41.pp svneol=native#text/pascal
|
||||
tests/test/trhlp5.pp svneol=native#text/pascal
|
||||
tests/test/trhlp6.pp svneol=native#text/pascal
|
||||
tests/test/trhlp7.pp svneol=native#text/pascal
|
||||
tests/test/trhlp8.pp svneol=native#text/pascal
|
||||
tests/test/trhlp9.pp svneol=native#text/pascal
|
||||
tests/test/trox1.pp svneol=native#text/plain
|
||||
tests/test/trox2.pp svneol=native#text/plain
|
||||
tests/test/trstr1.pp svneol=native#text/plain
|
||||
@ -10138,22 +10188,8 @@ tests/test/twrstr6.pp svneol=native#text/plain
|
||||
tests/test/twrstr7.pp svneol=native#text/plain
|
||||
tests/test/twrstr8.pp svneol=native#text/plain
|
||||
tests/test/uabstrcl.pp svneol=native#text/plain
|
||||
tests/test/uchlp27a.pp svneol=native#text/pascal
|
||||
tests/test/uchlp27b.pp svneol=native#text/pascal
|
||||
tests/test/uchlp27c.pp svneol=native#text/pascal
|
||||
tests/test/uchlp32a.pp svneol=native#text/pascal
|
||||
tests/test/uchlp32b.pp svneol=native#text/pascal
|
||||
tests/test/uchlp32c.pp svneol=native#text/pascal
|
||||
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/uchlp50.pp svneol=native#text/pascal
|
||||
tests/test/uchlp51a.pp svneol=native#text/pascal
|
||||
tests/test/uchlp51b.pp svneol=native#text/pascal
|
||||
tests/test/uchlp51c.pp svneol=native#text/pascal
|
||||
tests/test/uchlp82.pp svneol=native#text/pascal
|
||||
tests/test/uchlp12.pp svneol=native#text/pascal
|
||||
tests/test/uchlp18.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
|
||||
@ -10162,6 +10198,12 @@ tests/test/ugeneric3.pp svneol=native#text/plain
|
||||
tests/test/ugeneric4.pp svneol=native#text/plain
|
||||
tests/test/ugeneric7.pp svneol=native#text/plain
|
||||
tests/test/uhintdir.pp svneol=native#text/plain
|
||||
tests/test/uhlp3.pp svneol=native#text/pascal
|
||||
tests/test/uhlp31.pp svneol=native#text/pascal
|
||||
tests/test/uhlp39.pp svneol=native#text/pascal
|
||||
tests/test/uhlp41a.pp svneol=native#text/pascal
|
||||
tests/test/uhlp41b.pp svneol=native#text/pascal
|
||||
tests/test/uhlp43.pp svneol=native#text/pascal
|
||||
tests/test/uimpluni1.pp svneol=native#text/plain
|
||||
tests/test/uimpluni2.pp svneol=native#text/plain
|
||||
tests/test/uinline4a.pp svneol=native#text/plain
|
||||
@ -10325,6 +10367,8 @@ tests/test/uprec6.pp svneol=native#text/plain
|
||||
tests/test/uprec7.pp svneol=native#text/plain
|
||||
tests/test/uprocext1.pp svneol=native#text/plain
|
||||
tests/test/uprocext2.pp svneol=native#text/plain
|
||||
tests/test/urhlp14.pp svneol=native#text/pascal
|
||||
tests/test/urhlp17.pp svneol=native#text/pascal
|
||||
tests/test/utasout.pp svneol=native#text/plain
|
||||
tests/test/uunit1.pp svneol=native#text/plain
|
||||
tests/test/uunit2a.pp svneol=native#text/plain
|
||||
|
||||
@ -1,50 +1,29 @@
|
||||
{%NORUN}
|
||||
{ %NORUN }
|
||||
|
||||
{ checks for support of the class helper syntax in mode objfpc }
|
||||
{ this tests that helpers can introduce instance methods for classes - mode
|
||||
Delphi }
|
||||
program tchlp1;
|
||||
|
||||
{$mode objfpc}
|
||||
{$ifdef fpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
|
||||
type
|
||||
TObjectHelper = class helper for TObject
|
||||
procedure SomePublicMethod;
|
||||
strict private
|
||||
procedure SomeStrictPrivateMethod;
|
||||
private
|
||||
procedure SomePrivateMethod;
|
||||
strict protected
|
||||
procedure SomeStrictProtectedMethod;
|
||||
protected
|
||||
procedure SomeProtectedMethod;
|
||||
public
|
||||
procedure SomePublicMethod2;
|
||||
TTest = class
|
||||
|
||||
end;
|
||||
|
||||
procedure TObjectHelper.SomePublicMethod;
|
||||
TTestHelper = class helper for TTest
|
||||
procedure Test;
|
||||
end;
|
||||
|
||||
procedure TTestHelper.Test;
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
procedure TObjectHelper.SomeStrictPrivateMethod;
|
||||
var
|
||||
t: TTest;
|
||||
begin
|
||||
end;
|
||||
|
||||
procedure TObjectHelper.SomePrivateMethod;
|
||||
begin
|
||||
end;
|
||||
|
||||
procedure TObjectHelper.SomeStrictProtectedMethod;
|
||||
begin
|
||||
end;
|
||||
|
||||
procedure TObjectHelper.SomeProtectedMethod;
|
||||
begin
|
||||
end;
|
||||
|
||||
procedure TObjectHelper.SomePublicMethod2;
|
||||
begin
|
||||
end;
|
||||
|
||||
begin
|
||||
|
||||
t.Test;
|
||||
end.
|
||||
|
||||
|
||||
@ -1,25 +1,40 @@
|
||||
{ %NORUN }
|
||||
|
||||
{ first simple scope test for class helpers }
|
||||
{ method modifiers of the extended class are completly irrelevant }
|
||||
program tchlp10;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode objfpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
|
||||
type
|
||||
TObjectHelper = class helper for TObject
|
||||
procedure SomeMethod;
|
||||
TTest = class
|
||||
procedure Test; virtual;
|
||||
end;
|
||||
|
||||
procedure TObjectHelper.SomeMethod;
|
||||
TTestHelper = class helper for TTest
|
||||
procedure Test; virtual;
|
||||
end;
|
||||
|
||||
TTestHelperSub = class helper(TTestHelper) for TTest
|
||||
procedure Test; override;
|
||||
end;
|
||||
|
||||
procedure TTest.Test;
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
var
|
||||
o: TObject;
|
||||
procedure TTestHelper.Test;
|
||||
begin
|
||||
o.SomeMethod;
|
||||
end.
|
||||
|
||||
end;
|
||||
|
||||
procedure TTestHelperSub.Test;
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
begin
|
||||
|
||||
end.
|
||||
|
||||
@ -1,23 +1,20 @@
|
||||
{ %NORUN }
|
||||
{ %FAIL }
|
||||
|
||||
{ second simple scope test for class helpers }
|
||||
{ it's forbidden for a class helper to extend a record }
|
||||
program tchlp11;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode objfpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
|
||||
type
|
||||
TObjectHelper = class helper for TObject
|
||||
class procedure SomeMethod;
|
||||
TTest = record
|
||||
|
||||
end;
|
||||
|
||||
class procedure TObjectHelper.SomeMethod;
|
||||
begin
|
||||
|
||||
end;
|
||||
TTestHelper = class helper for TTest
|
||||
end;
|
||||
|
||||
begin
|
||||
TObject.SomeMethod;
|
||||
|
||||
end.
|
||||
|
||||
|
||||
@ -1,35 +1,25 @@
|
||||
{ class helpers hide methods of the extended class }
|
||||
{ %FAIL }
|
||||
|
||||
{ class helpers can access (strict) protected, public and published members -
|
||||
here: strict private }
|
||||
program tchlp12;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode objfpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
|
||||
uses
|
||||
uchlp12;
|
||||
|
||||
type
|
||||
TFoo = class
|
||||
function Test: Integer;
|
||||
TTestHelper = class helper for TTest
|
||||
function AccessTest: Integer;
|
||||
end;
|
||||
|
||||
TFooHelper = class helper for TFoo
|
||||
function Test: Integer;
|
||||
end;
|
||||
|
||||
function TFoo.Test: Integer;
|
||||
function TTestHelper.AccessTest: Integer;
|
||||
begin
|
||||
Result := 1;
|
||||
Result := Test1;
|
||||
end;
|
||||
|
||||
function TFooHelper.Test: Integer;
|
||||
begin
|
||||
Result := 2;
|
||||
end;
|
||||
|
||||
var
|
||||
f: TFoo;
|
||||
begin
|
||||
f := TFoo.Create;
|
||||
if f.Test <> 2 then
|
||||
Halt(1);
|
||||
Writeln('ok');
|
||||
end.
|
||||
|
||||
|
||||
@ -1,44 +1,26 @@
|
||||
{ class helpers don't hide methods of the subclasses of the extended class }
|
||||
{ %FAIL }
|
||||
|
||||
{ class helpers can access (strict) protected, public and published members -
|
||||
here: private }
|
||||
program tchlp13;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode objfpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
|
||||
uses
|
||||
uchlp12;
|
||||
|
||||
type
|
||||
TFoo = class
|
||||
function Test: Integer;
|
||||
TTestHelper = class helper for TTest
|
||||
function AccessTest: Integer;
|
||||
end;
|
||||
|
||||
TFooHelper = class helper for TFoo
|
||||
function Test: Integer;
|
||||
end;
|
||||
|
||||
TFooSub = class(TFoo)
|
||||
function Test: Integer;
|
||||
end;
|
||||
|
||||
function TFoo.Test: Integer;
|
||||
function TTestHelper.AccessTest: Integer;
|
||||
begin
|
||||
Result := 1;
|
||||
Result := Test2;
|
||||
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);
|
||||
Writeln('ok');
|
||||
end.
|
||||
|
||||
|
||||
@ -1,32 +1,26 @@
|
||||
{ %FAIL }
|
||||
{ %NORUN }
|
||||
|
||||
{ class helpers must not override virtual methods of the extended class }
|
||||
{ class helpers can access (strict) protected, public and published members -
|
||||
here: strict protected }
|
||||
program tchlp14;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
|
||||
uses
|
||||
uchlp12;
|
||||
|
||||
type
|
||||
TFoo = class
|
||||
function Test: Integer; virtual;
|
||||
TTestHelper = class helper for TTest
|
||||
function AccessTest: Integer;
|
||||
end;
|
||||
|
||||
TFooHelper = class helper for TFoo
|
||||
function Test: Integer; override;
|
||||
end;
|
||||
|
||||
function TFoo.Test: Integer;
|
||||
function TTestHelper.AccessTest: Integer;
|
||||
begin
|
||||
Result := 1;
|
||||
end;
|
||||
|
||||
function TFooHelper.Test: Integer;
|
||||
begin
|
||||
Result := 2;
|
||||
Result := Test3;
|
||||
end;
|
||||
|
||||
begin
|
||||
|
||||
end.
|
||||
|
||||
|
||||
@ -1,35 +1,26 @@
|
||||
{ class helpers may hide virtual methods of the extended class }
|
||||
{ %NORUN }
|
||||
|
||||
{ class helpers can access (strict) protected, public and published members -
|
||||
here: protected }
|
||||
program tchlp15;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode objfpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
|
||||
uses
|
||||
uchlp12;
|
||||
|
||||
type
|
||||
TFoo = class
|
||||
function Test: Integer; virtual;
|
||||
TTestHelper = class helper for TTest
|
||||
function AccessTest: Integer;
|
||||
end;
|
||||
|
||||
TFooHelper = class helper for TFoo
|
||||
function Test: Integer;
|
||||
end;
|
||||
|
||||
function TFoo.Test: Integer;
|
||||
function TTestHelper.AccessTest: Integer;
|
||||
begin
|
||||
Result := 1;
|
||||
Result := Test4;
|
||||
end;
|
||||
|
||||
function TFooHelper.Test: Integer;
|
||||
begin
|
||||
Result := 2;
|
||||
end;
|
||||
|
||||
var
|
||||
f: TFoo;
|
||||
begin
|
||||
f := TFoo.Create;
|
||||
if f.Test <> 2 then
|
||||
Halt(1);
|
||||
Writeln('ok');
|
||||
end.
|
||||
|
||||
|
||||
@ -1,18 +1,26 @@
|
||||
{ %FAIL }
|
||||
{ %NORUN }
|
||||
|
||||
{ class helpers may not be referenced in any way - test 1 }
|
||||
{ class helpers can access (strict) protected, public and published members -
|
||||
here: public }
|
||||
program tchlp16;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode objfpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
|
||||
uses
|
||||
uchlp12;
|
||||
|
||||
type
|
||||
TObjectHelper = class helper for TObject
|
||||
TTestHelper = class helper for TTest
|
||||
function AccessTest: Integer;
|
||||
end;
|
||||
|
||||
var
|
||||
o: TObjectHelper;
|
||||
function TTestHelper.AccessTest: Integer;
|
||||
begin
|
||||
Result := Test5;
|
||||
end;
|
||||
|
||||
begin
|
||||
end.
|
||||
|
||||
|
||||
@ -1,17 +1,26 @@
|
||||
{ %FAIL }
|
||||
{ %NORUN }
|
||||
|
||||
{ class helpers may not be referenced in any way - test 2 }
|
||||
{ class helpers can access (strict) protected, public and published members -
|
||||
here: published }
|
||||
program tchlp17;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode objfpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
|
||||
uses
|
||||
uchlp12;
|
||||
|
||||
type
|
||||
TObjectHelper = class helper for TObject
|
||||
TTestHelper = class helper for TTest
|
||||
function AccessTest: Integer;
|
||||
end;
|
||||
|
||||
function TTestHelper.AccessTest: Integer;
|
||||
begin
|
||||
Result := Test6;
|
||||
end;
|
||||
|
||||
begin
|
||||
with TObjectHelper.Create do ;
|
||||
end.
|
||||
|
||||
|
||||
@ -1,23 +1,18 @@
|
||||
{ %FAIL }
|
||||
|
||||
{ class helpers may not be referenced in any way - test 3 }
|
||||
{ usage of nested helpers adheres to visibility rules as well - here:
|
||||
strict private }
|
||||
program tchlp18;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode objfpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
|
||||
type
|
||||
TObjectHelper = class helper for TObject
|
||||
class procedure Test;
|
||||
end;
|
||||
uses
|
||||
uchlp18;
|
||||
|
||||
class procedure TObjectHelper.Test;
|
||||
var
|
||||
t: TTest1;
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
begin
|
||||
TObjectHelper.Test;
|
||||
t.Test;
|
||||
end.
|
||||
|
||||
|
||||
@ -1,21 +1,19 @@
|
||||
{ %FAIL }
|
||||
|
||||
{ class helpers may not be referenced in any way - test 4 }
|
||||
{ usage of nested helpers adheres to visibility rules as well - here:
|
||||
private }
|
||||
program tchlp19;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode objfpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
|
||||
type
|
||||
TObjectHelper = class helper for TObject
|
||||
end;
|
||||
|
||||
procedure SomeProc(aHelper: TObjectHelper);
|
||||
begin
|
||||
|
||||
end;
|
||||
uses
|
||||
uchlp18;
|
||||
|
||||
var
|
||||
t: TTest2;
|
||||
begin
|
||||
t.Test;
|
||||
end.
|
||||
|
||||
|
||||
@ -1,6 +1,7 @@
|
||||
{%NORUN}
|
||||
{ %NORUN }
|
||||
|
||||
{ checks for support of the class helper syntax in mode delphi }
|
||||
{ this tests that helpers can introduce class methods for classes - mode
|
||||
Delphi }
|
||||
program tchlp2;
|
||||
|
||||
{$ifdef fpc}
|
||||
@ -8,45 +9,20 @@ program tchlp2;
|
||||
{$endif}
|
||||
|
||||
type
|
||||
TObjectHelper = class helper for TObject
|
||||
procedure SomePublicMethod;
|
||||
strict private
|
||||
procedure SomeStrictPrivateMethod;
|
||||
private
|
||||
procedure SomePrivateMethod;
|
||||
strict protected
|
||||
procedure SomeStrictProtectedMethod;
|
||||
protected
|
||||
procedure SomeProtectedMethod;
|
||||
public
|
||||
procedure SomePublicMethod2;
|
||||
TTest = class
|
||||
|
||||
end;
|
||||
|
||||
procedure TObjectHelper.SomePublicMethod;
|
||||
begin
|
||||
end;
|
||||
TTestHelper = class helper for TTest
|
||||
class procedure Test;
|
||||
end;
|
||||
|
||||
procedure TObjectHelper.SomeStrictPrivateMethod;
|
||||
class procedure TTestHelper.Test;
|
||||
begin
|
||||
end;
|
||||
|
||||
procedure TObjectHelper.SomePrivateMethod;
|
||||
begin
|
||||
end;
|
||||
|
||||
procedure TObjectHelper.SomeStrictProtectedMethod;
|
||||
begin
|
||||
end;
|
||||
|
||||
procedure TObjectHelper.SomeProtectedMethod;
|
||||
begin
|
||||
end;
|
||||
|
||||
procedure TObjectHelper.SomePublicMethod2;
|
||||
begin
|
||||
end;
|
||||
|
||||
begin
|
||||
|
||||
TTest.Test;
|
||||
end.
|
||||
|
||||
|
||||
@ -1,20 +1,19 @@
|
||||
{ %FAIL }
|
||||
|
||||
{ class helpers may not be referenced in any way - test 5 }
|
||||
{ usage of nested helpers adheres to visibility rules as well - here:
|
||||
strict protected }
|
||||
program tchlp20;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode objfpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
|
||||
type
|
||||
TObjectHelper = class helper for TObject
|
||||
end;
|
||||
|
||||
TSomeRec = record
|
||||
helper: TObjectHelper;
|
||||
end;
|
||||
uses
|
||||
uchlp18;
|
||||
|
||||
var
|
||||
t: TTest3;
|
||||
begin
|
||||
t.Test;
|
||||
end.
|
||||
|
||||
|
||||
@ -1,19 +1,19 @@
|
||||
{ %FAIL }
|
||||
|
||||
{ class helpers may not be referenced in any way - test 6 }
|
||||
program tchlp21;
|
||||
{ usage of nested helpers adheres to visibility rules as well - here:
|
||||
protected }
|
||||
program tchlp18;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode objfpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
|
||||
type
|
||||
TObjectHelper = class helper for TObject
|
||||
end;
|
||||
|
||||
TObjectHelperHelper = class helper for TObjectHelper
|
||||
end;
|
||||
uses
|
||||
uchlp18;
|
||||
|
||||
var
|
||||
t: TTest4;
|
||||
begin
|
||||
t.Test;
|
||||
end.
|
||||
|
||||
|
||||
@ -1,35 +1,19 @@
|
||||
{ %FAIL }
|
||||
{ %NORUN }
|
||||
|
||||
{ overloading needs to be enabled explicitly }
|
||||
{ usage of nested helpers adheres to visibility rules as well - here:
|
||||
public }
|
||||
program tchlp22;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode objfpc}
|
||||
{$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;
|
||||
uses
|
||||
uchlp18;
|
||||
|
||||
var
|
||||
f: TFoo;
|
||||
t: TTest5;
|
||||
begin
|
||||
f := TFoo.Create;
|
||||
f.Test('Foo');
|
||||
t.Test;
|
||||
end.
|
||||
|
||||
|
||||
@ -1,36 +1,19 @@
|
||||
{ %NORUN }
|
||||
|
||||
{ overloading needs to be enabled explicitly }
|
||||
{ usage of nested helpers adheres to visibility rules as well - here:
|
||||
published }
|
||||
program tchlp23;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode objfpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
|
||||
type
|
||||
TFoo = class
|
||||
procedure Test(const aTest: String);
|
||||
end;
|
||||
|
||||
TFooHelper = class helper for TFoo
|
||||
procedure Test; overload;
|
||||
end;
|
||||
|
||||
procedure TFoo.Test(const aTest: String);
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
procedure TFooHelper.Test;
|
||||
begin
|
||||
|
||||
end;
|
||||
uses
|
||||
uchlp18;
|
||||
|
||||
var
|
||||
f: TFoo;
|
||||
t: TTest6;
|
||||
begin
|
||||
f := TFoo.Create;
|
||||
f.Test;
|
||||
f.Test('Foo');
|
||||
t.Test;
|
||||
end.
|
||||
|
||||
|
||||
@ -1,19 +1,42 @@
|
||||
{ %FAIL }
|
||||
|
||||
{ class helpers may not be referenced in any way - test 7 }
|
||||
{ published methods of class helpers are not accessible through the extended
|
||||
class' RTTI }
|
||||
program tchlp24;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode objfpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
{$apptype console}
|
||||
|
||||
type
|
||||
TObjectHelper = class helper for TObject
|
||||
{$M+}
|
||||
TTest = class
|
||||
end;
|
||||
{$M-}
|
||||
|
||||
TObjectHelperSub = class(TObjectHelper)
|
||||
{$M+}
|
||||
TTestHelper = class helper for TTest
|
||||
published
|
||||
function Test: Integer;
|
||||
end;
|
||||
{$M-}
|
||||
|
||||
function TTestHelper.Test: Integer;
|
||||
begin
|
||||
end.
|
||||
Result := 1;
|
||||
end;
|
||||
|
||||
var
|
||||
f: TTest;
|
||||
res: Pointer;
|
||||
begin
|
||||
f := TTest.Create;
|
||||
res := f.MethodAddress('Test');
|
||||
{$ifdef fpc}
|
||||
Writeln('Address of TTest.Test: ', PtrInt(res));
|
||||
{$else}
|
||||
Writeln('Address of TTest.Test: ', NativeInt(res));
|
||||
{$endif}
|
||||
if res <> Nil then
|
||||
Halt(1);
|
||||
Writeln('ok');
|
||||
end.
|
||||
|
||||
@ -1,17 +1,23 @@
|
||||
{ %FAIL }
|
||||
{ %NORUN }
|
||||
|
||||
{ class helpers may not contain any fields }
|
||||
{ class helpers can extend a subclass of the parent's extended class }
|
||||
program tchlp25;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode objfpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
|
||||
type
|
||||
TObjectHelper = class helper for TObject
|
||||
Test: Integer;
|
||||
end;
|
||||
|
||||
TTest = class
|
||||
end;
|
||||
|
||||
TTestHelper = class helper(TObjectHelper) for TTest
|
||||
end;
|
||||
|
||||
begin
|
||||
|
||||
end.
|
||||
|
||||
|
||||
@ -1,23 +1,20 @@
|
||||
{ %NORUN }
|
||||
{ %FAIL }
|
||||
|
||||
{ class helpers can extend a subclass of the parent's extended class }
|
||||
{ a class helper can only inherit from another class helper }
|
||||
program tchlp26;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode objfpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
|
||||
type
|
||||
TObjectHelperA = class helper for TObject
|
||||
TTest = class
|
||||
|
||||
end;
|
||||
|
||||
TFoo = class
|
||||
end;
|
||||
|
||||
TObjectHelperB = class helper(TObjectHelperA) for TFoo
|
||||
TObjectHelper = class helper(TTest) for TObject
|
||||
end;
|
||||
|
||||
begin
|
||||
|
||||
end.
|
||||
|
||||
|
||||
@ -1,22 +1,26 @@
|
||||
{ extensive scoping test - test 1 }
|
||||
{ %FAIL }
|
||||
|
||||
{ a class helper must extend a subclass of the parent class helper }
|
||||
program tchlp27;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode objfpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
|
||||
uses
|
||||
uchlp27a, uchlp27b;
|
||||
type
|
||||
TTest1 = class
|
||||
|
||||
end;
|
||||
|
||||
TTest1Helper = class helper for TTest1
|
||||
end;
|
||||
|
||||
TTest2 = class
|
||||
|
||||
end;
|
||||
|
||||
TTest2Helper = class helper(TTest1Helper) for TTest2
|
||||
end;
|
||||
|
||||
var
|
||||
f: TFoo;
|
||||
res: Integer;
|
||||
begin
|
||||
f := TFoo.Create;
|
||||
res := f.Test;
|
||||
Writeln('f.Test: ', res);
|
||||
if res <> 2 then
|
||||
Halt(1);
|
||||
Writeln('ok');
|
||||
end.
|
||||
|
||||
|
||||
@ -1,30 +1,35 @@
|
||||
{ extensive scoping test - test 2 }
|
||||
{ class helpers hide methods of the extended class }
|
||||
program tchlp28;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode objfpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
|
||||
uses
|
||||
uchlp27a, uchlp27b, uchlp27c;
|
||||
type
|
||||
TTest = class
|
||||
function Test: Integer;
|
||||
end;
|
||||
|
||||
TTestHelper = class helper for TTest
|
||||
function Test: Integer;
|
||||
end;
|
||||
|
||||
function TTest.Test: Integer;
|
||||
begin
|
||||
Result := 1;
|
||||
end;
|
||||
|
||||
function TTestHelper.Test: Integer;
|
||||
begin
|
||||
Result := 2;
|
||||
end;
|
||||
|
||||
var
|
||||
f: TFoo;
|
||||
b: TBar;
|
||||
res: Integer;
|
||||
t: TTest;
|
||||
begin
|
||||
f := TBar.Create;
|
||||
res := f.Test;
|
||||
Writeln('f.Test: ', res);
|
||||
if res <> 2 then
|
||||
t := TTest.Create;
|
||||
if t.Test <> 2 then
|
||||
Halt(1);
|
||||
|
||||
b := TBar.Create;
|
||||
res := b.Test;
|
||||
Writeln('b.Test: ', res);
|
||||
if res <> 3 then
|
||||
Halt(2);
|
||||
|
||||
Writeln('ok');
|
||||
end.
|
||||
|
||||
|
||||
@ -1,30 +1,44 @@
|
||||
{ extensive scoping test - test 3 }
|
||||
{ class helpers don't hide methods of the subclasses of the extended class }
|
||||
program tchlp29;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode objfpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
|
||||
uses
|
||||
uchlp27a, uchlp27c, uchlp27b;
|
||||
type
|
||||
TTest = class
|
||||
function Test: Integer;
|
||||
end;
|
||||
|
||||
TTestHelper = class helper for TTest
|
||||
function Test: Integer;
|
||||
end;
|
||||
|
||||
TTestSub = class(TTest)
|
||||
function Test: Integer;
|
||||
end;
|
||||
|
||||
function TTest.Test: Integer;
|
||||
begin
|
||||
Result := 1;
|
||||
end;
|
||||
|
||||
function TTestHelper.Test: Integer;
|
||||
begin
|
||||
Result := 2;
|
||||
end;
|
||||
|
||||
function TTestSub.Test: Integer;
|
||||
begin
|
||||
Result := 3;
|
||||
end;
|
||||
|
||||
var
|
||||
f: TFoo;
|
||||
b: TBar;
|
||||
res: Integer;
|
||||
t: TTestSub;
|
||||
begin
|
||||
f := TBar.Create;
|
||||
res := f.Test;
|
||||
Writeln('f.Test: ', res);
|
||||
if res <> 2 then
|
||||
t := TTestSub.Create;
|
||||
if t.Test <> 3 then
|
||||
Halt(1);
|
||||
|
||||
b := TBar.Create;
|
||||
res := b.Test;
|
||||
Writeln('b.Test: ', res);
|
||||
if res <> 3 then
|
||||
Halt(2);
|
||||
|
||||
Writeln('ok');
|
||||
end.
|
||||
|
||||
|
||||
@ -1,6 +1,7 @@
|
||||
{%FAIL}
|
||||
{ %NORUN }
|
||||
|
||||
{ forward declarations are not allowed }
|
||||
{ this tests that helpers can introduce instance methods for classes - mode
|
||||
ObjFPC }
|
||||
program tchlp3;
|
||||
|
||||
{$ifdef fpc}
|
||||
@ -8,12 +9,22 @@ program tchlp3;
|
||||
{$endif}
|
||||
|
||||
type
|
||||
TObjectHelper = class helper for TObject;
|
||||
TTest = class
|
||||
|
||||
TObjectHelper = class helper for TObject
|
||||
end;
|
||||
|
||||
TTestHelper = class helper for TTest
|
||||
procedure Test;
|
||||
end;
|
||||
|
||||
procedure TTestHelper.Test;
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
var
|
||||
t: TTest;
|
||||
begin
|
||||
t.Test;
|
||||
end.
|
||||
|
||||
|
||||
@ -1,23 +1,31 @@
|
||||
{ extensive scoping test - test 4 }
|
||||
{ %FAIL }
|
||||
|
||||
{ helpers must not override virtual methods of the extended class }
|
||||
program tchlp30;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode objfpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
|
||||
uses
|
||||
uchlp27b, uchlp27a;
|
||||
type
|
||||
TTest = class
|
||||
function Test: Integer; virtual;
|
||||
end;
|
||||
|
||||
TTestHelper = class helper for TTest
|
||||
function Test: Integer; override;
|
||||
end;
|
||||
|
||||
function TTest.Test: Integer;
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
function TTestHelper.Test: Integer;
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
var
|
||||
f: TFoo;
|
||||
res: Integer;
|
||||
begin
|
||||
f := TFoo.Create;
|
||||
res := f.Test;
|
||||
Writeln('f.Test: ', res);
|
||||
if res <> 2 then
|
||||
Halt(1);
|
||||
|
||||
Writeln('ok');
|
||||
end.
|
||||
|
||||
|
||||
@ -1,23 +1,35 @@
|
||||
{ extensive scoping test - test 5 }
|
||||
{ helpers may hide virtual methods of the extended class }
|
||||
program tchlp31;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode objfpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
|
||||
uses
|
||||
uchlp27b, uchlp27c;
|
||||
type
|
||||
TTest = class
|
||||
function Test: Integer; virtual;
|
||||
end;
|
||||
|
||||
TTestHelper = class helper for TTest
|
||||
function Test: Integer;
|
||||
end;
|
||||
|
||||
function TTest.Test: Integer;
|
||||
begin
|
||||
Result := 1;
|
||||
end;
|
||||
|
||||
function TTestHelper.Test: Integer;
|
||||
begin
|
||||
Result := 2;
|
||||
end;
|
||||
|
||||
var
|
||||
b: TBar;
|
||||
res: Integer;
|
||||
t: TTest;
|
||||
begin
|
||||
b := TBar.Create;
|
||||
res := b.Test;
|
||||
Writeln('b.Test: ', res);
|
||||
if res <> 3 then
|
||||
t := TTest.Create;
|
||||
if t.Test <> 2 then
|
||||
Halt(1);
|
||||
|
||||
Writeln('ok');
|
||||
end.
|
||||
|
||||
|
||||
@ -1,19 +1,35 @@
|
||||
{ %FAIL }
|
||||
|
||||
{ only the last available class helper for a class must be used - test 1 }
|
||||
{ overloading needs to be enabled explicitly }
|
||||
program tchlp32;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode objfpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
|
||||
uses
|
||||
uchlp32a, uchlp32b, uchlp32c;
|
||||
type
|
||||
TTest = class
|
||||
procedure Test(const aTest: String);
|
||||
end;
|
||||
|
||||
TTestHelper = class helper for TTest
|
||||
procedure Test;
|
||||
end;
|
||||
|
||||
procedure TTest.Test(const aTest: String);
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
procedure TTestHelper.Test;
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
var
|
||||
f: TFoo;
|
||||
t: TTest;
|
||||
begin
|
||||
f := TFoo.Create;
|
||||
f.Method1;
|
||||
t := TTest.Create;
|
||||
t.Test('Foo');
|
||||
end.
|
||||
|
||||
|
||||
@ -1,22 +1,36 @@
|
||||
{ only the last available class helper for a class must be used - test 2 }
|
||||
{ %NORUN }
|
||||
|
||||
{ overloading needs to be enabled explicitly }
|
||||
program tchlp33;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode objfpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
|
||||
uses
|
||||
uchlp33a, uchlp33c, uchlp33b;
|
||||
type
|
||||
TTest = class
|
||||
procedure Test(const aTest: String);
|
||||
end;
|
||||
|
||||
TTestHelper = class helper for TTest
|
||||
procedure Test; overload;
|
||||
end;
|
||||
|
||||
procedure TTest.Test(const aTest: String);
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
procedure TTestHelper.Test;
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
var
|
||||
f: TFoo;
|
||||
res: Integer;
|
||||
t: TTest;
|
||||
begin
|
||||
f := TFoo.Create;
|
||||
res := f.Test;
|
||||
Writeln('f.Test: ', res);
|
||||
if res <> 1 then
|
||||
Halt(1);
|
||||
Writeln('ok');
|
||||
t := TTest.Create;
|
||||
t.Test;
|
||||
t.Test('Foo');
|
||||
end.
|
||||
|
||||
|
||||
@ -1,20 +1,30 @@
|
||||
{ %FAIL }
|
||||
{ %NORUN }
|
||||
|
||||
{ a class helper can only inherit from another class helper }
|
||||
{ a helper can already be accessed when implementing a class' methods }
|
||||
program tchlp34;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode objfpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
|
||||
type
|
||||
TFoo = class
|
||||
|
||||
TTest = class
|
||||
procedure Test;
|
||||
end;
|
||||
|
||||
TObjectHelper = class helper(TFoo) for TObject
|
||||
TTestHelper = class helper for TTest
|
||||
procedure DoSomething;
|
||||
end;
|
||||
|
||||
procedure TTest.Test;
|
||||
begin
|
||||
DoSomething;
|
||||
end;
|
||||
|
||||
procedure TTestHelper.DoSomething;
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
begin
|
||||
end.
|
||||
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
{ tests virtual methods inside class helpers }
|
||||
{ helper methods also influence calls to a parent's method in a derived class }
|
||||
program tchlp35;
|
||||
|
||||
{$ifdef fpc}
|
||||
@ -6,26 +6,42 @@ program tchlp35;
|
||||
{$endif}
|
||||
{$apptype console}
|
||||
|
||||
uses
|
||||
uchlp35;
|
||||
|
||||
type
|
||||
TObjectHelperB = class helper(TObjectHelperA) for TObject
|
||||
function VirtualTest: Integer; override;
|
||||
TTest = class
|
||||
function Test: Integer;
|
||||
end;
|
||||
|
||||
function TObjectHelperB.VirtualTest: Integer;
|
||||
TTestSub = class(TTest)
|
||||
function AccessTest: Integer;
|
||||
end;
|
||||
|
||||
TTestHelper = class helper for TTest
|
||||
function Test: Integer;
|
||||
end;
|
||||
|
||||
function TTest.Test: Integer;
|
||||
begin
|
||||
Result := 1;
|
||||
end;
|
||||
|
||||
function TTestSub.AccessTest: Integer;
|
||||
begin
|
||||
Result := Test;
|
||||
end;
|
||||
|
||||
function TTestHelper.Test: Integer;
|
||||
begin
|
||||
Result := 2;
|
||||
end;
|
||||
|
||||
var
|
||||
o: TObject;
|
||||
t: TTestSub;
|
||||
res: Integer;
|
||||
begin
|
||||
o := TObject.Create;
|
||||
res := o.Test;
|
||||
t := TTestSub.Create;
|
||||
res := t.AccessTest;
|
||||
Writeln('f.AccessTest: ', res);
|
||||
if res <> 2 then
|
||||
Halt(1);
|
||||
Writeln('ok');
|
||||
end.
|
||||
|
||||
|
||||
@ -1,31 +1,48 @@
|
||||
{ %FAIL }
|
||||
|
||||
{ a class helper must extend a subclass of the parent class helper }
|
||||
{ helper methods also influence calls to a parent's method in a derived class }
|
||||
program tchlp36;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
{$apptype console}
|
||||
|
||||
type
|
||||
TBar = class
|
||||
|
||||
TTest = class
|
||||
function Test: Integer;
|
||||
end;
|
||||
|
||||
TBarHelper = class helper for TBar
|
||||
procedure Test;
|
||||
TTestSub = class(TTest)
|
||||
function AccessTest: Integer;
|
||||
end;
|
||||
|
||||
TFoo = class
|
||||
|
||||
TTestHelper = class helper for TTest
|
||||
function Test: Integer;
|
||||
end;
|
||||
|
||||
TFooHelper = class helper(TBarHelper) for TFoo
|
||||
end;
|
||||
|
||||
procedure TBarHelper.Test;
|
||||
function TTest.Test: Integer;
|
||||
begin
|
||||
Result := 1;
|
||||
end;
|
||||
|
||||
function TTestSub.AccessTest: Integer;
|
||||
begin
|
||||
Result := inherited Test;
|
||||
end;
|
||||
|
||||
function TTestHelper.Test: Integer;
|
||||
begin
|
||||
Result := 2;
|
||||
end;
|
||||
|
||||
var
|
||||
t: TTestSub;
|
||||
res: Integer;
|
||||
begin
|
||||
t := TTestSub.Create;
|
||||
res := t.AccessTest;
|
||||
Writeln('f.AccessTest: ', res);
|
||||
if res <> 2 then
|
||||
Halt(1);
|
||||
Writeln('ok');
|
||||
end.
|
||||
|
||||
|
||||
@ -1,47 +1,33 @@
|
||||
{ a parent class helper's methods are available in a child class helper }
|
||||
{ %NORUN }
|
||||
|
||||
{ helpers of a parent are available in a subclass as well }
|
||||
program tchlp37;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode objfpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
{$apptype console}
|
||||
|
||||
type
|
||||
TFoo = class
|
||||
function Test: Integer;
|
||||
TTest = class
|
||||
|
||||
end;
|
||||
|
||||
TFooHelper = class helper for TFoo
|
||||
function Test: Integer;
|
||||
TTestSub = class(TTest)
|
||||
|
||||
end;
|
||||
|
||||
TFooBarHelper = class helper(TFooHelper) for TFoo
|
||||
function AccessTest: Integer;
|
||||
TTestHelper = class helper for TTest
|
||||
procedure Test;
|
||||
end;
|
||||
|
||||
function TFoo.Test: Integer;
|
||||
procedure TTestHelper.Test;
|
||||
begin
|
||||
Result := 1;
|
||||
end;
|
||||
|
||||
function TFooHelper.Test: Integer;
|
||||
begin
|
||||
Result := 2;
|
||||
end;
|
||||
|
||||
function TFooBarHelper.AccessTest: Integer;
|
||||
begin
|
||||
Result := Test;
|
||||
end;
|
||||
|
||||
var
|
||||
f: TFoo;
|
||||
res: Integer;
|
||||
t: TTestSub;
|
||||
begin
|
||||
f := TFoo.Create;
|
||||
res := f.AccessTest;
|
||||
Writeln(res);
|
||||
if res <> 2 then
|
||||
Halt(1);
|
||||
Writeln('ok');
|
||||
t.Test;
|
||||
end.
|
||||
|
||||
@ -1,41 +1,42 @@
|
||||
{ methods of the extended class can be called using "inherited" }
|
||||
{ a helper of a parent class hides the parent's methods }
|
||||
program tchlp38;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode objfpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
{$apptype console}
|
||||
|
||||
type
|
||||
TFoo = class
|
||||
function Test(aRecurse: Boolean): Integer;
|
||||
TTest = class
|
||||
function Test: Integer;
|
||||
end;
|
||||
|
||||
TFooHelper = class helper for TFoo
|
||||
function Test(aRecurse: Boolean): Integer;
|
||||
TTestSub = class(TTest)
|
||||
|
||||
end;
|
||||
|
||||
function TFoo.Test(aRecurse: Boolean): Integer;
|
||||
TTestHelper = class helper for TTest
|
||||
function Test: Integer;
|
||||
end;
|
||||
|
||||
function TTest.Test: Integer;
|
||||
begin
|
||||
Result := 1;
|
||||
end;
|
||||
|
||||
function TFooHelper.Test(aRecurse: Boolean): Integer;
|
||||
function TTestHelper.Test: Integer;
|
||||
begin
|
||||
if aRecurse then
|
||||
Result := inherited Test(False)
|
||||
else
|
||||
Result := 2;
|
||||
Result := 2;
|
||||
end;
|
||||
|
||||
var
|
||||
f: TFoo;
|
||||
t: TTestSub;
|
||||
res: Integer;
|
||||
begin
|
||||
f := TFoo.Create;
|
||||
res := f.Test(True);
|
||||
Writeln('f.Test: ', res);
|
||||
if res <> 1 then
|
||||
t := TTestSub.Create;
|
||||
res := t.Test;
|
||||
Writeln('b.TestFoo: ', res);
|
||||
if res <> 2 then
|
||||
Halt(1);
|
||||
Writeln('ok');
|
||||
end.
|
||||
|
||||
@ -1,51 +1,51 @@
|
||||
{ the extended class has higher priority than the parent class when
|
||||
searching for symbols }
|
||||
program tchlp39;
|
||||
{ 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 objfpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
{$apptype console}
|
||||
|
||||
type
|
||||
TFoo = class
|
||||
function Test(aRecurse: Boolean): Integer;
|
||||
TTest = class
|
||||
function Test: Integer;
|
||||
end;
|
||||
|
||||
TFooHelper = class helper for TFoo
|
||||
function Test(aRecurse: Boolean): Integer;
|
||||
TTestSub = class(TTest)
|
||||
function Test: Integer;
|
||||
end;
|
||||
|
||||
TFooSubHelper = class helper(TFooHelper) for TFoo
|
||||
function Test(aRecurse: Boolean): Integer;
|
||||
TTestHelper = class helper for TTest
|
||||
function Test: Integer;
|
||||
end;
|
||||
|
||||
function TFoo.Test(aRecurse: Boolean): Integer;
|
||||
TTestSubHelper = class helper(TTestHelper) for TTestSub
|
||||
end;
|
||||
|
||||
function TTest.Test: Integer;
|
||||
begin
|
||||
Result := 1;
|
||||
end;
|
||||
|
||||
function TFooHelper.Test(aRecurse: Boolean): Integer;
|
||||
function TTestSub.Test: Integer;
|
||||
begin
|
||||
Result := 4;
|
||||
end;
|
||||
|
||||
function TTestHelper.Test: Integer;
|
||||
begin
|
||||
Result := 2;
|
||||
end;
|
||||
|
||||
function TFooSubHelper.Test(aRecurse: Boolean): Integer;
|
||||
begin
|
||||
if aRecurse then
|
||||
Result := inherited Test(False)
|
||||
else
|
||||
Result := 3;
|
||||
end;
|
||||
|
||||
var
|
||||
f: TFoo;
|
||||
t: TTestSub;
|
||||
res: Integer;
|
||||
begin
|
||||
f := TFoo.Create;
|
||||
res := f.Test(True);
|
||||
Writeln('f.Test: ', res);
|
||||
if res <> 1 then
|
||||
t := TTestSub.Create;
|
||||
res := t.Test;
|
||||
Writeln('b.TestFoo: ', res);
|
||||
if res <> 2 then
|
||||
Halt(1);
|
||||
Writeln('ok');
|
||||
end.
|
||||
|
||||
@ -1,18 +1,28 @@
|
||||
{%FAIL}
|
||||
{ %NORUN }
|
||||
|
||||
{ destructors are not allowed }
|
||||
{ this tests that helpers can introduce class methods for classes - mode
|
||||
ObjFPC }
|
||||
program tchlp4;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode objfpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
|
||||
type
|
||||
TObjectHelper = class helper for TObject
|
||||
destructor Destroy; override;
|
||||
TTest = class
|
||||
|
||||
end;
|
||||
|
||||
TTestHelper = class helper for TTest
|
||||
class procedure Test;
|
||||
end;
|
||||
|
||||
class procedure TTestHelper.Test;
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
begin
|
||||
TTest.Test;
|
||||
end.
|
||||
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
{ published is allowed in mode Delphi, but unusable }
|
||||
{ methods of the extended class can be called using "inherited" }
|
||||
program tchlp40;
|
||||
|
||||
{$ifdef fpc}
|
||||
@ -7,33 +7,35 @@ program tchlp40;
|
||||
{$apptype console}
|
||||
|
||||
type
|
||||
{$M+}
|
||||
TFoo = class
|
||||
end;
|
||||
{$M-}
|
||||
|
||||
TFooHelper = class helper for TFoo
|
||||
published
|
||||
function Test: Integer;
|
||||
TTest = class
|
||||
function Test(aRecurse: Boolean): Integer;
|
||||
end;
|
||||
|
||||
function TFooHelper.Test: Integer;
|
||||
TTestHelper = class helper for TTest
|
||||
function Test(aRecurse: Boolean): Integer;
|
||||
end;
|
||||
|
||||
function TTest.Test(aRecurse: Boolean): Integer;
|
||||
begin
|
||||
Result := 1;
|
||||
end;
|
||||
|
||||
var
|
||||
f: TFoo;
|
||||
res: Pointer;
|
||||
function TTestHelper.Test(aRecurse: Boolean): Integer;
|
||||
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
|
||||
if aRecurse then
|
||||
Result := inherited Test(False)
|
||||
else
|
||||
Result := 2;
|
||||
end;
|
||||
|
||||
var
|
||||
t: TTest;
|
||||
res: Integer;
|
||||
begin
|
||||
t := TTest.Create;
|
||||
res := t.Test(True);
|
||||
Writeln('t.Test: ', res);
|
||||
if res <> 1 then
|
||||
Halt(1);
|
||||
Writeln('ok');
|
||||
end.
|
||||
|
||||
@ -1,25 +1,51 @@
|
||||
{ %FAIL }
|
||||
|
||||
{ puplished members are not allowed in mode objfpc }
|
||||
{ the extended class has higher priority than the parent class when
|
||||
searching for symbols }
|
||||
program tchlp41;
|
||||
|
||||
{$mode objfpc}
|
||||
{$ifdef fpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
{$apptype console}
|
||||
|
||||
type
|
||||
{$M+}
|
||||
TFoo = class
|
||||
end;
|
||||
{$M-}
|
||||
|
||||
TFooHelper = class helper for TFoo
|
||||
published
|
||||
function Test: Integer;
|
||||
TTest = class
|
||||
function Test(aRecurse: Boolean): Integer;
|
||||
end;
|
||||
|
||||
function TFooHelper.Test: Integer;
|
||||
TTestHelper = class helper for TTest
|
||||
function Test(aRecurse: Boolean): Integer;
|
||||
end;
|
||||
|
||||
TTestHelperSub = class helper(TTestHelper) for TTest
|
||||
function Test(aRecurse: Boolean): Integer;
|
||||
end;
|
||||
|
||||
function TTest.Test(aRecurse: Boolean): Integer;
|
||||
begin
|
||||
Result := 1;
|
||||
end;
|
||||
|
||||
function TTestHelper.Test(aRecurse: Boolean): Integer;
|
||||
begin
|
||||
Result := 2;
|
||||
end;
|
||||
|
||||
function TTestHelperSub.Test(aRecurse: Boolean): Integer;
|
||||
begin
|
||||
if aRecurse then
|
||||
Result := inherited Test(False)
|
||||
else
|
||||
Result := 3;
|
||||
end;
|
||||
|
||||
var
|
||||
t: TTest;
|
||||
res: Integer;
|
||||
begin
|
||||
t := TTest.Create;
|
||||
res := t.Test(True);
|
||||
Writeln('t.Test: ', res);
|
||||
if res <> 1 then
|
||||
Halt(1);
|
||||
Writeln('ok');
|
||||
end.
|
||||
|
||||
@ -1,74 +1,51 @@
|
||||
{ a class helper may introduce a enumerator }
|
||||
{ the extended type is searched first for a inherited method even if it's
|
||||
defined as "override" }
|
||||
program tchlp42;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode objfpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
{$apptype console}
|
||||
|
||||
type
|
||||
TContainer = class
|
||||
Contents: array[0..5] of Integer;
|
||||
constructor Create;
|
||||
TTest = class
|
||||
function Test(aRecurse: Boolean): Integer; virtual;
|
||||
end;
|
||||
|
||||
TContainerEnum = class
|
||||
private
|
||||
fIndex: Integer;
|
||||
fContainer: TContainer;
|
||||
public
|
||||
constructor Create(aContainer: TContainer);
|
||||
function GetCurrent: Integer;
|
||||
function MoveNext: Boolean;
|
||||
property Current: Integer read GetCurrent;
|
||||
TObjectHelper = class helper for TObject
|
||||
function Test(aRecurse: Boolean): Integer; virtual;
|
||||
end;
|
||||
|
||||
TContainerHelper = class helper for TContainer
|
||||
function GetEnumerator: TContainerEnum;
|
||||
TTestHelper = class helper(TObjectHelper) for TTest
|
||||
function Test(aRecurse: Boolean): Integer; override;
|
||||
end;
|
||||
|
||||
{ TContainer }
|
||||
|
||||
constructor TContainer.Create;
|
||||
var
|
||||
i: Integer;
|
||||
function TTest.Test(aRecurse: Boolean): Integer;
|
||||
begin
|
||||
for i := Low(Contents) to High(Contents) do
|
||||
Contents[i] := High(Contents) - i;
|
||||
Result := 1;
|
||||
end;
|
||||
|
||||
{ TContainerHelper }
|
||||
|
||||
function TContainerHelper.GetEnumerator: TContainerEnum;
|
||||
function TObjectHelper.Test(aRecurse: Boolean): Integer;
|
||||
begin
|
||||
Result := TContainerEnum.Create(Self);
|
||||
Result := 2;
|
||||
end;
|
||||
|
||||
{ TContainerEnum }
|
||||
|
||||
constructor TContainerEnum.Create(aContainer: TContainer);
|
||||
function TTestHelper.Test(aRecurse: Boolean): Integer;
|
||||
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);
|
||||
if aRecurse then
|
||||
Result := inherited Test(False)
|
||||
else
|
||||
Result := 3;
|
||||
end;
|
||||
|
||||
var
|
||||
cont: TContainer;
|
||||
i: Integer;
|
||||
t: TTest;
|
||||
res: Integer;
|
||||
begin
|
||||
cont := TContainer.Create;
|
||||
for i in cont do
|
||||
Writeln(i);
|
||||
t := TTest.Create;
|
||||
res := t.Test(True);
|
||||
Writeln('t.Test: ', res);
|
||||
if res <> 1 then
|
||||
Halt(1);
|
||||
Writeln('ok');
|
||||
end.
|
||||
|
||||
@ -1,51 +1,35 @@
|
||||
{ the extended type is searched first for a inherited method even if it's
|
||||
defined as "override" }
|
||||
{ %NORUN }
|
||||
|
||||
{ for helpers Self always refers to the extended class }
|
||||
program tchlp43;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode delphi}
|
||||
{$mode objfpc}
|
||||
{$endif}
|
||||
{$apptype console}
|
||||
|
||||
type
|
||||
TFoo = class
|
||||
function Test(aRecurse: Boolean): Integer; virtual;
|
||||
TTest = class
|
||||
procedure DoTest(aTest: TTest);
|
||||
end;
|
||||
|
||||
TObjectHelper = class helper for TObject
|
||||
function Test(aRecurse: Boolean): Integer; virtual;
|
||||
TTestHelper = class helper for TTest
|
||||
procedure Test;
|
||||
end;
|
||||
|
||||
TFooHelper = class helper(TObjectHelper) for TFoo
|
||||
function Test(aRecurse: Boolean): Integer; override;
|
||||
end;
|
||||
|
||||
function TFoo.Test(aRecurse: Boolean): Integer;
|
||||
procedure TTest.DoTest(aTest: TTest);
|
||||
begin
|
||||
Result := 1;
|
||||
|
||||
end;
|
||||
|
||||
function TObjectHelper.Test(aRecurse: Boolean): Integer;
|
||||
procedure TTestHelper.Test;
|
||||
begin
|
||||
Result := 2;
|
||||
end;
|
||||
|
||||
function TFooHelper.Test(aRecurse: Boolean): Integer;
|
||||
begin
|
||||
if aRecurse then
|
||||
Result := inherited Test(False)
|
||||
else
|
||||
Result := 3;
|
||||
DoTest(Self);
|
||||
end;
|
||||
|
||||
var
|
||||
f: TFoo;
|
||||
res: Integer;
|
||||
t: TTest;
|
||||
begin
|
||||
f := TFoo.Create;
|
||||
res := f.Test(True);
|
||||
Writeln('f.Test: ', res);
|
||||
if res <> 1 then
|
||||
Halt(1);
|
||||
Writeln('ok');
|
||||
t := TTest.Create;
|
||||
t.Test;
|
||||
end.
|
||||
|
||||
|
||||
@ -1,49 +1,49 @@
|
||||
{ in a parent class helper Self always is of the type of the extended class }
|
||||
{ in a class helper Self always is of the type of the extended class }
|
||||
program tchlp44;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode objfpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
{$apptype console}
|
||||
|
||||
type
|
||||
TFoo = class
|
||||
TTest = class
|
||||
function Test: Integer;
|
||||
end;
|
||||
|
||||
TBar = class(TFoo)
|
||||
TTestSub = class(TTest)
|
||||
function Test: Integer;
|
||||
end;
|
||||
|
||||
TFooHelper = class helper for TFoo
|
||||
TTestHelper = class helper for TTest
|
||||
function AccessTest: Integer;
|
||||
end;
|
||||
|
||||
TBarHelper = class helper(TFooHelper) for TBar
|
||||
TTestSubHelper = class helper(TTestHelper) for TTestSub
|
||||
end;
|
||||
|
||||
function TFoo.Test: Integer;
|
||||
function TTest.Test: Integer;
|
||||
begin
|
||||
Result := 1;
|
||||
end;
|
||||
|
||||
function TBar.Test: Integer;
|
||||
function TTestSub.Test: Integer;
|
||||
begin
|
||||
Result := 2;
|
||||
end;
|
||||
|
||||
function TFooHelper.AccessTest: Integer;
|
||||
function TTestHelper.AccessTest: Integer;
|
||||
begin
|
||||
Result := Test;
|
||||
end;
|
||||
|
||||
var
|
||||
b: TBar;
|
||||
t: TTestSub;
|
||||
res: Integer;
|
||||
begin
|
||||
b := TBar.Create;
|
||||
res := b.AccessTest;
|
||||
Writeln('b.AccessTest: ', res);
|
||||
t := TTestSub.Create;
|
||||
res := t.AccessTest;
|
||||
Writeln('t.AccessTest: ', res);
|
||||
if res <> 1 then
|
||||
Halt(1);
|
||||
Writeln('ok');
|
||||
|
||||
@ -1,19 +1,35 @@
|
||||
{ %FAIL }
|
||||
{ %NORUN }
|
||||
|
||||
{ access to methods must adhere to visibility rules (here: strict private) }
|
||||
{ tests whether the methods of a parent helper are usable in a derived helper }
|
||||
program tchlp45;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode objfpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
{$apptype console}
|
||||
|
||||
uses
|
||||
uchlp45;
|
||||
type
|
||||
TTest = class
|
||||
|
||||
end;
|
||||
|
||||
TTestHelper = class helper for TTest
|
||||
procedure Test;
|
||||
end;
|
||||
|
||||
TTestHelperSub = class helper(TTestHelper) for TTest
|
||||
procedure AccessTest;
|
||||
end;
|
||||
|
||||
procedure TTestHelper.Test;
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
procedure TTestHelperSub.AccessTest;
|
||||
begin
|
||||
Test;
|
||||
end;
|
||||
|
||||
var
|
||||
f: TFoo;
|
||||
begin
|
||||
f := TFoo.Create;
|
||||
f.Test1;
|
||||
end.
|
||||
|
||||
@ -1,18 +1,46 @@
|
||||
{ %FAIL }
|
||||
|
||||
{ access to methods must adhere to visibility rules (here: private)}
|
||||
{ test that helpers can access the methods of the parent helper using
|
||||
"inherited" }
|
||||
program tchlp46;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode objfpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
{$apptype console}
|
||||
|
||||
uses
|
||||
uchlp45;
|
||||
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(False)
|
||||
else
|
||||
Result := 2;
|
||||
end;
|
||||
|
||||
var
|
||||
f: TFoo;
|
||||
t: TTest;
|
||||
res: Integer;
|
||||
begin
|
||||
f := TFoo.Create;
|
||||
f.Test2;
|
||||
t := TTest.Create;
|
||||
res := t.Test(True);
|
||||
Writeln('t.Test: ', res);
|
||||
if res <> 1 then
|
||||
Halt(1);
|
||||
Writeln('ok');
|
||||
end.
|
||||
|
||||
@ -1,18 +1,51 @@
|
||||
{ %FAIL }
|
||||
|
||||
{ access to methods must adhere to visibility rules (here: strict protected)}
|
||||
{ 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 objfpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
{$apptype console}
|
||||
|
||||
uses
|
||||
uchlp45;
|
||||
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;
|
||||
end;
|
||||
|
||||
var
|
||||
f: TFoo;
|
||||
t: TTestSub;
|
||||
res: Integer;
|
||||
begin
|
||||
f := TFoo.Create;
|
||||
f.Test3;
|
||||
t := TTestSub.Create;
|
||||
res := t.AccessTest;
|
||||
Writeln('t.AccessTest: ', res);
|
||||
if res <> 2 then
|
||||
Halt(1);
|
||||
Writeln('ok');
|
||||
end.
|
||||
|
||||
@ -1,18 +1,51 @@
|
||||
{ %FAIL }
|
||||
|
||||
{ access to methods must adhere to visibility rules (here: protected)}
|
||||
{ a method defined in a parent helper has higher priority than a method defined
|
||||
in the parent of the extended class - test 2 }
|
||||
program tchlp48;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode objfpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
{$apptype console}
|
||||
|
||||
uses
|
||||
uchlp45;
|
||||
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 := inherited Test;
|
||||
end;
|
||||
|
||||
var
|
||||
f: TFoo;
|
||||
t: TTestSub;
|
||||
res: Integer;
|
||||
begin
|
||||
f := TFoo.Create;
|
||||
f.Test4;
|
||||
t := TTestSub.Create;
|
||||
res := t.AccessTest;
|
||||
Writeln('t.AccessTest: ', res);
|
||||
if res <> 2 then
|
||||
Halt(1);
|
||||
Writeln('ok');
|
||||
end.
|
||||
|
||||
@ -1,18 +1,46 @@
|
||||
{ %NORUN }
|
||||
|
||||
{ access to methods must adhere to visibility rules (here: public)}
|
||||
{ a class helper can access methods defined in the parent of the extended
|
||||
class }
|
||||
program tchlp49;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode objfpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
{$apptype console}
|
||||
|
||||
uses
|
||||
uchlp45;
|
||||
type
|
||||
TTest = class
|
||||
function Test(aRecurse: Boolean): Integer;
|
||||
end;
|
||||
|
||||
TTestSub = class(TTest)
|
||||
end;
|
||||
|
||||
TTestSubHelper = class helper for TTestSub
|
||||
function Test(aRecurse: Boolean): Integer;
|
||||
end;
|
||||
|
||||
function TTest.Test(aRecurse: Boolean): Integer;
|
||||
begin
|
||||
Result := 1;
|
||||
end;
|
||||
|
||||
function TTestSubHelper.Test(aRecurse: Boolean): Integer;
|
||||
begin
|
||||
if aRecurse then
|
||||
Result := inherited Test(False)
|
||||
else
|
||||
Result := 2;
|
||||
end;
|
||||
|
||||
var
|
||||
f: TFoo;
|
||||
t: TTestSub;
|
||||
res: Integer;
|
||||
begin
|
||||
f := TFoo.Create;
|
||||
f.Test5;
|
||||
t := TTestSub.Create;
|
||||
res := t.Test(True);
|
||||
Writeln('t.Test: ', res);
|
||||
if res <> 1 then
|
||||
Halt(1);
|
||||
Writeln('ok');
|
||||
end.
|
||||
|
||||
|
||||
@ -1,18 +1,29 @@
|
||||
{%FAIL}
|
||||
|
||||
{ class destructors are not allowed }
|
||||
{ the size of a class helper is equivalent to that of a pointer }
|
||||
program tchlp5;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode objfpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
{$apptype console}
|
||||
|
||||
type
|
||||
TObjectHelper = class helper for TObject
|
||||
class destructor Destroy; override;
|
||||
TTest = class
|
||||
s: String;
|
||||
i32: Integer;
|
||||
b: Boolean;
|
||||
i64: Int64;
|
||||
end;
|
||||
|
||||
TTestHelper = class helper for TTest
|
||||
end;
|
||||
|
||||
var
|
||||
res: Integer;
|
||||
begin
|
||||
|
||||
res := SizeOf(TTestHelper);
|
||||
Writeln('SizeOf(TTest): ', SizeOf(TTest));
|
||||
Writeln('SizeOf(TTestHelper): ', res);
|
||||
if res <> SizeOf(Pointer) then
|
||||
Halt(1);
|
||||
Writeln('ok');
|
||||
end.
|
||||
|
||||
|
||||
@ -1,24 +1,41 @@
|
||||
{ test whether the correct class helper is used, if two are defined for the
|
||||
same class in a unit }
|
||||
{ without "inherited" the methods of the helper are called first }
|
||||
program tchlp50;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode objfpc}{$H+}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
{$apptype console}
|
||||
|
||||
uses
|
||||
uchlp50;
|
||||
type
|
||||
TTest = class
|
||||
function Test(aRecurse: Boolean): Integer;
|
||||
end;
|
||||
|
||||
TTestHelper = class helper for TTest
|
||||
function Test(aRecurse: Boolean): Integer;
|
||||
end;
|
||||
|
||||
function TTest.Test(aRecurse: Boolean): Integer;
|
||||
begin
|
||||
Result := 1;
|
||||
end;
|
||||
|
||||
function TTestHelper.Test(aRecurse: Boolean): Integer;
|
||||
begin
|
||||
if aRecurse then
|
||||
Result := Test(False)
|
||||
else
|
||||
Result := 2;
|
||||
end;
|
||||
|
||||
var
|
||||
f: TFoo;
|
||||
t: TTest;
|
||||
res: Integer;
|
||||
begin
|
||||
f := TFoo.Create;
|
||||
res := f.Test;
|
||||
Writeln('f.Test: ', res);
|
||||
t := TTest.Create;
|
||||
res := t.Test(True);
|
||||
Writeln('t.Test: ', res);
|
||||
if res <> 2 then
|
||||
Halt(1);
|
||||
Writeln('ok');
|
||||
end.
|
||||
|
||||
|
||||
@ -1,23 +1,47 @@
|
||||
{ this tests whether a class helper introduced in the uses clause of an
|
||||
implementation section overrides the one introduced in the interface section }
|
||||
{ methods defined in a helper have higher priority than those defined in the
|
||||
extended type }
|
||||
program tchlp51;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode objfpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
{$apptype console}
|
||||
|
||||
uses
|
||||
uchlp51a, uchlp51c;
|
||||
type
|
||||
TTest = class
|
||||
function Test: Integer;
|
||||
end;
|
||||
|
||||
TTestHelper = class helper for TTest
|
||||
private
|
||||
function Test: Integer;
|
||||
public
|
||||
function AccessTest: Integer;
|
||||
end;
|
||||
|
||||
function TTest.Test: Integer;
|
||||
begin
|
||||
Result := 1;
|
||||
end;
|
||||
|
||||
function TTestHelper.Test: Integer;
|
||||
begin
|
||||
Result := 2;
|
||||
end;
|
||||
|
||||
function TTestHelper.AccessTest: Integer;
|
||||
begin
|
||||
Result := Test;
|
||||
end;
|
||||
|
||||
var
|
||||
f: TFoo;
|
||||
t: TTest;
|
||||
res: Integer;
|
||||
begin
|
||||
f := TFoo.Create;
|
||||
res := f.AccessTest;
|
||||
Writeln('f.AccessTest: ', res);
|
||||
if res <> 1 then
|
||||
t := TTest.Create;
|
||||
res := t.AccessTest;
|
||||
Writeln('t.AccessTest: ', res);
|
||||
if res <> 2 then
|
||||
Halt(1);
|
||||
Writeln('ok');
|
||||
end.
|
||||
|
||||
@ -1,24 +1,73 @@
|
||||
{ %FAIL }
|
||||
{ %NORUN }
|
||||
|
||||
{ class helpers may not be referenced in any way - test 7 }
|
||||
{ a helper may introduce an enumerator }
|
||||
program tchlp52;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode objfpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
|
||||
type
|
||||
TObjectHelper = class helper for TObject
|
||||
procedure Test;
|
||||
TContainer = class
|
||||
Contents: array[0..5] of Integer;
|
||||
constructor Create;
|
||||
end;
|
||||
|
||||
procedure TObjectHelper.Test;
|
||||
begin
|
||||
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] := 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
|
||||
o: TObject;
|
||||
cont: TContainer;
|
||||
i: Integer;
|
||||
begin
|
||||
TObjectHelper(o).Test;
|
||||
cont := TContainer.Create;
|
||||
for i in cont do ;
|
||||
end.
|
||||
|
||||
@ -1,40 +1,97 @@
|
||||
{ %NORUN }
|
||||
|
||||
{ method modifiers of the extended class are completly irrelevant }
|
||||
{ a helper hides an existing enumerator }
|
||||
program tchlp53;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
{$apptype console}
|
||||
|
||||
type
|
||||
TFoo = class
|
||||
procedure Test; virtual;
|
||||
TContainerEnum = class;
|
||||
|
||||
TContainer = class
|
||||
Contents: array[0..5] of Integer;
|
||||
function GetEnumerator: TContainerEnum;
|
||||
constructor Create;
|
||||
end;
|
||||
|
||||
TFooHelper = class helper for TFoo
|
||||
procedure Test; virtual;
|
||||
TContainerEnum = class
|
||||
private
|
||||
fIndex: Integer;
|
||||
fContainer: TContainer;
|
||||
fForward: Boolean;
|
||||
public
|
||||
constructor Create(aContainer: TContainer; aForward: Boolean);
|
||||
function GetCurrent: Integer;
|
||||
function MoveNext: Boolean;
|
||||
property Current: Integer read GetCurrent;
|
||||
end;
|
||||
|
||||
TFooSubHelper = class helper(TFooHelper) for TFoo
|
||||
procedure Test; override;
|
||||
TContainerHelper = class helper for TContainer
|
||||
function GetEnumerator: TContainerEnum;
|
||||
end;
|
||||
|
||||
procedure TFoo.Test;
|
||||
begin
|
||||
{ TContainer }
|
||||
|
||||
constructor TContainer.Create;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
for i := Low(Contents) to High(Contents) do
|
||||
Contents[i] := i;
|
||||
end;
|
||||
|
||||
procedure TFooHelper.Test;
|
||||
function TContainer.GetEnumerator: TContainerEnum;
|
||||
begin
|
||||
|
||||
Result := TContainerEnum.Create(Self, True);
|
||||
end;
|
||||
|
||||
procedure TFooSubHelper.Test;
|
||||
begin
|
||||
{ TContainerHelper }
|
||||
|
||||
function TContainerHelper.GetEnumerator: TContainerEnum;
|
||||
begin
|
||||
Result := TContainerEnum.Create(Self, False);
|
||||
end;
|
||||
|
||||
begin
|
||||
{ TContainerEnum }
|
||||
|
||||
constructor TContainerEnum.Create(aContainer: TContainer; aForward: Boolean);
|
||||
begin
|
||||
fContainer := aContainer;
|
||||
fForward := aForward;
|
||||
if fForward then
|
||||
fIndex := Low(fContainer.Contents) - 1
|
||||
else
|
||||
fIndex := High(fContainer.Contents) + 1;
|
||||
end;
|
||||
|
||||
function TContainerEnum.GetCurrent: Integer;
|
||||
begin
|
||||
Result := fContainer.Contents[fIndex];
|
||||
end;
|
||||
|
||||
function TContainerEnum.MoveNext: Boolean;
|
||||
begin
|
||||
if fForward then begin
|
||||
Inc(fIndex);
|
||||
Result := fIndex <= High(fContainer.Contents);
|
||||
end else begin
|
||||
Dec(fIndex);
|
||||
Result := fIndex >= Low(fContainer.Contents);
|
||||
end;
|
||||
end;
|
||||
|
||||
var
|
||||
cont: TContainer;
|
||||
i, c: Integer;
|
||||
begin
|
||||
cont := TContainer.Create;
|
||||
c := 5;
|
||||
for i in cont do begin
|
||||
if c <> i then
|
||||
Halt(1);
|
||||
Writeln(i);
|
||||
Dec(c);
|
||||
end;
|
||||
Writeln('ok');
|
||||
end.
|
||||
|
||||
@ -1,33 +1,123 @@
|
||||
{ tests whether the methods of a parent helper are usable in a derived helper }
|
||||
{ this example tests combinations of class and helpers hierarchies }
|
||||
program tchlp54;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode objfpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
{$apptype console}
|
||||
|
||||
type
|
||||
TFoo = class
|
||||
|
||||
TTest1 = class
|
||||
end;
|
||||
|
||||
TFooHelper = class helper for TFoo
|
||||
procedure Test;
|
||||
TTest2 = class(TTest1)
|
||||
class function Test3: Integer;
|
||||
end;
|
||||
|
||||
TFooBarHelper = class helper(TFooHelper) for TFoo
|
||||
procedure AccessTest;
|
||||
TTest3 = class(TTest2)
|
||||
class function Test1: Integer;
|
||||
class function Test2: Integer;
|
||||
end;
|
||||
|
||||
procedure TFooHelper.Test;
|
||||
TTest4 = class(TTest3)
|
||||
end;
|
||||
|
||||
TTest1Helper = class helper for TTest1
|
||||
class function Test1: Integer;
|
||||
class function Test3: Integer;
|
||||
class function Test4: Integer;
|
||||
end;
|
||||
|
||||
TTest3Helper = class helper for TTest3
|
||||
class function Test2: Integer;
|
||||
class function Test4: Integer;
|
||||
end;
|
||||
|
||||
TTest4Helper = class helper(TTest1Helper) for TTest4
|
||||
class function DoTest1: Integer;
|
||||
class function DoTest2: Integer;
|
||||
class function DoTest3: Integer;
|
||||
class function DoTest4: Integer;
|
||||
end;
|
||||
|
||||
class function TTest2.Test3: Integer;
|
||||
begin
|
||||
|
||||
Result := 1;
|
||||
end;
|
||||
|
||||
procedure TFooBarHelper.AccessTest;
|
||||
class function TTest3.Test1: Integer;
|
||||
begin
|
||||
Test;
|
||||
Result := 1;
|
||||
end;
|
||||
|
||||
class function TTest3.Test2: Integer;
|
||||
begin
|
||||
Result := 1;
|
||||
end;
|
||||
|
||||
class function TTest1Helper.Test1: Integer;
|
||||
begin
|
||||
Result := 2;
|
||||
end;
|
||||
|
||||
class function TTest1Helper.Test3: Integer;
|
||||
begin
|
||||
Result := 2;
|
||||
end;
|
||||
|
||||
class function TTest1Helper.Test4: Integer;
|
||||
begin
|
||||
Result := 1;
|
||||
end;
|
||||
|
||||
class function TTest3Helper.Test2: Integer;
|
||||
begin
|
||||
Result := 2;
|
||||
end;
|
||||
|
||||
class function TTest3Helper.Test4: Integer;
|
||||
begin
|
||||
Result := 2;
|
||||
end;
|
||||
|
||||
class function TTest4Helper.DoTest1: Integer;
|
||||
begin
|
||||
Result := Test1;
|
||||
end;
|
||||
|
||||
class function TTest4Helper.DoTest2: Integer;
|
||||
begin
|
||||
Result := Test2;
|
||||
end;
|
||||
|
||||
class function TTest4Helper.DoTest3: Integer;
|
||||
begin
|
||||
Result := Test3;
|
||||
end;
|
||||
|
||||
class function TTest4Helper.DoTest4: Integer;
|
||||
begin
|
||||
Result := Test4;
|
||||
end;
|
||||
|
||||
var
|
||||
res: Integer;
|
||||
begin
|
||||
res := TTest4.DoTest1;
|
||||
Writeln('TTest4.DoTest1: ', res);
|
||||
if res <> 2 then
|
||||
Halt(1);
|
||||
res := TTest4.DoTest2;
|
||||
Writeln('TTest4.DoTest2: ', res);
|
||||
if res <> 2 then
|
||||
Halt(2);
|
||||
res := TTest4.DoTest3;
|
||||
Writeln('TTest4.DoTest3: ', res);
|
||||
if res <> 2 then
|
||||
Halt(3);
|
||||
res := TTest4.DoTest4;
|
||||
Writeln('TTest4.DoTest4: ', res);
|
||||
if res <> 1 then
|
||||
Halt(4);
|
||||
Writeln('ok');
|
||||
end.
|
||||
|
||||
@ -1,26 +0,0 @@
|
||||
program tchlp55;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode objfpc}
|
||||
{$endif}
|
||||
|
||||
type
|
||||
TTest = class
|
||||
strict private
|
||||
type
|
||||
TFooHelper = class helper for TObject
|
||||
procedure Test;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTest.TFooHelper.Test;
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
var
|
||||
o: TObject;
|
||||
begin
|
||||
o := TObject.Create;
|
||||
o.Test;
|
||||
end.
|
||||
@ -1,34 +0,0 @@
|
||||
{ %NORUN }
|
||||
|
||||
{ for helpers Self always refers to the extended class }
|
||||
program tchlp56;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode objfpc}
|
||||
{$endif}
|
||||
|
||||
type
|
||||
TFoo = class
|
||||
procedure DoFoo(aFoo: TFoo);
|
||||
end;
|
||||
|
||||
TFooHelper = class helper for TFoo
|
||||
procedure Test;
|
||||
end;
|
||||
|
||||
procedure TFoo.DoFoo(aFoo: TFoo);
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
procedure TFooHelper.Test;
|
||||
begin
|
||||
DoFoo(Self);
|
||||
end;
|
||||
|
||||
var
|
||||
f: TFoo;
|
||||
begin
|
||||
f := TFoo.Create;
|
||||
f.Test;
|
||||
end.
|
||||
@ -1,30 +0,0 @@
|
||||
{ %NORUN }
|
||||
|
||||
{ a class helper can already be accessed when implementing a class' methods }
|
||||
program tchlp57;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode objfpc}
|
||||
{$endif}
|
||||
|
||||
type
|
||||
TFoo = class
|
||||
procedure Test;
|
||||
end;
|
||||
|
||||
TFooHelper = class helper for TFoo
|
||||
procedure Bar;
|
||||
end;
|
||||
|
||||
procedure TFoo.Test;
|
||||
begin
|
||||
Bar;
|
||||
end;
|
||||
|
||||
procedure TFooHelper.Bar;
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
begin
|
||||
end.
|
||||
@ -1,31 +0,0 @@
|
||||
{ %NORUN }
|
||||
|
||||
{ tests whether class helpers can introduce properties }
|
||||
program tchlp58;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
{$apptype console}
|
||||
|
||||
type
|
||||
TFoo = class
|
||||
Test: Integer;
|
||||
end;
|
||||
|
||||
TFooHelper = class helper for TFoo
|
||||
function GetAccessTest: Integer;
|
||||
property AccessTest: Integer read GetAccessTest;
|
||||
end;
|
||||
|
||||
function TFooHelper.GetAccessTest: Integer;
|
||||
begin
|
||||
Result := Test;
|
||||
end;
|
||||
|
||||
var
|
||||
f: TFoo;
|
||||
begin
|
||||
f := TFoo.Create;
|
||||
f.AccessTest;
|
||||
end.
|
||||
@ -1,27 +1,34 @@
|
||||
{%NORUN}
|
||||
|
||||
{ message methods are allowed in mode Delphi }
|
||||
{ helpers may introduce new default properties }
|
||||
program tchlp6;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
{$apptype console}
|
||||
|
||||
type
|
||||
TMessage = record
|
||||
ID: LongWord;
|
||||
TTest = class
|
||||
|
||||
end;
|
||||
|
||||
TObjectHelper = class helper for TObject
|
||||
procedure SomeMessage(var aMessage: TMessage); message 42;
|
||||
TTestHelper = class helper for TTest
|
||||
function GetTest(aIndex: Integer): Integer;
|
||||
property Test[Index: Integer]: Integer read GetTest; default;
|
||||
end;
|
||||
|
||||
procedure TObjectHelper.SomeMessage(var aMessage: TMessage);
|
||||
function TTestHelper.GetTest(aIndex: Integer): Integer;
|
||||
begin
|
||||
|
||||
Result := aIndex;
|
||||
end;
|
||||
|
||||
var
|
||||
t: TTest;
|
||||
res: Integer;
|
||||
begin
|
||||
|
||||
t := TTest.Create;
|
||||
res := t[3];
|
||||
Writeln('value: ', res);
|
||||
if res <> 3 then
|
||||
Halt(1);
|
||||
Writeln('ok');
|
||||
end.
|
||||
|
||||
|
||||
@ -1,51 +0,0 @@
|
||||
{ a method defined in a parent helper has higher priority than a method defined
|
||||
in the parent of the extended class - test 1}
|
||||
program tchlp62;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
{$apptype console}
|
||||
|
||||
type
|
||||
TFoo = class
|
||||
function Test: Integer;
|
||||
end;
|
||||
|
||||
TFooBar = class(TFoo)
|
||||
end;
|
||||
|
||||
TFooBarHelper = class helper for TFooBar
|
||||
function Test: Integer;
|
||||
end;
|
||||
|
||||
TFooBarSubHelper = class helper(TFooBarHelper) for TFooBar
|
||||
function AccessTest: Integer;
|
||||
end;
|
||||
|
||||
function TFoo.Test: Integer;
|
||||
begin
|
||||
Result := 1;
|
||||
end;
|
||||
|
||||
function TFooBarHelper.Test: Integer;
|
||||
begin
|
||||
Result := 2;
|
||||
end;
|
||||
|
||||
function TFooBarSubHelper.AccessTest: Integer;
|
||||
begin
|
||||
Result := Test;
|
||||
end;
|
||||
|
||||
var
|
||||
f: TFooBar;
|
||||
res: Integer;
|
||||
begin
|
||||
f := TFooBar.Create;
|
||||
res := f.AccessTest;
|
||||
Writeln('f.AccessTest: ', res);
|
||||
if res <> 2 then
|
||||
Halt(1);
|
||||
Writeln('ok');
|
||||
end.
|
||||
@ -1,51 +0,0 @@
|
||||
{ a method defined in a parent helper has higher priority than a method defined
|
||||
in the parent of the extended class - test 2 }
|
||||
program tchlp63;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
{$apptype console}
|
||||
|
||||
type
|
||||
TFoo = class
|
||||
function Test: Integer;
|
||||
end;
|
||||
|
||||
TFooBar = class(TFoo)
|
||||
end;
|
||||
|
||||
TFooBarHelper = class helper for TFooBar
|
||||
function Test: Integer;
|
||||
end;
|
||||
|
||||
TFooBarSubHelper = class helper(TFooBarHelper) for TFooBar
|
||||
function AccessTest: Integer;
|
||||
end;
|
||||
|
||||
function TFoo.Test: Integer;
|
||||
begin
|
||||
Result := 1;
|
||||
end;
|
||||
|
||||
function TFooBarHelper.Test: Integer;
|
||||
begin
|
||||
Result := 2;
|
||||
end;
|
||||
|
||||
function TFooBarSubHelper.AccessTest: Integer;
|
||||
begin
|
||||
Result := inherited Test;
|
||||
end;
|
||||
|
||||
var
|
||||
f: TFooBar;
|
||||
res: Integer;
|
||||
begin
|
||||
f := TFooBar.Create;
|
||||
res := f.AccessTest;
|
||||
Writeln('f.AccessTest: ', res);
|
||||
if res <> 2 then
|
||||
Halt(1);
|
||||
Writeln('ok');
|
||||
end.
|
||||
@ -1,46 +0,0 @@
|
||||
{ a class helper can access methods defined in the parent of the extended
|
||||
class }
|
||||
program tchlp64;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
{$apptype console}
|
||||
|
||||
type
|
||||
TFoo = class
|
||||
function Test(aRecurse: Boolean): Integer;
|
||||
end;
|
||||
|
||||
TFooBar = class(TFoo)
|
||||
end;
|
||||
|
||||
TFooBarHelper = class helper for TFooBar
|
||||
function Test(aRecurse: Boolean): Integer;
|
||||
end;
|
||||
|
||||
function TFoo.Test(aRecurse: Boolean): Integer;
|
||||
begin
|
||||
Result := 1;
|
||||
end;
|
||||
|
||||
function TFooBarHelper.Test(aRecurse: Boolean): Integer;
|
||||
begin
|
||||
if aRecurse then
|
||||
Result := inherited Test(False)
|
||||
else
|
||||
Result := 2;
|
||||
end;
|
||||
|
||||
var
|
||||
f: TFooBar;
|
||||
res: Integer;
|
||||
begin
|
||||
f := TFooBar.Create;
|
||||
res := f.Test(True);
|
||||
Writeln('f.Test: ', res);
|
||||
if res <> 1 then
|
||||
Halt(1);
|
||||
Writeln('ok');
|
||||
end.
|
||||
|
||||
@ -1,47 +0,0 @@
|
||||
{ helper methods also influence calls to a parent's method in a derived class }
|
||||
program tchlp67;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
{$apptype console}
|
||||
|
||||
type
|
||||
TFoo = class
|
||||
function Test: Integer;
|
||||
end;
|
||||
|
||||
TFooBar = class(TFoo)
|
||||
function AccessTest: Integer;
|
||||
end;
|
||||
|
||||
TFooHelper = class helper for TFoo
|
||||
function Test: Integer;
|
||||
end;
|
||||
|
||||
function TFoo.Test: Integer;
|
||||
begin
|
||||
Result := 1;
|
||||
end;
|
||||
|
||||
function TFooBar.AccessTest: Integer;
|
||||
begin
|
||||
Result := Test;
|
||||
end;
|
||||
|
||||
function TFooHelper.Test: Integer;
|
||||
begin
|
||||
Result := 2;
|
||||
end;
|
||||
|
||||
var
|
||||
f: TFooBar;
|
||||
res: Integer;
|
||||
begin
|
||||
f := TFooBar.Create;
|
||||
res := f.AccessTest;
|
||||
Writeln('f.AccessTest: ', res);
|
||||
if res <> 2 then
|
||||
Halt(1);
|
||||
Writeln('ok');
|
||||
end.
|
||||
@ -1,48 +0,0 @@
|
||||
{ helper methods also influence calls to a parent's method in a derived class }
|
||||
program tchlp68;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
{$apptype console}
|
||||
|
||||
type
|
||||
TFoo = class
|
||||
function Test: Integer;
|
||||
end;
|
||||
|
||||
TFooBar = class(TFoo)
|
||||
function AccessTest: Integer;
|
||||
end;
|
||||
|
||||
TFooHelper = class helper for TFoo
|
||||
function Test: Integer;
|
||||
end;
|
||||
|
||||
function TFoo.Test: Integer;
|
||||
begin
|
||||
Result := 1;
|
||||
end;
|
||||
|
||||
function TFooBar.AccessTest: Integer;
|
||||
begin
|
||||
Result := inherited Test;
|
||||
end;
|
||||
|
||||
function TFooHelper.Test: Integer;
|
||||
begin
|
||||
Result := 2;
|
||||
end;
|
||||
|
||||
var
|
||||
f: TFooBar;
|
||||
res: Integer;
|
||||
begin
|
||||
f := TFooBar.Create;
|
||||
res := f.AccessTest;
|
||||
Writeln('f.AccessTest: ', res);
|
||||
if res <> 2 then
|
||||
Halt(1);
|
||||
Writeln('ok');
|
||||
end.
|
||||
|
||||
@ -1,25 +1,42 @@
|
||||
{%FAIL}
|
||||
|
||||
{ message methods are not allowed in mode ObjFPC }
|
||||
{ helpers may override existing default properties }
|
||||
program tchlp7;
|
||||
|
||||
{$mode objfpc}
|
||||
{$ifdef fpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
{$apptype console}
|
||||
|
||||
type
|
||||
TMessage = record
|
||||
ID: LongWord;
|
||||
TTest = class
|
||||
private
|
||||
function GetTest(aIndex: Integer): Integer;
|
||||
public
|
||||
property Test[Index: Integer]: Integer read GetTest; default;
|
||||
end;
|
||||
|
||||
TObjectHelper = class helper for TObject
|
||||
procedure SomeMessage(var aMessage: TMessage); message 42;
|
||||
TTestHelper = class helper for TTest
|
||||
function GetTest(aIndex: Integer): Integer;
|
||||
property Test[Index: Integer]: Integer read GetTest; default;
|
||||
end;
|
||||
|
||||
procedure TObjectHelper.SomeMessage(var aMessage: TMessage);
|
||||
function TTest.GetTest(aIndex: Integer): Integer;
|
||||
begin
|
||||
|
||||
Result := - aIndex;
|
||||
end;
|
||||
|
||||
function TTestHelper.GetTest(aIndex: Integer): Integer;
|
||||
begin
|
||||
Result := aIndex;
|
||||
end;
|
||||
|
||||
var
|
||||
t: TTest;
|
||||
res: Integer;
|
||||
begin
|
||||
t := TTest.Create;
|
||||
res := t[3];
|
||||
Writeln('value: ', res);
|
||||
if res <> 3 then
|
||||
Halt(1);
|
||||
Writeln('ok');
|
||||
end.
|
||||
|
||||
|
||||
@ -1,18 +0,0 @@
|
||||
{ size of a class helper is size of a pointer }
|
||||
program tchlp78;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
{$apptype console}
|
||||
|
||||
type
|
||||
TObjectHelper = class helper for TObject
|
||||
end;
|
||||
|
||||
begin
|
||||
Writeln('Size of TObjectHelper: ', SizeOf(TObjectHelper));
|
||||
if SizeOf(TObjectHelper) <> SizeOf(Pointer) then
|
||||
Halt(1);
|
||||
Writeln('ok');
|
||||
end.
|
||||
@ -1,23 +0,0 @@
|
||||
{ size of a record helper is the size of a pointer }
|
||||
program tchlp79;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
{$apptype console}
|
||||
|
||||
type
|
||||
TTestRecord = record
|
||||
i: Integer;
|
||||
j: Integer;
|
||||
end;
|
||||
|
||||
TTestRecordHelper = record helper for TTestRecord
|
||||
end;
|
||||
|
||||
begin
|
||||
Writeln('Size of TTestRecordHelper: ', SizeOf(TTestRecordHelper));
|
||||
if SizeOf(TTestRecordHelper) <> SizeOf(Pointer) then
|
||||
Halt(1);
|
||||
Writeln('ok');
|
||||
end.
|
||||
@ -1,18 +1,38 @@
|
||||
{%FAIL}
|
||||
|
||||
{ abstract methods are not allowed }
|
||||
{ helpers may introduce new default properties (includes default properties
|
||||
introudced by the helper's parent) }
|
||||
program tchlp8;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode objfpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
{$apptype console}
|
||||
|
||||
type
|
||||
TObjectHelper = class helper for TObject
|
||||
procedure SomeMethod; virtual; abstract;
|
||||
TTest = class
|
||||
|
||||
end;
|
||||
|
||||
TTestHelper = class helper for TTest
|
||||
function GetTest(aIndex: Integer): Integer;
|
||||
property Test[Index: Integer]: Integer read GetTest; default;
|
||||
end;
|
||||
|
||||
TTestHelperSub = class helper(TTestHelper) for TTest
|
||||
end;
|
||||
|
||||
function TTestHelper.GetTest(aIndex: Integer): Integer;
|
||||
begin
|
||||
Result := aIndex;
|
||||
end;
|
||||
|
||||
var
|
||||
t: TTest;
|
||||
res: Integer;
|
||||
begin
|
||||
t := TTest.Create;
|
||||
res := t[3];
|
||||
Writeln('value: ', res);
|
||||
if res <> 3 then
|
||||
Halt(1);
|
||||
Writeln('ok');
|
||||
end.
|
||||
|
||||
|
||||
@ -1,26 +0,0 @@
|
||||
{ %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.
|
||||
@ -1,26 +0,0 @@
|
||||
{ %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.
|
||||
@ -1,26 +0,0 @@
|
||||
{ %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.
|
||||
@ -1,26 +0,0 @@
|
||||
{ %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.
|
||||
@ -1,30 +0,0 @@
|
||||
{ %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.
|
||||
@ -1,33 +0,0 @@
|
||||
{ %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.
|
||||
@ -1,42 +0,0 @@
|
||||
{ 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.
|
||||
@ -1,47 +0,0 @@
|
||||
{ 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.
|
||||
@ -1,32 +1,22 @@
|
||||
{%NORUN}
|
||||
{ %FAIL }
|
||||
|
||||
{ class helper inheritance syntax }
|
||||
{ inside a helper's declaration the methods/fields of the extended class can't
|
||||
be accessed }
|
||||
program tchlp9;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode objfpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
|
||||
type
|
||||
TObjectHelperA = class helper for TObject
|
||||
procedure SomeMethodA;
|
||||
TTest = class
|
||||
Test: Integer;
|
||||
function GetTest: Integer;
|
||||
end;
|
||||
|
||||
TObjectHelperB = class helper(TObjectHelperA) for TObject
|
||||
procedure SomeMethodB;
|
||||
TTestHelper = class helper for TTest
|
||||
property AccessTest: Integer read Test;
|
||||
end;
|
||||
|
||||
procedure TObjectHelperA.SomeMethodA;
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
procedure TObjectHelperB.SomeMethodB;
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
begin
|
||||
|
||||
end.
|
||||
|
||||
|
||||
@ -1,51 +0,0 @@
|
||||
{ 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.
|
||||
18
tests/test/thlp1.pp
Normal file
18
tests/test/thlp1.pp
Normal file
@ -0,0 +1,18 @@
|
||||
{ %NORUN }
|
||||
|
||||
{ tests the inheritance syntax of helpers }
|
||||
program thlp1;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
|
||||
type
|
||||
TObjectHelper = class helper for TObject
|
||||
end;
|
||||
|
||||
TObjectHelperSub = class helper(TObjectHelper) for TObject
|
||||
end;
|
||||
|
||||
begin
|
||||
end.
|
||||
20
tests/test/thlp10.pp
Normal file
20
tests/test/thlp10.pp
Normal file
@ -0,0 +1,20 @@
|
||||
{ %FAIL }
|
||||
|
||||
{ destructors are not allowed }
|
||||
program thlp10;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
|
||||
type
|
||||
TObjectHelper = class helper for TObject
|
||||
destructor Destroy;
|
||||
end;
|
||||
|
||||
destructor TObjectHelper.Destroy;
|
||||
begin
|
||||
end;
|
||||
|
||||
begin
|
||||
end.
|
||||
21
tests/test/thlp11.pp
Normal file
21
tests/test/thlp11.pp
Normal file
@ -0,0 +1,21 @@
|
||||
{ %FAIL }
|
||||
|
||||
{ class destructors are not allowed }
|
||||
program thlp11;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
|
||||
type
|
||||
TObjectHelper = class helper for TObject
|
||||
class destructor Destroy;
|
||||
end;
|
||||
|
||||
class destructor TObjectHelper.Destroy;
|
||||
begin
|
||||
end;
|
||||
|
||||
begin
|
||||
end.
|
||||
|
||||
21
tests/test/thlp12.pp
Normal file
21
tests/test/thlp12.pp
Normal file
@ -0,0 +1,21 @@
|
||||
{ %FAIL }
|
||||
|
||||
{ class constructors are not allowed }
|
||||
program thlp12;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
|
||||
type
|
||||
TObjectHelper = class helper for TObject
|
||||
class constructor Create;
|
||||
end;
|
||||
|
||||
class constructor TObjectHelper.Create;
|
||||
begin
|
||||
end;
|
||||
|
||||
begin
|
||||
end.
|
||||
|
||||
24
tests/test/thlp13.pp
Normal file
24
tests/test/thlp13.pp
Normal file
@ -0,0 +1,24 @@
|
||||
{ %NORUN }
|
||||
|
||||
{ message methods are allowed in mode Delphi }
|
||||
program thlp13;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
|
||||
type
|
||||
TMessage = record
|
||||
ID: Word;
|
||||
end;
|
||||
|
||||
TObjectHelper = class helper for TObject
|
||||
procedure Message(var aMessage: TMessage); message 42;
|
||||
end;
|
||||
|
||||
procedure TObjectHelper.Message(var aMessage: TMessage);
|
||||
begin
|
||||
end;
|
||||
|
||||
begin
|
||||
end.
|
||||
25
tests/test/thlp14.pp
Normal file
25
tests/test/thlp14.pp
Normal file
@ -0,0 +1,25 @@
|
||||
{ %FAIL }
|
||||
|
||||
{ message methods are forbidden in mode ObjFPC }
|
||||
program thlp14;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode objfpc}
|
||||
{$endif}
|
||||
|
||||
type
|
||||
TMessage = record
|
||||
ID: Word;
|
||||
end;
|
||||
|
||||
TObjectHelper = class helper for TObject
|
||||
procedure Message(var aMessage: TMessage); message 42;
|
||||
end;
|
||||
|
||||
procedure TObjectHelper.Message(var aMessage: TMessage);
|
||||
begin
|
||||
end;
|
||||
|
||||
begin
|
||||
end.
|
||||
|
||||
18
tests/test/thlp15.pp
Normal file
18
tests/test/thlp15.pp
Normal file
@ -0,0 +1,18 @@
|
||||
{ %FAIL }
|
||||
|
||||
{ helpers may not be referenced in any way - test 1 }
|
||||
program thlp15;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
|
||||
type
|
||||
TObjectHelper = class helper for TObject
|
||||
end;
|
||||
|
||||
var
|
||||
o: TObjectHelper;
|
||||
begin
|
||||
end.
|
||||
|
||||
17
tests/test/thlp16.pp
Normal file
17
tests/test/thlp16.pp
Normal file
@ -0,0 +1,17 @@
|
||||
{ %FAIL }
|
||||
|
||||
{ helpers may not be referenced in any way - test 2 }
|
||||
program thlp16;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
|
||||
type
|
||||
TObjectHelper = class helper for TObject
|
||||
end;
|
||||
|
||||
begin
|
||||
with TObjectHelper.Create do ;
|
||||
end.
|
||||
|
||||
23
tests/test/thlp17.pp
Normal file
23
tests/test/thlp17.pp
Normal file
@ -0,0 +1,23 @@
|
||||
{ %FAIL }
|
||||
|
||||
{ helpers may not be referenced in any way - test 3 }
|
||||
program thlp17;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
|
||||
type
|
||||
TObjectHelper = class helper for TObject
|
||||
class procedure Test;
|
||||
end;
|
||||
|
||||
class procedure TObjectHelper.Test;
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
begin
|
||||
TObjectHelper.Test;
|
||||
end.
|
||||
|
||||
21
tests/test/thlp18.pp
Normal file
21
tests/test/thlp18.pp
Normal file
@ -0,0 +1,21 @@
|
||||
{ %FAIL }
|
||||
|
||||
{ helpers may not be referenced in any way - test 4 }
|
||||
program thlp18;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
|
||||
type
|
||||
TObjectHelper = class helper for TObject
|
||||
end;
|
||||
|
||||
procedure SomeProc(aHelper: TObjectHelper);
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
begin
|
||||
end.
|
||||
|
||||
20
tests/test/thlp19.pp
Normal file
20
tests/test/thlp19.pp
Normal file
@ -0,0 +1,20 @@
|
||||
{ %FAIL }
|
||||
|
||||
{ helpers may not be referenced in any way - test 5 }
|
||||
program thlp19;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
|
||||
type
|
||||
TObjectHelper = class helper for TObject
|
||||
end;
|
||||
|
||||
TSomeRec = record
|
||||
helper: TObjectHelper;
|
||||
end;
|
||||
|
||||
begin
|
||||
end.
|
||||
|
||||
28
tests/test/thlp2.pp
Normal file
28
tests/test/thlp2.pp
Normal file
@ -0,0 +1,28 @@
|
||||
{ %NORUN }
|
||||
|
||||
{ tests that helpers can introduce properties }
|
||||
program thlp2;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
|
||||
type
|
||||
TObjectHelper = class helper for TObject
|
||||
class function GetTest: Integer; static;
|
||||
class procedure SetTest(aValue: Integer); static;
|
||||
class property Test: Integer read GetTest write SetTest;
|
||||
end;
|
||||
|
||||
class function TObjectHelper.GetTest: Integer;
|
||||
begin
|
||||
end;
|
||||
|
||||
class procedure TObjectHelper.SetTest(aValue: Integer);
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
begin
|
||||
TObject.Test := TObject.Test;
|
||||
end.
|
||||
19
tests/test/thlp20.pp
Normal file
19
tests/test/thlp20.pp
Normal file
@ -0,0 +1,19 @@
|
||||
{ %FAIL }
|
||||
|
||||
{ helpers may not be referenced in any way - test 6 }
|
||||
program thlp20;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
|
||||
type
|
||||
TObjectHelper = class helper for TObject
|
||||
end;
|
||||
|
||||
TObjectHelperHelper = class helper for TObjectHelper
|
||||
end;
|
||||
|
||||
begin
|
||||
end.
|
||||
|
||||
19
tests/test/thlp21.pp
Normal file
19
tests/test/thlp21.pp
Normal file
@ -0,0 +1,19 @@
|
||||
{ %FAIL }
|
||||
|
||||
{ helpers may not be referenced in any way - test 7 }
|
||||
program thlp21;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
|
||||
type
|
||||
TObjectHelper = class helper for TObject
|
||||
end;
|
||||
|
||||
TObjectHelperHelper = record helper for TObjectHelper
|
||||
end;
|
||||
|
||||
begin
|
||||
end.
|
||||
|
||||
19
tests/test/thlp22.pp
Normal file
19
tests/test/thlp22.pp
Normal file
@ -0,0 +1,19 @@
|
||||
{ %FAIL }
|
||||
|
||||
{ helpers may not be referenced in any way - test 8 }
|
||||
program thlp22;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
|
||||
type
|
||||
TObjectHelper = class helper for TObject
|
||||
end;
|
||||
|
||||
TObjectHelperSub = class(TObjectHelper)
|
||||
end;
|
||||
|
||||
begin
|
||||
end.
|
||||
|
||||
24
tests/test/thlp23.pp
Normal file
24
tests/test/thlp23.pp
Normal file
@ -0,0 +1,24 @@
|
||||
{ %FAIL }
|
||||
|
||||
{ helpers may not be referenced in any way - test 9 }
|
||||
program thlp23;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
|
||||
type
|
||||
TObjectHelper = class helper for TObject
|
||||
procedure Test;
|
||||
end;
|
||||
|
||||
procedure TObjectHelper.Test;
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
var
|
||||
o: TObject;
|
||||
begin
|
||||
TObjectHelper(o).Test;
|
||||
end.
|
||||
@ -1,12 +1,11 @@
|
||||
{ %FAIL }
|
||||
|
||||
{ a helper can not extend inline defined generics }
|
||||
program tchlp69;
|
||||
program thlp24;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
{$apptype console}
|
||||
|
||||
type
|
||||
TFoo<T> = class
|
||||
@ -1,12 +1,11 @@
|
||||
{ %FAIL }
|
||||
|
||||
{ a helper can not extend unspecialized generics }
|
||||
program tchlp70;
|
||||
program thlp25;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
{$apptype console}
|
||||
|
||||
type
|
||||
TFoo<T> = class
|
||||
@ -1,12 +1,12 @@
|
||||
{ %FAIL }
|
||||
{ %NORUN }
|
||||
|
||||
{ a helper can not extend specialized generics }
|
||||
program tchlp71;
|
||||
{ a helper may extend specialized generics }
|
||||
{ Note: this does currently not compile in Delphi }
|
||||
program thlp26;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
{$apptype console}
|
||||
|
||||
type
|
||||
TFoo<T> = class
|
||||
@ -1,12 +1,11 @@
|
||||
{ %NORUN }
|
||||
|
||||
{ a helper can extend the subclass of a specialized generic }
|
||||
program tchlp72;
|
||||
program thlp27;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
{$apptype console}
|
||||
|
||||
type
|
||||
TFoo<T> = class
|
||||
@ -1,12 +1,11 @@
|
||||
{ %FAIL }
|
||||
|
||||
{ a helper may not be defined as a generic type }
|
||||
program tchlp73;
|
||||
program thlp28;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
{$apptype console}
|
||||
|
||||
type
|
||||
TFoo = class
|
||||
@ -1,24 +1,22 @@
|
||||
{ %SKIP }
|
||||
{ .%NORUN }
|
||||
{ %NORUN }
|
||||
|
||||
{ a helper may contain generic methods }
|
||||
program tchlp74;
|
||||
program thlp29;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
{$apptype console}
|
||||
|
||||
type
|
||||
TFoo = class
|
||||
TTest = class
|
||||
|
||||
end;
|
||||
|
||||
TFooHelper = class helper for TFoo
|
||||
TTestHelper = class helper for TTest
|
||||
function Test<T>: T;
|
||||
end;
|
||||
|
||||
function TFooHelper.Test<T>: T;
|
||||
function TTestHelper.Test<T>: T;
|
||||
begin
|
||||
|
||||
end;
|
||||
28
tests/test/thlp3.pp
Normal file
28
tests/test/thlp3.pp
Normal file
@ -0,0 +1,28 @@
|
||||
{ %NORUN }
|
||||
|
||||
{ test that virtual methods can be defined in mode Delphi }
|
||||
program thlp3;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
|
||||
uses
|
||||
uhlp3;
|
||||
|
||||
type
|
||||
TObjectHelperSub = class helper(TObjectHelper) for TObject
|
||||
procedure TestOverride; override;
|
||||
procedure TestFinal; override; final;
|
||||
end;
|
||||
|
||||
procedure TObjectHelperSub.TestOverride;
|
||||
begin
|
||||
end;
|
||||
|
||||
procedure TObjectHelperSub.TestFinal;
|
||||
begin
|
||||
end;
|
||||
|
||||
begin
|
||||
end.
|
||||
@ -1,13 +1,11 @@
|
||||
{ %SKIP }
|
||||
{ .%FAIL }
|
||||
{ %FAIL }
|
||||
|
||||
{ helpers can not extend type parameters even if they can only be classes }
|
||||
program tchlp75;
|
||||
program thlp30;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
{$apptype console}
|
||||
|
||||
type
|
||||
TFoo<T: class> = class
|
||||
18
tests/test/thlp31.pp
Normal file
18
tests/test/thlp31.pp
Normal file
@ -0,0 +1,18 @@
|
||||
{ %FAIL }
|
||||
|
||||
{ access to helper methods adheres to visibility rules (here: strict private) }
|
||||
program thlp31;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode delphi}
|
||||
{$endif}
|
||||
|
||||
uses
|
||||
uhlp31;
|
||||
|
||||
var
|
||||
f: TFoo;
|
||||
begin
|
||||
f := TFoo.Create;
|
||||
f.Test1;
|
||||
end.
|
||||
Some files were not shown because too many files have changed in this diff Show More
Loading…
Reference in New Issue
Block a user