mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-23 00:09:31 +02:00
* new tests
This commit is contained in:
parent
6e65cd0ee4
commit
b620a6c66d
25
tests/tbs/tb0356.pp
Normal file
25
tests/tbs/tb0356.pp
Normal 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
32
tests/webtbf/tw1483.pp
Normal 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.
|
@ -1,3 +1,4 @@
|
||||
{ %opt=-Un }
|
||||
{ %version=1.1 }
|
||||
|
||||
uses
|
||||
|
8
tests/webtbs/tw1477.pp
Normal file
8
tests/webtbs/tw1477.pp
Normal 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
17
tests/webtbs/tw1479.pp
Normal 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
25
tests/webtbs/tw1489.pp
Normal 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
18
tests/webtbs/tw1501.pp
Normal 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.
|
@ -1,4 +1,4 @@
|
||||
unit uw1279;
|
||||
unit testunit;
|
||||
interface
|
||||
implementation
|
||||
end.
|
||||
|
Loading…
Reference in New Issue
Block a user