* new bugs

This commit is contained in:
peter 2004-10-31 22:29:23 +00:00
parent 4478f72279
commit 4df316465e
6 changed files with 136 additions and 4 deletions

23
tests/webtbs/tw3218.pp Normal file
View File

@ -0,0 +1,23 @@
{ Source provided for Free Pascal Bug Report 3218 }
{ Submitted by "Vincent Snijders" on 2004-07-20 }
{ e-mail: vslist@zonnet.nl }
{$mode objfpc}
uses
classes;
type TAProc = procedure(const s: string; o: TObject);
var AProc: TAProc;
procedure A(const s: string; c: TComponent);
begin
c.Name := s;
end;
var
o1: TObject;
begin
AProc:=@A; //this line should generate an error
o1 := TObject.Create;
AProc('',o1);
end.

View File

@ -1,8 +1,8 @@
{ Source provided for Free Pascal Bug Report 3227 }
{ Submitted by "mickaël leduque" on 2004-08-03 }
{ e-mail: mickael.leduque@laposte.net }
uses variants;
uses Variants;
type
TGffVarType = (
@ -66,7 +66,7 @@ type
var FType : TGffVarType;
@ -124,6 +124,7 @@ FType:=gffBYTE;
end;
end;
end.

33
tests/webtbs/tw3327.pp Normal file
View File

@ -0,0 +1,33 @@
{ Source provided for Free Pascal Bug Report 3327 }
{ Submitted by "Andreas Dorn" on 2004-09-21 }
{ e-mail: andreasd1@gmx.de }
Program BugReport;
Type Type1 = Record
a: Word;
b: LongWord;
End;
Type Type2 = Record
a: Word;
b: LongWord;
c: Array[0..1024] Of Char;
End;
Type Type3 = Record
a: Word;
b: LongWord;
c: Array[0..1024] Of LongWord;
End;
Var One: Array [1..100000] Of Type1;
Two: Type2;
Three: Type3 absolute two;
Four: Type1 absolute Three;
Begin;
One[1].a:=12;
Four := One[1];
if Four.a<>12 then
halt(1);
End.

32
tests/webtbs/tw3334.pp Normal file
View File

@ -0,0 +1,32 @@
{ Source provided for Free Pascal Bug Report 3334 }
{ Submitted by "Martin Schreiber" on 2004-09-28 }
{ e-mail: }
program project1;
{$mode objfpc}{$H+}
uses
Classes;
procedure p1;
type
integerarty = array of integer;
var
ar1,ar2: integerarty;
begin
setlength(ar1,4);
ar2:= copy(ar1,1,2);
end;
var
mem1,mem2 : longint;
begin
mem1:=heapsize-memavail;
p1;
mem2:=heapsize-memavail;
writeln(mem1,' - ',mem2);
if mem1<>mem2 then
halt(1);
end.

18
tests/webtbs/tw3340.pp Normal file
View File

@ -0,0 +1,18 @@
{ Source provided for Free Pascal Bug Report 3340 }
{ Submitted by "Alexey Barkovoy" on 2004-10-05 }
{ e-mail: clootie@ixbt.com }
program Project1;
{$APPTYPE CONSOLE}
{$MODE DELPHI}
{$INLINE ON}
uses
uw3340;
var
t: TTT;
begin
t:= TTT.Create;
t.zz:= 9;
WriteLn(t.Yes);
t.Free;
end.

25
tests/webtbs/uw3340.pp Normal file
View File

@ -0,0 +1,25 @@
unit uw3340;
interface
{$MODE DELPHI}
{$INLINE ON}
type
TTT = class
public
zz: Integer;
public
function Yes: Integer; inline;
end;
implementation
procedure LocK; inline;
begin WriteLn('asdfasdf'); end;
function TTT.Yes: Integer;
begin
Lock;
Result:= zz;
end;
end.