paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-20 21:09:24 +02:00
Code Issues Packages Projects Releases Wiki Activity

* also test new(precord)

Browse Source
This commit is contained in:
peter 2003-11-04 19:06:02 +00:00
parent f47210ad0d
commit c821c2b596
1 changed files with 28 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
tests/webtbs/tw1103.pp
View File

@ -1,5 +1,6 @@
{$ifdef fpc}{$MODE OBJFPC }{$endif}
type
PTestRec = ^TestRec;
TestRec = record
fString : AnsiString;
fInt1 : Longint;
@ -7,9 +8,22 @@ type
fRetAddr : Longint;
end;
function GetGroupInfo: TestRec;
function GetGroupInfoP: PTestRec;
var
s : string;
begin
Result.fString := 'Test';
new(Result);
s:=' Wr';
Result^.fString := 'Test' + s;
Result^.fRetAddr := 0;
end;
function GetGroupInfo: TestRec;
var
s : string;
begin
s:=' Wr';
Result.fString := 'Test' + s;
Result.fRetAddr := 0;
end;
@ -25,14 +39,23 @@ end;
procedure destroystack;
var
s : string;
s : shortstring;
p : pchar;
i : longint;
begin
for i:=0 to 255 do
s[i]:=#$90;
s[i]:=#$90;
getmem(p,sizeof(TestRec));
for i:=0 to sizeof(TestRec)-1 do
p[i]:=#$ff;
freemem(p);
end;
var
p1 : PTestRec;
begin
// destroystack;
destroystack;
p;
p1:=GetGroupInfoP;
dispose(p1);
end.