+ several tbs/tbf

This commit is contained in:
pierre 1999-06-01 22:23:11 +00:00
parent ac686d0930
commit 5e63dbceeb
9 changed files with 203 additions and 0 deletions

9
tests/tbf0186.pp Normal file
View 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
View 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
View 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
View 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
View 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
View 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
View File

@ -0,0 +1,4 @@
begin
end.
disposestr

9
tests/tbs0255.pp Normal file
View 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
View 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.