* new tests

This commit is contained in:
peter 2001-05-20 12:07:56 +00:00
parent 6e65cd0ee4
commit b620a6c66d
8 changed files with 127 additions and 1 deletions

25
tests/tbs/tb0356.pp Normal file
View File

@ -0,0 +1,25 @@
{$mode objfpc}
type
tc = class
function test(var c: tc): boolean;
left,right: tc;
end;
testfunc = function(var c: tc):boolean of object;
function foreach(var c: tc; p: testfunc): boolean;
begin
if not assigned(c) then
exit;
end;
function tc.test(var c: tc): boolean;
begin
result := foreach(c.left,@test);
result := foreach(c.right,@test) or result;
end;
begin
end.

32
tests/webtbf/tw1483.pp Normal file
View File

@ -0,0 +1,32 @@
{ %fail }
Type pBug=^tBug;
tBug=Object
Private
A:Longint;
Go:Procedure Of Object;
Procedure Go1;
Public
Constructor Init;
End;
Constructor tBug.Init;
Begin
A:=10;
Go:=Go1; { <-- It's wring, it should }
{ be Go:=@Go1; but compiler }
{ says it's ok, and the program}
{ even runs... }
End;
Procedure tBug.Go1;
Begin
WriteLn(A);
End;
Var Bug:pBug;
Begin
Bug:=New(pBug,Init);
Bug^.Go;
End.

View File

@ -1,3 +1,4 @@
{ %opt=-Un }
{ %version=1.1 }
uses

8
tests/webtbs/tw1477.pp Normal file
View File

@ -0,0 +1,8 @@
CONST
Digit:Byte=3;{did work if we use DWord}
VAR
x:Real;
BEGIN
x:=10;
WriteLn(x:1:Digit);
END.

17
tests/webtbs/tw1479.pp Normal file
View File

@ -0,0 +1,17 @@
{$ifdef fpc}{$mode objfpc}{$endif}
uses
sysutils;
var
fn : string;
begin
fn:=FileSearch('tw1479.pp',';');
writeln('found: ',fn);
if fn<>'tw1479.pp' then
halt(1);
fn:=FileSearch('.\tw1479.pp',';');
writeln('found: ',fn);
if fn<>'.\tw1479.pp' then
halt(1);
end.

25
tests/webtbs/tw1489.pp Normal file
View File

@ -0,0 +1,25 @@
{$ifdef fpc}{$mode delphi}{$endif}
uses classes;
var
StrList : TStringList;
x : Integer;
Para : string;
begin
Para:='Hello,"This","i"s",a,"Test for"," TStringList"';
StrList := TStringList.Create;
writeln('Parameter: '+Para);
StrList.CommaText := Para;
writeln('Strings:');
for x := 0 to StrList.Count-1 do
writeln(StrList.Strings[x]);
writeln('CommaText: '+StrList.CommaText);
if StrList.CommaText<>'Hello,This,i,"s""",a,"Test for"," TStringList"' then
begin
writeln('ERROR!');
halt(1);
end;
StrList.Free;
end.

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

@ -0,0 +1,18 @@
{$mode objfpc}
function Uper1(const Pwd:AnsiString):AnsiString;
begin
Result := UpCase(Pwd);
Exit;
end;
function Uper2(const Pwd:AnsiString):AnsiString;
begin
Exit(UpCase(Pwd));
end;
begin
writeln('test', Uper1('test'));
writeln('test', Uper2('test'));
end.

View File

@ -1,4 +1,4 @@
unit uw1279;
unit testunit;
interface
implementation
end.