mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-20 09:09:42 +02:00
* some small fixes
+ added several new tests
This commit is contained in:
parent
a06d35ef82
commit
f274f1baad
@ -1,4 +1,5 @@
|
|||||||
{ %version=1.1 }
|
{ %version=1.1 }
|
||||||
|
{ %fail }
|
||||||
{ Interfaces only supported in v1.1 }
|
{ Interfaces only supported in v1.1 }
|
||||||
{ Should give the same error as /tbf/tb0125.pp }
|
{ Should give the same error as /tbf/tb0125.pp }
|
||||||
{$ifdef fpc}
|
{$ifdef fpc}
|
||||||
|
24
tests/tbf/tb0144.pp
Normal file
24
tests/tbf/tb0144.pp
Normal 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
25
tests/tbf/tb0145.pp
Normal 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
31
tests/tbf/tb0146.pp
Normal 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
31
tests/tbf/tb0147.pp
Normal 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
39
tests/tbf/tb0148.pp
Normal 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
27
tests/tbf/tb0149.pp
Normal 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
12
tests/tbf/ub0149.pp
Normal file
@ -0,0 +1,12 @@
|
|||||||
|
unit ub0149;
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
type
|
||||||
|
tdefinition = 1..10;
|
||||||
|
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
|
||||||
|
end.
|
Loading…
Reference in New Issue
Block a user