* some small fixes

+ added several new tests
This commit is contained in:
carl 2002-11-26 19:24:30 +00:00
parent a06d35ef82
commit f274f1baad
8 changed files with 190 additions and 0 deletions

View File

@ -1,4 +1,5 @@
{ %version=1.1 }
{ %fail }
{ Interfaces only supported in v1.1 }
{ Should give the same error as /tbf/tb0125.pp }
{$ifdef fpc}

24
tests/tbf/tb0144.pp Normal file
View File

@ -0,0 +1,24 @@
{ %FAIL }
{ OpenString with high should not be allowed }
program tb0144;
procedure TestOpen(var s: OpenString); cdecl;
var
b: byte;
begin
b:=high(s);
end;
Begin
end.
{
$Log$
Revision 1.1 2002-11-26 19:24:30 carl
* some small fixes
+ added several new tests
}

25
tests/tbf/tb0145.pp Normal file
View File

@ -0,0 +1,25 @@
{ %FAIL }
{ This should fail compilation because open parameters are not
allowed with cdecl'ed routines.
}
procedure TestOpen(var s: array of byte); cdecl;
var
b: byte;
begin
b:=high(s);
end;
Begin
end.
{
$Log$
Revision 1.1 2002-11-26 19:24:30 carl
* some small fixes
+ added several new tests
}

31
tests/tbf/tb0146.pp Normal file
View File

@ -0,0 +1,31 @@
{ %VERSION=1.1 }
{ %FAIL }
{ %OPT=-Sew -vw }
{$MODE OBJFPC}
type
tmyclass = class
procedure myabstract; virtual; abstract;
end;
tmyclass2 = class(tmyclass)
end;
tmyclassnode = class of tmyclass;
var
cla : tmyclass2;
cla1 : tmyclass;
classnode : tmyclassnode;
Begin
cla := tmyclass2.create;
classnode := tmyclass2;
cla1 := classnode.create;
end.
{
$Log$
Revision 1.1 2002-11-26 19:24:30 carl
* some small fixes
+ added several new tests
}

31
tests/tbf/tb0147.pp Normal file
View File

@ -0,0 +1,31 @@
{ %VERSION=1.1 }
{ %FAIL }
{ %OPT=-Sew -vw }
{$MODE OBJFPC}
type
tmyclass = class
procedure myabstract; virtual; abstract;
end;
tmyclass2 = class(tmyclass)
end;
tmyclassnode = class of tmyclass;
var
cla : tmyclass2;
cla1 : tmyclass;
classnode : tmyclassnode;
Begin
cla := tmyclass2.create;
classnode := tmyclass2;
cla1 := classnode.create;
end.
{
$Log$
Revision 1.1 2002-11-26 19:24:30 carl
* some small fixes
+ added several new tests
}

39
tests/tbf/tb0148.pp Normal file
View File

@ -0,0 +1,39 @@
{ %VERSION=1.1 }
{ %FAIL }
{ %OPT=-Sew -vw }
{$MODE OBJFPC}
{ This tests that non-implemented abstract methods which are
overloaded (but not in all cases) will still give out a
warning
}
type
tmyclass = class
procedure myabstract(x: integer); virtual; abstract;
procedure myabstract(z: byte); virtual; abstract;
end;
tmyclass2 = class(tmyclass)
procedure myabstract(x: integer) ; override;
end;
procedure tmyclass2.myabstract(x: integer);
begin
end;
var
cla : tmyclass2;
Begin
cla := tmyclass2.create;
end.
{
$Log$
Revision 1.1 2002-11-26 19:24:30 carl
* some small fixes
+ added several new tests
}

27
tests/tbf/tb0149.pp Normal file
View File

@ -0,0 +1,27 @@
{ %VERSION=1.1 }
{ %FAIL }
{ %OPT=-Sew -vw }
uses ub0149;
procedure testdef1(b: tdefinition);
begin
b:=12;
end;
type
tdefinition = 1..10;
procedure testdef2(b : tdefinition);
begin
b:=10;
end;
Begin
testdef1(0);
testdef2(0);
end.

12
tests/tbf/ub0149.pp Normal file
View File

@ -0,0 +1,12 @@
unit ub0149;
interface
type
tdefinition = 1..10;
implementation
end.