paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-21 03:29:19 +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

31
tests/webtbs/tw1103.pp
View File

@ -1,5 +1,6 @@
{$ifdef fpc}{$MODE OBJFPC }{$endif} {$ifdef fpc}{$MODE OBJFPC }{$endif}
type type
PTestRec = ^TestRec;
TestRec = record TestRec = record
fString : AnsiString; fString : AnsiString;
fInt1 : Longint; fInt1 : Longint;
@ -7,9 +8,22 @@ type
fRetAddr : Longint; fRetAddr : Longint;
end; end;
function GetGroupInfo: TestRec; function GetGroupInfoP: PTestRec;
var
s : string;
begin 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; Result.fRetAddr := 0;
end; end;
@ -25,14 +39,23 @@ end;
procedure destroystack; procedure destroystack;
var var
s : string; s : shortstring;
p : pchar;
i : longint; i : longint;
begin begin
for i:=0 to 255 do 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; end;
var
p1 : PTestRec;
begin begin
// destroystack; destroystack;
p; p;
p1:=GetGroupInfoP;
dispose(p1);
end. end.