{ test bench of fpc memory management}
program memMgr;
type
TRec = record { memory area of sizeof(TRec) }
a, b: integer;
end;
TObj = object { memory area of sizeof(TObj) }
a, b: integer;
end;
{ TClass }
TClass = class { pointer }
constructor Create; overload;
constructor Create(const c: TClass); overload; {deep copy version}
public
a, b: integer;
v: array of integer;
end;
PTRec = ^TRec;
var
a, b: array of integer; { dynamic arrays -> pointer }
ra, rb: TRec;
oa, ob: TObj;
ca, cb: TClass;
pa, pb: PTrec;
{ TClass }
constructor TClass.Create;
begin
a := 0;
b := 0;
v := nil;
inherited Create;
end;
constructor TClass.Create(const c: TClass);
begin
inherited Create;
a := c.a; {deep copy assign all c properties to self}
b := c.b;
v := copy(c.v); {for dynamic arrays properties use copy func: v:=copy(c.v); }
end;
begin
{ dynamic array are pointers so assignment does a shallow copy }
writeln('----------- dynamic arrays');
a := nil;
setLength(a, 10);
a[0] := 1;
b := a; // pointer copy
writeln('@a[0]=0x', hexStr(@a[0]), ' @b[0]=0x', hexStr(@b[0]), ' pointers are equal');
b[0] := 2; // also changes a[0] as a and b point to the same place
writeln('a[0]=', a[0], ' b[0]=', b[0]);
if a[0] = b[0] then writeln(
'dymanic arrays assignment copies a pointer (shallow copy)');
{ deep copy using copy func. }
b := copy(a); // now a & b point to different addresses
b[0] := 3;
if a[0] <> b[0] then writeln('after copy func b has a different address');
writeln('a[0]=', a[0], ' b[0]=', b[0]);
{ records fixed address deep copy assignment (non recursive)}
writeln('----------- records');
ra.a := 1;
rb := ra;
rb.a := 2;
writeln('ra.a=', ra.a, ' rb.a=', rb.a);
if ra.a <> rb.a then writeln('records use fixed independant storage');
{ objects -> fixed address deep copy assign }
writeln('----------- objects');
oa.a := 1;
ob := oa;
ob.a := 2;
writeln('oa.a=', ra.a, ' ob.a=', ob.a);
if oa.a <> ob.a then writeln('objects use fixed independant storage');
{ class -> pointers }
writeln('----------- class');
ca := TClass.Create;
cb := ca; {copy pointer -> shallow copy }
ca.a := 1;
cb.a := 2; { now both ca.a and cb.a are equal as ca and cb point to the same place }
writeln('ca=0x', hexStr(ca), ' cb=0x', hexStr(cb), ' they point to the same address');
writeln('ca.a=', ca.a, ' cb.a=', cb.a);
if ca.a <> cb.a then writeln('class use fixed independant storage')
else
writeln('class use pointer based shallow copy');
cb := TClass.Create;
cb.a := 3;
if ca.a <> cb.a then writeln(
'after creating a new instance of cb it points to a different place than ca');
writeln('ca.a=', ca.a, ' cb.a=', cb.a);
cb := TClass.Create(ca);
{ now the contain the same data in different spaces -> deep copy }
writeln('after a deep copy ca.a=', ca.a, ' cb.a=', cb.a);
cb.a := 3;
writeln('modified cb -> cb.a=', cb.a, ' cb.b=', cb.b);
{ pointers: new dispose }
writeln('----------- pointers to records new/dispose');
new(pa);
pa^.a := 1;
pb := pa;
pb^.a := 2;
if pa^.a <> pb^.a then writeln('pointers use fixed independant storage')
else
writeln('pointers use shallow copy');
writeln('pa.a=', pa^.a, ' pb.a=', pb^.a);
writeln('new pb instance');
new(pb);
pb^.a := 3;
writeln('pa.a=', pa^.a, ' pb.a=', pb^.a);
writeln('pa=0x', hexStr(pa), ' pb=0x', hexStr(pb), ' point to different places');
dispose(pa);
dispose(pb);
{ getmem }
writeln('----------- pointers to records getmem/freemem');
getmem(pa, sizeof(pa^));
pa^.a := 1;
pb := pa;
pb^.a := 2;
if pa^.a <> pb^.a then writeln('pointers use fixed independant storage')
else
writeln('pointers use shallow copy');
writeln('pa.a=', pa^.a, ' pb.a=', pb^.a);
writeln('new pb instance');
getmem(pb, sizeof(pb^));
pb^.a := 3;
writeln('pa.a=', pa^.a, ' pb.a=', pb^.a);
writeln('pa=0x', hexStr(pa), ' pb=0x', hexStr(pb), ' point to different places');
pb^ := pa^; { record deep copy }
writeln('pa.a=', pa^.a, ' pb.a=', pb^.a);
writeln('pa=0x', hexStr(pa), ' pb=0x', hexStr(pb), ' point to different places');
freemem(pa);
freemem(pb);
{---------------------}
readln;
end.