fpc_dynarray_setlength does not respect Copy operator
SetLength
respects operator Initialize/Finalize
and even operator AddRef
(when uniquifying the array with RefCount <> 1
), but not operator Copy
.
Managed types can be tempted to track their instances in memory: for example, collection can watch its iterators to be able to fix them on the fly to allow changes during iteration. This will work with all current scenarios but dynamic arrays of such iterators.
Okay, it was a bad example because iterators rarely end up in the array and because you can neglect the extra allocation and use class
for iterators to circumvent this, but imagine a world where you don't have to think about it.
Demo that shows absence of Copy
:
{$mode objfpc} {$h+} {$modeswitch advancedrecords} {$modeswitch duplicatelocals} {$coperators on}
{$warn 4055 off} // Hint: Conversion between ordinals and pointers is not portable
{$warn 5092 off} // Hint: Variable of a managed type does not seem to be initialized
type
pManObj = ^ManObj;
ManObj = record
name: string;
selfPtr: pManObj;
procedure Verify;
function ToString: string;
class operator Initialize(var self: ManObj);
class operator Copy(constref b: ManObj; var self: ManObj);
class operator AddRef(var self: ManObj);
end;
function ShortPointerStr(p: pointer): string;
var
width: uint8;
begin
if PtrUint(p) = 0 then
width := 1
else
width := 1 +
{$if sizeof(pointer) = sizeof(dword)} BsrDWord
{$elseif sizeof(pointer) = sizeof(qword)} BsrQWord
{$else} {$error unknown pointer size} {$endif}
(PtrUint(p)) div 4;
result := HexStr(PtrUint(p), width);
end;
procedure ManObj.Verify;
begin
if @self = selfPtr then
writeln('Verify ', ToString, ' ok.')
else
writeln('VERIFY ', ToString, ' FAILED: @self=', ShortPointerStr(@self), '.');
end;
function ManObj.ToString: string;
begin
result := name + '@' + ShortPointerStr(selfPtr);
end;
class operator ManObj.Initialize(var self: ManObj);
begin
self.selfPtr := @self;
end;
class operator ManObj.Copy(constref b: ManObj; var self: ManObj);
begin
writeln('Copy ', b.ToString, ' -> ', ShortPointerStr(@self), '.');
self.name := b.name;
self.selfPtr := @self;
end;
class operator ManObj.AddRef(var self: ManObj);
begin
writeln('AddRef ', self.ToString, ' -> ', ShortPointerStr(@self), '.');
self.selfPtr := @self;
end;
var
m: array of ManObj;
mp: pointer;
begin
SetLength(m, 1);
mp := pointer(m);
writeln('Array allocated at ', ShortPointerStr(mp), '.');
m[0].name := 'A';
m[0].Verify;
SetLength(m, 16);
if pointer(m) = mp then
begin
writeln('Reallocation didn''t move the array. It is a valid behavior, but the array was actually expected to move in order to continue test.');
halt(1);
end;
writeln('Array reallocated to ', ShortPointerStr(pointer(m)), '.');
m[0].Verify;
end.
↓↓↓
Array allocated at 14F2820.
Verify A@14F2820 ok.
Array reallocated to 14FA850.
VERIFY A@14F2820 FAILED: @self=14FA850.