mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-17 06:39:34 +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