mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-06-10 09:58:38 +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