latest bugs added

This commit is contained in:
pierre 2000-03-21 15:52:37 +00:00
parent 311a357239
commit 64acc76501
3 changed files with 165 additions and 0 deletions

10
tests/tbf/tbf0310.pp Normal file
View File

@ -0,0 +1,10 @@
procedure p(s:string);
var
s : string;
begin
writeln(s);
end;
begin
p('test');
end.

11
tests/tbs/tbs0311.pp Normal file
View File

@ -0,0 +1,11 @@
type
tsplitextended = record
case byte of
0: (a: array[0..9] of byte);
{ the following "a" should give a duplicate identifier errorÊ}
1: (a: array[0..4] of word);
2: (a: array[0..1] of cardinal; w: word);
end;
begin
end.

144
tests/tbs/tbs0312.pp Normal file
View File

@ -0,0 +1,144 @@
{ Program that showss a problem if
Self is not reloaded in %esi register
at entry in local procedure inside method }
uses
objects;
type
{$ifndef FPC}
sw_integer = integer;
{$endif not FPC}
PMYObj = ^TMyObj;
TMyObj = Object(TObject)
x : longint;
Constructor Init(ax : longint);
procedure display;virtual;
end;
PMYObj2 = ^TMyObj2;
TMyObj2 = Object(TMyObj)
y : longint;
Constructor Init(ax,ay : longint);
procedure display;virtual;
end;
PMyCollection = ^TMyCollection;
TMyCollection = Object(TCollection)
function At(I : sw_integer) : PMyObj;
procedure DummyThatShouldNotBeCalled;virtual;
end;
{ TMy is also a TCollection so that
ShowMy and DummyThatShouldNotBeCalled are at same position in VMT }
TMy = Object(TCollection)
Col : PMyCollection;
MyObj : PMyObj;
ShowMyCalled : boolean;
constructor Init;
destructor Done;virtual;
procedure ShowAll;
procedure AddMyObj(x : longint);
procedure AddMyObj2(x,y : longint);
procedure ShowMy;virtual;
end;
Constructor TMyObj.Init(ax : longint);
begin
Inherited Init;
x:=ax;
end;
Procedure TMyObj.Display;
begin
Writeln('x = ',x);
end;
Constructor TMyObj2.Init(ax,ay : longint);
begin
Inherited Init(ax);
y:=ay;
end;
Procedure TMyObj2.Display;
begin
Writeln('x = ',x,' y = ',y);
end;
Function TMyCollection.At(I : sw_integer) : PMyObj;
begin
At:=Inherited At(I);
end;
Procedure TMyCollection.DummyThatShouldNotBeCalled;
begin
Writeln('This method should never be called');
Abstract;
end;
Constructor TMy.Init;
begin
New(Col,Init(5,5));
MyObj:=nil;
ShowMyCalled:=false;
end;
Destructor TMy.Done;
begin
Dispose(Col,Done);
Inherited Done;
end;
Procedure TMy.ShowAll;
procedure ShowIt(P : pointer);{$ifdef TP}far;{$endif}
begin
ShowMy;
PMyObj(P)^.Display;
end;
begin
Col^.ForEach(@ShowIt);
end;
Procedure TMy.ShowMy;
begin
if assigned(MyObj) then
MyObj^.Display;
ShowMyCalled:=true;
end;
Procedure TMy.AddMyObj(x : longint);
begin
MyObj:=New(PMyObj,Init(x));
Col^.Insert(MyObj);
end;
Procedure TMy.AddMyObj2(x,y : longint);
begin
MyObj:=New(PMyObj2,Init(x,y));
Col^.Insert(MyObj);
end;
var
My : TMy;
begin
My.Init;
My.AddMyObj(5);
My.AddMyObj2(4,3);
My.AddMyObj(43);
{ MyObj field is now a PMyObj with value 43 }
My.ShowAll;
If not My.ShowMyCalled then
begin
Writeln('ShowAll does not work correctly');
Halt(1);
end;
My.Done;
end.