tchlp37.pp: properties seem to be disliked by Delphi 2007 (when accessing them), so test using a function

tchlp50.pp+: added some more tests that yet need to be verified in Delphi

git-svn-id: branches/svenbarth/classhelpers@16890 -
This commit is contained in:
svenbarth 2011-02-07 19:00:13 +00:00
parent 7cc7826343
commit 9b6fbd330c
10 changed files with 222 additions and 1 deletions

8
.gitattributes vendored
View File

@ -9331,6 +9331,10 @@ tests/test/tchlp47.pp svneol=native#text/pascal
tests/test/tchlp48.pp svneol=native#text/pascal
tests/test/tchlp49.pp svneol=native#text/pascal
tests/test/tchlp5.pp svneol=native#text/pascal
tests/test/tchlp50.pp svneol=native#text/pascal
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/tchlp6.pp svneol=native#text/pascal
tests/test/tchlp7.pp svneol=native#text/pascal
tests/test/tchlp8.pp svneol=native#text/pascal
@ -9876,6 +9880,10 @@ 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/uenum2a.pp svneol=native#text/plain
tests/test/uenum2b.pp svneol=native#text/plain
tests/test/ugeneric10.pp svneol=native#text/plain

View File

@ -16,7 +16,7 @@ type
end;
TFooBarHelper = class helper(TFooHelper) for TFoo
property AccessTest: Integer read Test;
function AccessTest: Integer;
end;
function TFoo.Test: Integer;
@ -29,6 +29,11 @@ begin
Result := 2;
end;
function TFooBarHelper.AccessTest: Integer;
begin
Result := Test;
end;
var
f: TFoo;
res: Integer;

24
tests/test/tchlp50.pp Normal file
View File

@ -0,0 +1,24 @@
{ test whether the correct class helper is used, if two are defined for the
same class in a unit }
program tchlp50;
{$ifdef fpc}
{$mode objfpc}{$H+}
{$endif}
{$apptype console}
uses
uchlp50;
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.

18
tests/test/tchlp51.pp Normal file
View File

@ -0,0 +1,18 @@
{ this tests whether a class helper introduced in the uses clause of an
implementation section overrides the one introduced in the interface section }
program tchlp51;
uses
uchlp51a, uchlp51c;
var
f: TFoo;
res: Integer;
begin
f := TFoo.Create;
res := f.AccessTest;
Writeln('f.AccessTest: ', res);
if res <> 2 then
Halt(1);
Writeln('ok');
end.

22
tests/test/tchlp52.pp Normal file
View File

@ -0,0 +1,22 @@
{ %FAIL }
{ class helpers may not be referenced in any way - test 7 }
program tchlp52;
{$mode objfpc}
type
TObjectHelper = class helper for TObject
procedure Test;
end;
procedure TObjectHelper.Test;
begin
end;
var
o: TObject;
begin
TObjectHelper(o).Test;
end.

39
tests/test/tchlp53.pp Normal file
View File

@ -0,0 +1,39 @@
{ %NORUN } { or fail? }
program tchlp53;
{$ifdef fpc}
{$mode objfpc}
{$endif}
type
TFoo = class
procedure Test; virtual;
end;
TFooHelper = class helper for TFoo
procedure Test; virtual;
end;
TFooSubHelper = class helper(TFooHelper) for TFoo
procedure Test; override;
end;
procedure TFoo.Test;
begin
end;
procedure TFooHelper.Test;
begin
end;
procedure TFooSubHelper.Test;
begin
end;
begin
end.

32
tests/test/uchlp50.pp Normal file
View File

@ -0,0 +1,32 @@
unit uchlp50;
{$mode objfpc}{$H+}
interface
type
TFoo = class
end;
TFooHelper1 = class helper for TFoo
function Test: Integer;
end;
TFooHelper2 = class helper for TFoo
function Test: Integer;
end;
implementation
function TFooHelper1.Test: Integer;
begin
Result := 1;
end;
function TFooHelper.Test: Integer;
begin
Result := 2;
end;
end.

20
tests/test/uchlp51a.pp Normal file
View File

@ -0,0 +1,20 @@
unit uchlp51a;
{$mode objfpc}{$H+}
interface
type
TFoo = class
function Test: Integer;
end;
implementation
function TFoo.Test: Integer;
begin
Result := 1;
end;
end.

25
tests/test/uchlp51b.pp Normal file
View File

@ -0,0 +1,25 @@
unit uchlp51b;
{$ifdef fpc}
{$mode objfpc}{$H+}
{$endif}
interface
uses
uchlp51a;
type
TFooHelper = class helper for TFoo
function Test: Integer;
end;
implementation
function TFooHelper.Test: Integer;
begin
Result := 2;
end;
end.

28
tests/test/uchlp51c.pp Normal file
View File

@ -0,0 +1,28 @@
unit uchlp51c;
{$ifdef fpc}
{$mode objfpc}{$H+}
{$endif}
interface
uses
uchlp51a;
type
TFooHelper2 = class helper for TFoo
function AccessTest: Integer;
end;
implementation
uses
uchlp51b;
function TFooHelper2.AccessTest: Integer;
begin
Result := Test;
end;
end.