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

* New test for #41155 bug fix

Browse Source
This commit is contained in:
J. Gareth "Curious Kit" Moreton 2025-02-24 05:04:44 +00:00 committed by J. Gareth "Kit" Moreton
parent 4648f967bd
commit eb74850d7c
1 changed files with 33 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
tests/webtbs/tw41155.pp Normal file
View File

@ -0,0 +1,33 @@
{ %OPT=-O3 }
program tw41155;
{$mode objfpc} {$modeswitch anonymousfunctions}
type
pAdapter = ^Adapter;
Adapter = record
start: SizeUint;
adaptee: procedure(p: pointer; a, b: SizeUint);
end;
procedure UseAdapter(ad: pAdapter; a, b: SizeUint);
begin
ad^.adaptee(nil, ad^.start + a, ad^.start + b);
end;
var
ad: Adapter;
oops: boolean = false;
begin
ad.start := 10;
ad.adaptee :=
procedure(p: pointer; a, b: SizeUint)
begin
if p <> nil then begin writeln('p = ', PtrUint(p), ', should be 0.'); oops := true; end;
if a <> 110 then begin writeln('a = ', a, ', should be 110.'); oops := true; end;
if b <> 1010 then begin writeln('b = ', b, ', should be 1010.'); oops := true; end;
end;
UseAdapter(@ad, 100, 1000);
if oops then halt(1);
WriteLn('ok');
end.