mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-08 03:48:07 +02:00
* new tests
This commit is contained in:
parent
1a71e7e02b
commit
4a7e2acad3
11
tests/webtbs/tw2676.pp
Normal file
11
tests/webtbs/tw2676.pp
Normal 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
16
tests/webtbs/tw2678.pp
Normal 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
17
tests/webtbs/tw2690.pp
Normal 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
15
tests/webtbs/tw2691.pp
Normal 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
57
tests/webtbs/tw2696.pp
Normal 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
26
tests/webtbs/tw2702.pp
Normal 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
46
tests/webtbs/tw2710.pp
Normal 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.
|
Loading…
Reference in New Issue
Block a user