mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-22 04:09:30 +02:00
* new bugs from the web
This commit is contained in:
parent
316523ca15
commit
2b2150e897
10
tests/webtbf/tb1432.pp
Normal file
10
tests/webtbf/tb1432.pp
Normal 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
15
tests/webtbs/tb1409.pp
Normal 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
18
tests/webtbs/tb1412.pp
Normal 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
23
tests/webtbs/tb1416.pp
Normal 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
39
tests/webtbs/tb1445.pp
Normal 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
23
tests/webtbs/tb1450.pp
Normal 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
18
tests/webtbs/tb1451.pp
Normal 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.
|
Loading…
Reference in New Issue
Block a user