mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-21 15:29:25 +02:00
latest bugs added
This commit is contained in:
parent
311a357239
commit
64acc76501
10
tests/tbf/tbf0310.pp
Normal file
10
tests/tbf/tbf0310.pp
Normal 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
11
tests/tbs/tbs0311.pp
Normal 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
144
tests/tbs/tbs0312.pp
Normal 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.
|
Loading…
Reference in New Issue
Block a user