mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-11 15:47:51 +02:00
+ several tbs/tbf
This commit is contained in:
parent
ac686d0930
commit
5e63dbceeb
9
tests/tbf0186.pp
Normal file
9
tests/tbf0186.pp
Normal file
@ -0,0 +1,9 @@
|
||||
program bug0186;
|
||||
var
|
||||
endline:^integer;
|
||||
line:array [1..endline^] of ^char;
|
||||
begin
|
||||
new (endline);
|
||||
endline^:=5;
|
||||
endline^:=10;
|
||||
end.
|
13
tests/tbf0219.pp
Normal file
13
tests/tbf0219.pp
Normal file
@ -0,0 +1,13 @@
|
||||
{ Should give '(' expected in line 6 }
|
||||
|
||||
const
|
||||
replaces=4;
|
||||
replacetab : array[1..replaces,1..2] of string[32]=(
|
||||
':',' or colon',
|
||||
'mem8','mem or bits8',
|
||||
'mem16','mem or bits16',
|
||||
'mem32','mem or bits32'
|
||||
)
|
||||
begin
|
||||
end.
|
||||
|
53
tests/tbs0215.pp
Normal file
53
tests/tbs0215.pp
Normal file
@ -0,0 +1,53 @@
|
||||
{ $OPT=-St }
|
||||
{ allow static keyword }
|
||||
{ submitted by Andrew Wilson }
|
||||
|
||||
Program X;
|
||||
|
||||
{$ifdef go32v2}
|
||||
uses dpmiexcp;
|
||||
{$endif go32v2}
|
||||
|
||||
Type
|
||||
PY=^Y;
|
||||
Y=Object
|
||||
A : LongInt;
|
||||
P : PY; static;
|
||||
Constructor Init(NewA:LongInt);
|
||||
Procedure StaticMethod; static;
|
||||
Procedure VirtualMethod; virtual;
|
||||
End;
|
||||
|
||||
|
||||
Constructor Y.Init(NewA:LongInt);
|
||||
Begin
|
||||
A:=NewA;
|
||||
P:=@self;
|
||||
End;
|
||||
|
||||
Procedure Y.StaticMethod;
|
||||
Begin
|
||||
Writeln(P^.A); // Compiler complains about using A.
|
||||
P^.VirtualMethod; // Same with the virtual method.
|
||||
With P^ do begin
|
||||
Writeln(A); // These two seem to compile, but I
|
||||
VirtualMethod; // can't get them to work. It seems to
|
||||
End; // be the same problem as last time, so
|
||||
End; // I'll check it again when I get the
|
||||
// new snapshot.
|
||||
Procedure Y.VirtualMethod;
|
||||
Begin
|
||||
Writeln('VirtualMethod ',A);
|
||||
End;
|
||||
|
||||
var T1,T2 : PY;
|
||||
|
||||
Begin
|
||||
New(T1,init(1));
|
||||
New(T2,init(2));
|
||||
T1^.VirtualMethod;
|
||||
T2^.VirtualMethod;
|
||||
Y.StaticMethod;
|
||||
T1^.StaticMethod;
|
||||
T2^.StaticMethod;
|
||||
End.
|
34
tests/tbs0216.pp
Normal file
34
tests/tbs0216.pp
Normal file
@ -0,0 +1,34 @@
|
||||
type rec = record
|
||||
a : Longint;
|
||||
b : Longint;
|
||||
c : Longint;
|
||||
d : record
|
||||
e : Longint;
|
||||
f : Word;
|
||||
end;
|
||||
g : Longint;
|
||||
end;
|
||||
|
||||
const r : rec = (
|
||||
a : 100; b : 200; c : 300; d : (e : 20; f : 30); g : 10);
|
||||
|
||||
|
||||
begin
|
||||
with r do begin
|
||||
Writeln('A : ', a);
|
||||
if a<>100 then halt(1);
|
||||
Writeln('B : ', b);
|
||||
if b<>200 then halt(1);
|
||||
Writeln('C : ', c);
|
||||
if c<>300 then halt(1);
|
||||
Writeln('D');
|
||||
with d do begin
|
||||
Writeln('E : ', e);
|
||||
if e<>20 then halt(1);
|
||||
Writeln('F : ', f);
|
||||
if f<>30 then halt(1);
|
||||
end;
|
||||
Writeln('G : ', g);
|
||||
if g<>10 then halt(1);
|
||||
end;
|
||||
end.
|
19
tests/tbs0217.pp
Normal file
19
tests/tbs0217.pp
Normal file
@ -0,0 +1,19 @@
|
||||
{$ifdef fpc}{$mode tp}{$endif}
|
||||
|
||||
type tmpproc=function:longint;
|
||||
|
||||
function a:longint;{$ifndef fpc}far;{$endif}
|
||||
begin
|
||||
a:=-1;
|
||||
end;
|
||||
|
||||
procedure tmp(aa: tmpproc);
|
||||
begin
|
||||
writeln(aa); { "Cannot read/write variables of this type", TP kan dit
|
||||
wel? }
|
||||
if aa<>-1 then halt(1);
|
||||
end;
|
||||
|
||||
begin
|
||||
tmp(a); { de TP manier , in FPC moet dit zijn tmp(@a); }
|
||||
end.
|
25
tests/tbs0218.pp
Normal file
25
tests/tbs0218.pp
Normal file
@ -0,0 +1,25 @@
|
||||
Program Wrong_Output;
|
||||
{}
|
||||
Var r,rr:Extended; s:String;
|
||||
code : word;
|
||||
{}
|
||||
Begin
|
||||
Writeln('Size of Extended type (r)=',SizeOf(r),' bytes');
|
||||
r:=0.000058184639;
|
||||
Writeln('r=',r);
|
||||
Writeln('r=',r:16:13);
|
||||
Writeln('r=',r:15:12);
|
||||
Writeln('r=',r:14:11);
|
||||
Writeln('r=',r:13:10);
|
||||
Writeln('r=',r:12:9);
|
||||
Writeln('r=',r:11:8);
|
||||
Writeln('r=',r:10:7);
|
||||
Writeln('r=',r:9:6);
|
||||
Writeln('r=',r:8:5);
|
||||
Writeln('r=',r:7:4);
|
||||
Str(r:7:4,s);
|
||||
Writeln('r=',s,' (as string)')
|
||||
str(r,s);
|
||||
val(s,rr,code);
|
||||
if r<>rr then halt(1);
|
||||
End.
|
4
tests/tbs0254.pp
Normal file
4
tests/tbs0254.pp
Normal file
@ -0,0 +1,4 @@
|
||||
begin
|
||||
end.
|
||||
|
||||
disposestr
|
9
tests/tbs0255.pp
Normal file
9
tests/tbs0255.pp
Normal file
@ -0,0 +1,9 @@
|
||||
|
||||
function a: char;
|
||||
begin
|
||||
a:='c';
|
||||
end;
|
||||
|
||||
begin
|
||||
if #12 in [a, a, a, a, a] then ; { <--- }
|
||||
end.
|
37
tests/ts010016.pp
Normal file
37
tests/ts010016.pp
Normal file
@ -0,0 +1,37 @@
|
||||
{ problem of conversion between
|
||||
smallsets and long sets }
|
||||
type
|
||||
|
||||
{ Command sets }
|
||||
|
||||
PCommandSet = ^TCommandSet;
|
||||
TCommandSet = set of Byte;
|
||||
|
||||
Const
|
||||
cmValid = 0;
|
||||
cmQuit = 1;
|
||||
cmError = 2;
|
||||
cmMenu = 3;
|
||||
cmClose = 4;
|
||||
cmZoom = 5;
|
||||
cmResize = 6;
|
||||
cmNext = 7;
|
||||
cmPrev = 8;
|
||||
cmHelp = 9;
|
||||
|
||||
{ Application command codes }
|
||||
|
||||
cmCut = 20;
|
||||
cmCopy = 21;
|
||||
cmPaste = 22;
|
||||
cmUndo = 23;
|
||||
cmClear = 24;
|
||||
cmTile = 25;
|
||||
cmCascade = 26;
|
||||
|
||||
CurCommandSet: TCommandSet =
|
||||
[0..255] - [cmZoom, cmClose, cmResize, cmNext, cmPrev];
|
||||
|
||||
|
||||
begin
|
||||
end.
|
Loading…
Reference in New Issue
Block a user