Skip to content

[WIP] Fix for pointer helper bug #39169.

deref_helper.patch

This patch fixes #39169 (closed) but does so by reintroducing #38122 (closed) and failing tests/webtbs/tw38122.pp and tests/test/tthlp29.pp... for now.

Test that also modifies self and checks it was modified on the caller’s side:

{$mode objfpc} {$modeswitch typehelpers}
{$warn 4055 off - Conversion between ordinals and pointers is not portable}

type
	PointerHelper = type helper for pointer
		function ToUintAndIncr: PtrUint;
	end;

	function PointerHelper.ToUintAndIncr: PtrUint;
	begin
		result := PtrUint(self);
		PtrUint(self) += 1;
	end;

var
	p: pointer;
	pp: PPointer;
	ip, ipThroughPp: PtrUint;
	exitCode: uint32 = 0;

begin
	p := pointer(16);
	pp := @p;
	ip := p.ToUintAndIncr;
	ipThroughPp := pp^.ToUintAndIncr;

	if ip <> 16 then
	begin
		writeln('ip = $', HexStr(ip, 2 * sizeof(PtrUint)), ', expected $', HexStr(16, 2));
		exitCode := 1;
	end;

	if ipThroughPp <> 17 then
	begin
		writeln('ipThroughPp = $', HexStr(ipThroughPp, 2 * sizeof(PtrUint)), ', expected $', HexStr(17, 2));
		exitCode := 2;
	end;

	if p <> pointer(18) then
	begin
		writeln('p = $', HexStr(p), ', expected $', HexStr(18, 2));
		exitCode := 3;
	end;

	if pp <> @p then
	begin
		writeln('pp unexpectedly changed from $', HexStr(@p), ' to $', HexStr(pp));
		exitCode := 4;
	end;

	if exitCode = 0 then writeln('ok');
	if exitCode <> 0 then halt(exitCode);
end.

Unpatched output:

ipThroughPp = $0000000100013010, expected $11
p = $0000000000000011, expected $12
pp unexpectedly changed from $0000000100013010 to $0000000100013011
Edited by Rika
To upload designs, you'll need to enable LFS and have an admin enable hashed storage. More information