* new bug

This commit is contained in:
peter 2005-01-04 16:32:07 +00:00
parent 1033fb1430
commit e98411d817
7 changed files with 190 additions and 0 deletions

35
tests/webtbf/tw3488.pp Normal file
View File

@ -0,0 +1,35 @@
{ %fail }
{ Source provided for Free Pascal Bug Report 3488 }
{ Submitted by "Jesus Reyes A." on 2004-12-28 }
{ e-mail: jesusrmx@yahoo.com.mx }
program opertest;
{$mode objfpc}{$H+}
type
TBug=class
private
FField: Integer;
procedure SetField(const AValue: Integer);
public
property Field: Integer read FField write SetField;
end;
procedure TBug.SetField(const aValue: Integer);
begin
WriteLn('SetField visited');
FField := AValue;
end;
var
Bug: TBug;
begin
Bug := TBug.Create;
Bug.Field := 10;
{ This is not allowed with properties }
Bug.Field += 1;
WriteLn('Bug.Field=',Bug.Field);
end.

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

@ -0,0 +1,10 @@
{ %fail }
{$mode fpc}
{ This is not allowed in normal fpc mode }
resourcestring
s = 'OK';
begin
writeln(s);
end.

12
tests/webtbf/tw3495.pp Normal file
View File

@ -0,0 +1,12 @@
{ %fail }
{ Source provided for Free Pascal Bug Report 3495 }
{ Submitted by "Ido Kanner" on 2005-01-01 }
{ e-mail: kanerido@actcom.net.il }
{$MACRO ON}
program Hi;
{$DEFINE ABCDEFHIJKLMNOPQRSTUBWXYZ1234567890abcdefghijklmnopqrstuvwxyz1234567890_ABCDEFHIJKLMNOPQRSTUBWXYZ1234567890abcdefghijklmnopqrstuvwxyz1234567890_ABCDEFHIJKLMNOPQRSTUBWXYZ1234567890abcdefghijklmnopqrstuvwxyz1234567890_ABCDEFHIJKLMNOPQRSTUBWXYZ1234567890abcdefghijklmnopqrstuvwxyz1234567890__ABCDEFHIJKLMNOPQRSTUBWXYZ1234567890abcdefghijklmnopqrstuvwxyz1234567890_ABCDEFHIJKLMNOPQRSTUBWXYZ1234567890abcdefghijklmnopqrstuvwxyz1234567890__________________________________________________________________________________________________________________________________________________________________ := 10}
begin
writeln (ABCDEFHIJKLMNOPQRSTUBWXYZ1234567890abcdefghijklmnopqrstuvwxyz1234567890_ABCDEFHIJKLMNOPQRSTUBWXYZ1234567890abcdefghijklmnopqrstuvwxyz1234567890_ABCDEFHIJKLMNOPQRSTUBWXYZ1234567890abcdefghijklmnopqrstuvwxyz1234567890_ABCDEFHIJKLMNOPQRSTUBWXYZ1234567890abcdefghijklmnopqrstuvwxyz1234567890__ABCDEFHIJKLMNOPQRSTUBWXYZ1234567890abcdefghijklmnopqrstuvwxyz1234567890_ABCDEFHIJKLMNOPQRSTUBWXYZ1234567890abcdefghijklmnopqrstuvwxyz1234567890__________________________________________________________________________________________________________________________________________________________________);
end.

12
tests/webtbf/tw3502.pp Normal file
View File

@ -0,0 +1,12 @@
{ %fail }
{$ifdef fpc}{$mode delphi}{$endif}
type
tc1=class
property Loop:integer read Loop;
end;
begin
end.

77
tests/webtbs/tw3101.pp Normal file
View File

@ -0,0 +1,77 @@
{ Source provided for Free Pascal Bug Report 3101 }
{ Submitted by "Martin Schreiber" on 2004-05-15 }
{ e-mail: }
{$ifdef fpc}{$mode objfpc}{$H+}{$endif}
uses
Classes;
type
ttestobj = class
public
constructor create1;
constructor create2;
destructor destroy; override;
procedure afterconstruction; override;
procedure beforedestruction; override;
end;
var
testobj: ttestobj;
i : integer;
err : boolean;
procedure ttestobj.afterconstruction;
begin
writeln('afterconstruction');
if i<>3 then
err:=true;
inc(i);
end;
procedure ttestobj.beforedestruction;
begin
writeln('beforedestruction');
if i<>4 then
err:=true;
inc(i);
end;
constructor ttestobj.create1;
begin
writeln('create1');
if i<>1 then
err:=true;
inc(i);
self.create2;
end;
constructor ttestobj.create2;
begin
writeln('create2');
if i<>2 then
err:=true;
inc(i);
end;
destructor ttestobj.destroy;
begin
writeln('destroy');
inherited;
if i<>5 then
err:=true;
inc(i);
end;
begin
i:=1;
testobj:= ttestobj(ttestobj.newinstance);
testobj.create1;
testobj.free;
//expected: create,afterconstruction,beforedestruction,destroy
//actual: create,beforedestruction,destroy
//kylix shows the expected behavior
if err then
halt(1);
end.

20
tests/webtbs/tw3491.pp Normal file
View File

@ -0,0 +1,20 @@
{ Source provided for Free Pascal Bug Report 3491 }
{ Submitted by "Marek Mauder" on 2004-12-29 }
{ e-mail: pentar@seznam.cz }
program ErrorGen;
{$APPTYPE CONSOLE}
{$ifdef fpc}{$mode delphi}{$endif}
type
TEnum = (
e0 = 10,
e1 = 11,
e2 = 12,
e3 = 15);
{errorgen.pas(9,27) Error: enums with assignments can't be used as array index}
TEnumArray = array[TEnum] of Byte;
begin
{writes 6}
WriteLn(SizeOf(TEnumArray));
if SizeOf(TEnumArray)<>6 then
halt(1);
end.

24
tests/webtbs/tw3504.pp Normal file
View File

@ -0,0 +1,24 @@
{$mode objfpc}{$H+}
uses SysUtils;
function Func1( Args :array of string ) :string;
begin
WriteLn('project2 Arg0-'+Args[0] +' Arg1-'+Args[1]);
if (Args[0]='1') and (Args[1]='2') then
Result := 'Ok'
else
Result := 'Err';
end;
var
Int1, Int2 :integer;
s : string;
begin
Int1 := 1;
Int2 := 2;
s:=Func1( [ IntToStr(Int1), IntToStr(Int2)] );
writeln(s);
if s<>'Ok' then
halt(1);
end.