* new bugs

This commit is contained in:
peter 2002-10-20 14:12:32 +00:00
parent f44ebfed94
commit 51cc63140f
8 changed files with 278 additions and 0 deletions

14
tests/webtbs/tw1948.pp Normal file
View File

@ -0,0 +1,14 @@
{ %opt=-Sew }
{ Source provided for Free Pascal Bug Report 1948 }
{ Submitted by "Sergey Kosarevsky" on 2002-04-27 }
{ e-mail: netsurfer@au.ru }
Function A:Longint;
Begin
Exit(0);
End;
Begin
A;
End.

26
tests/webtbs/tw2158.pp Normal file
View File

@ -0,0 +1,26 @@
{ %cpu=i386 }
{ Source provided for Free Pascal Bug Report 2158 }
{ Submitted by "Maxim Voronov" on 2002-10-03 }
{ e-mail: m_v_voronov@mail.ru }
{$asmmode intel}
Function TestProc:single;
begin
asm
push eax
fldz
fldz
fldz
fsubp st(2),st(0)
fstp st(0)
pop eax
end;
end;
Begin
writeln;
writeln(TestProc);
End.

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

@ -0,0 +1,17 @@
{ %version=1.1 }
{ Source provided for Free Pascal Bug Report 2159 }
{ Submitted by "Yakov Sudeikin" on 2002-10-03 }
{ e-mail: yashka@exebook.com }
{$mode objfpc}
var
a,b,c: array of string;
begin
setlength(a, 2);
a[0] := 'asd';
a[1] := 'qwe';
b := copy(a);
c := copy(a, 1, 1);
end.

36
tests/webtbs/tw2174.pp Normal file
View File

@ -0,0 +1,36 @@
{ Source provided for Free Pascal Bug Report 2174 }
{ Submitted by "Maarten Bekers" on 2002-10-13 }
{ e-mail: fpc@elesoft.net }
{$mode delphi}
program test;
type StringArrayObj = Object
constructor Init(AllocStrings: Longint);
destructor Done;
end; { StringArrayObj }
type pStringArrayObj = ^StringArrayObj;
constructor StringArrayObj.Init(AllocStrings: Longint);
begin
end; { constructor Init }
destructor StringArrayObj.Done;
begin
end; { destructor Done }
var
oo2,oo3: ^stringarrayobj;
begin
{!!!}
new(oo2, init);
new(oo3, init);
writeln('one');
writeln('two!');
{!!!}
end.

42
tests/webtbs/tw2176.pp Normal file
View File

@ -0,0 +1,42 @@
{ %version=1.1}
{ Source provided for Free Pascal Bug Report 2176 }
{ Submitted by "Rimgaudas" on 2002-10-14 }
{ e-mail: rimga@ktl.mii.lt }
{$ifdef fpc}{$mode delphi}{$endif}
uses
SysUtils;
type
ii= interface
['{616D9683-88DC-4D1C-B847-1293DDFBACF7}']
procedure Show;stdcall;
end;
Twii= class(TInterfacedObject, ii)
s: string;
procedure Show;stdcall;
end;
procedure Twii.Show;stdcall;
begin
WriteLn(s);
end;
var
wii: twii;
i: ii;
begin
try
wii:= Twii.create;
wii.s:='OK';
i:= ii(wii);
i.Show; //writes nothing
except //does not excepts
WriteLn('Problem');
end;
//in delphi it works OK
end.

65
tests/webtbs/tw2177.pp Normal file
View File

@ -0,0 +1,65 @@
{ %version=1.1 }
{ Source provided for Free Pascal Bug Report 2177 }
{ Submitted by "Rimgaudas" on 2002-10-14 }
{ e-mail: rimga@ktl.mii.lt }
{$ifdef fpc}{$mode delphi}{$endif}
uses
SysUtils;
type
ii= interface
['{616D9683-88DC-4D1C-B847-1293DDFBACF7}']
procedure Show;stdcall;
end;
Twii= class(TObject, ii)
s: string;
function QueryInterface(const IID: TGUID; out Obj): Integer; stdcall;
function _AddRef: Integer; stdcall;
function _Release: Integer; stdcall;
procedure Show;stdcall;
end;
{________doomy interfaces______}
function Twii.QueryInterface(const IID: TGUID; out Obj): Integer; stdcall;
begin
result:= -1;
end;
function Twii._AddRef: Integer; stdcall;
begin
result:= -1;
end;
function Twii._Release: Integer; stdcall;
begin
result:= -1;
end;
{________doomy interfaces______}
procedure Twii.Show;stdcall;
begin
WriteLn(s);
end;
var
wii: twii;
i: ii;
begin
try
wii:= Twii.create;
wii.s:='OK';
i:= ii(wii);
i.Show;
except //excepts
on EAccessViolation do WriteLn('Access Violation');
else
WriteLn('Problem');
end;
end.

60
tests/webtbs/tw2185.pp Normal file
View File

@ -0,0 +1,60 @@
{ Source provided for Free Pascal Bug Report 2185 }
{ Submitted by "Andrew Johnson" on 2002-10-16 }
{ e-mail: AJ_Genius@Hotmail.com }
Program BugTest;
{$Mode ObjFPC}{$H+}
{off $Define InvertOrder}
Uses Classes;
Type
TMyClass = Class(TPersistent)
public
dummy : Longint;
{$IfNDef InvertOrder}
procedure Assign(Source : TPersistent); override;
procedure Assign(const value: integer);
{$Else InvertOrder}
procedure Assign(const value: integer);
procedure Assign(Source : TPersistent); override;
{$EndIf InvertOrder}
Constructor Create;
end;
procedure TMyClass.Assign(Source : TPersistent);
begin
If Source is TMyClass then
Dummy := TMyClass(Source).dummy;
end;
procedure TMyClass.Assign(const value: integer);
begin
Dummy := value;
end;
Constructor TMyClass.Create;
begin
Inherited Create;
end;
Const
ConstDummy : Integer = 3;
var
Test1, Test2 : TMyClass;
begin
Test1 := TMyClass.Create;
Test2 := TMyClass.Create;
Test1.Dummy := 2;
Test2.Dummy := 1;
Writeln(Test2.Dummy);
Test2.Assign(Test1);
Writeln(Test2.Dummy);
Test2.Assign(ConstDummy);
Writeln(Test2.Dummy);
Test1.Destroy;
Test2.Destroy;
end.

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

@ -0,0 +1,18 @@
{ Source provided for Free Pascal Bug Report 2186 }
{ Submitted by "Andrew Johnson" on 2002-10-16 }
{ e-mail: AJ_Genoius@Hotmail.com }
Program TypeBug;
{$Mode ObjFPC}
Uses Classes;
Type
NewInt = type longint;
TSomeClass = Class(TComponent)
end;
begin
end.