Browse Source

* also test new(precord)

peter 22 years ago
parent
commit
c821c2b596
1 changed files with 27 additions and 4 deletions
  1. 27 4
      tests/webtbs/tw1103.pp

+ 27 - 4
tests/webtbs/tw1103.pp

@@ -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 GetGroupInfoP: PTestRec;
+var
+  s : string;
+begin
+  new(Result);
+  s:=' Wr';
+  Result^.fString := 'Test' + s;
+  Result^.fRetAddr := 0;
+end;
+
 function GetGroupInfo: TestRec;
+var
+  s : string;
 begin
-  Result.fString := 'Test';
+  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.