mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-24 14:09:17 +02:00
* new bugs
This commit is contained in:
parent
f44ebfed94
commit
51cc63140f
14
tests/webtbs/tw1948.pp
Normal file
14
tests/webtbs/tw1948.pp
Normal 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
26
tests/webtbs/tw2158.pp
Normal 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
17
tests/webtbs/tw2159.pp
Normal 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
36
tests/webtbs/tw2174.pp
Normal 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
42
tests/webtbs/tw2176.pp
Normal 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
65
tests/webtbs/tw2177.pp
Normal 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
60
tests/webtbs/tw2185.pp
Normal 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
18
tests/webtbs/tw2186.pp
Normal 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.
|
||||||
|
|
Loading…
Reference in New Issue
Block a user