* new tests

This commit is contained in:
peter 2003-10-05 12:58:30 +00:00
parent 1a71e7e02b
commit 4a7e2acad3
7 changed files with 188 additions and 0 deletions

11
tests/webtbs/tw2676.pp Normal file
View File

@ -0,0 +1,11 @@
{ %target=win32 }
{ Source provided for Free Pascal Bug Report 2676 }
{ Submitted by "Coenraad Loubser" on 2003-09-12 }
{ e-mail: sprinkaan7@hotmail.com }
var
x: dword absolute 123;
begin
writeln(dword(@x));
end.

16
tests/webtbs/tw2678.pp Normal file
View File

@ -0,0 +1,16 @@
{ Source provided for Free Pascal Bug Report 2678 }
{ Submitted by "darek mazur" on 2003-09-13 }
{ e-mail: madarzoo@o2.pl }
{$H-,I-,C-,D+,E-,L+,M-,P-,Q-,R-,S-,T-,X+,Z1}
{$Y+}
unit tw2678;
{$mode delphi}
interface
var
uii : integer;
function aa(a: string):string;
implementation
function aa;
begin
end;
end.

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

@ -0,0 +1,17 @@
{ %result=201 }
{ Source provided for Free Pascal Bug Report 2690 }
{ Submitted by "Tom Verhoeff" on 2003-09-22 }
{ e-mail: Tom.Verhoeff@acm.org }
program RangeError;
{$R+} { Range Checking Enabled }
var
c: Char;
d: 'a' .. 'z'; { subtype of Char }
a: array [ 'a' .. 'z' ] of Integer;
begin
c := chr ( ord ( 'a' ) - 1 ) { OK }
; d := c { value of c is outside the range of d,
should be caught, but is not }
; a [ d ] := 0 { this is now dangerous! }
end.

15
tests/webtbs/tw2691.pp Normal file
View File

@ -0,0 +1,15 @@
{ Source provided for Free Pascal Bug Report 2691 }
{ Submitted by "Luk Vandelaer" on 2003-09-22 }
{ e-mail: luk.vandelaer@wisa.be }
program int64prob;
uses sysutils;
var
x : int64;
begin
x := $FFFF shl 32;
writeln (format ('%d %d %d',
[x mod $10000, x div $10000, x div $10000]));
end.

57
tests/webtbs/tw2696.pp Normal file
View File

@ -0,0 +1,57 @@
{ %version=1.1 }
{ Source provided for Free Pascal Bug Report 2696 }
{ Submitted by "Vincent Snijders" on 2003-09-28 }
{ e-mail: vslist@zonnet.nl }
{$ifdef fpc}
{$mode delphi}
{$endif}
uses
Classes;
type
IBase = interface
procedure a(i: integer); overload;
procedure a(s: string); overload;
end;
IBase2 = interface(IBase)
procedure c;
end;
TBase = class(TInterfacedObject, IBase)
public
procedure a(i: integer); overload;
procedure a(s: string); overload; virtual;
end;
TSubClass = class(TBase, IBase2)
procedure a(s: string); overload; override;
procedure c;
end;
{ TBase }
procedure TBase.a(i: integer);
begin
end;
procedure TBase.a(s: string);
begin
end;
{ TSubClass }
procedure TSubClass.a(s: string);
begin
end;
procedure TSubClass.c;
begin
end;
begin
end.

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

@ -0,0 +1,26 @@
{ Source provided for Free Pascal Bug Report 2702 }
{ Submitted by "Johannes Berg" on 2003-10-01 }
{ e-mail: johannes -at- sipsolutions -dot- de }
{$mode delphi}
uses
Classes;
type
TDummy = class(TObject)
end;
TF = class(TObject)
function GetDummy: TDummy; virtual; abstract;
property dummy: TDummy read GetDummy;
procedure dada;
end;
procedure TF.dada;
begin
if Assigned(dummy) then begin
end;
end;
begin
end.

46
tests/webtbs/tw2710.pp Normal file
View File

@ -0,0 +1,46 @@
{ %OPT=-Sew }
{ Source provided for Free Pascal Bug Report 2710 }
{ Submitted by "Micha Nelissen" on 2003-10-04 }
{ e-mail: M.Nelissen@student.tue.nl }
unit tw2710;
{$mode delphi}
interface
type
TAbstract = class(TObject)
public
constructor Create;
procedure AbstractMethod; virtual; abstract;
end;
type
TDerived = class(TAbstract)
public
constructor Create;
procedure AbstractMethod; override;
end;
implementation
constructor TAbstract.Create;
begin
inherited;
end;
constructor TDerived.Create;
begin
inherited;
end;
procedure TDerived.AbstractMethod;
begin
end;
end.