paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-13 11:49:30 +02:00
Code Issues Packages Projects Releases Wiki Activity

no message

Browse Source
This commit is contained in:
florian 2005-03-05 16:37:06 +00:00
parent 38f57c30fe
commit 3ad334f7cb
1 changed files with 45 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

45
tests/webtbs/tw3742.pp Normal file
View File

@ -0,0 +1,45 @@
{ %OPT=-gh }
{ Source provided for Free Pascal Bug Report 3742 }
{ Submitted by "Martin Schreiber" on 2005-03-04 }
{ e-mail: }
program project1;
{$mode objfpc}{$H+}
//compile with -glh
uses
Classes;
type
integerarty = array of integer;
scopestackcachety = record
startscope: integer;
stack: integerarty;
end;
scopestackcachearty = array of scopestackcachety;
var
ar2: scopestackcachearty;
procedure testproc;
var
ar1: integerarty;
begin
setlength(ar1,2);
setlength(ar2,2);
ar2[0].stack:= copy(ar1,0,1);
ar2[1].stack:= copy(ar1,0,1);
writeln('refcount a 0: ',pinteger(pchar(pointer(ar2[0].stack)-8))^);
writeln('refcount a 1: ',pinteger(pchar(pointer(ar2[1].stack)-8))^);
end;
begin
testproc;
writeln('refcount b 0: ',pinteger(pchar(pointer(ar2[0].stack)-8))^);
writeln('refcount b 1: ',pinteger(pchar(pointer(ar2[1].stack)-8))^);
finalize(ar2);
end.