* new bugs from the web

This commit is contained in:
peter 2001-04-13 18:01:34 +00:00
parent 316523ca15
commit 2b2150e897
7 changed files with 146 additions and 0 deletions

10
tests/webtbf/tb1432.pp Normal file
View File

@ -0,0 +1,10 @@
{ %FAIL }
procedure something;
procedure SomethingExt (onepar:longint); external;
begin
SomethingExt (1);
end;
begin
end.

15
tests/webtbs/tb1409.pp Normal file
View File

@ -0,0 +1,15 @@
{$MODE objfpc}
type
TPoint = record
x, y: Integer;
end;
procedure Test(const Args: array of TPoint);
begin
end;
const
p1: TPoint = (x: 10; y: 10);
begin
Test([p1]);
end.

18
tests/webtbs/tb1412.pp Normal file
View File

@ -0,0 +1,18 @@
PROGRAM initializationBug( INPUT, OUTPUT );
{$H+}
CONST
bufferSize = 8;
tableSize = 2;
TYPE
bufferRecord = RECORD
stringBuffer : String;
characterBuffer : ARRAY[ 1..bufferSize ] OF CHAR;
END;
VAR
bufferTable : ARRAY[ 1..tableSize ] OF bufferRecord;
BEGIN
WRITELN( '< INITIALIZATION BUG HAS NOT OCCURRED!' );
END.

23
tests/webtbs/tb1416.pp Normal file
View File

@ -0,0 +1,23 @@
var s:ansistring;
begin
s:='TeSt....10........20........30'+
'........40........50'+
'........60........70........80'+
'........90.......100'+
'.......110.......120.......130'+
'.......140.......150'+
'.......160.......170.......180'+
'.......190.......200'+
'.......210.......220.......230'+
'.......240.......250'+
'.......260.......270.......280'+
'.......290.......300';
writeln(s);
writeln(upcase(s));
writeln(lowercase(s));
if (length(upcase(s))<length(s)) or (length(lowercase(s))<length(s)) then
begin
writeln('ERROR');
halt(1);
end;
end.

39
tests/webtbs/tb1445.pp Normal file
View File

@ -0,0 +1,39 @@
{$ifdef fpc}{$mode objfpc}{$endif}
uses classes, sysutils;
var list : TStringList;
begin
list := TStringList.Create;
try
try
list.commatext := '"OK"';
writeln ('---');
writeln (list.text);
writeln ('---');
except
on e:exception do
begin
writeln('Exception: '+e.message);
halt(1);
end;
end;
try
//Failed
list.commatext := '';
writeln ('---');
writeln (list.text);
writeln ('---');
except
on e:exception do
begin
writeln('Exception: '+e.message);
halt(1);
end;
end;
finally
list.Free;
writeln ('Freeing list');
end;
end.

23
tests/webtbs/tb1450.pp Normal file
View File

@ -0,0 +1,23 @@
{$ifdef fpc}{$mode objfpc}{$endif}
uses classes;
var SL : TStringlist;
begin
SL := TStringlist.Create;
sl.Add('1');
sl.Add('2');
sl.Add('A"A');
sl.Add('B');
sl.Add('C,C');
sl.Add('D;D');
writeln(sl.Text);
writeln(sl.CommaText);
if sl.CommaText<>'1,2,"A""A",B,"C,C",D;D' then
begin
writeln('ERROR!');
halt(1);
end;
sl.free;
end.

18
tests/webtbs/tb1451.pp Normal file
View File

@ -0,0 +1,18 @@
{$ifdef fpc}{$mode objfpc}{$endif}
uses
sysutils;
var ErrorFileHandle : Text;
begin
//No Assignfile
Writeln('----');
try
CloseFile(ErrorFileHandle);
except
on E: Exception
do Writeln('ExceptionMessage: '+e.Message);
end;
Writeln('----');
end.