* fix #40725: pass along whole array constructor to the Insert() so that it's converted with the correct checks

+ added test
This commit is contained in:
Sven/Sarah Barth 2024-04-12 17:16:26 +02:00
parent e76c5d96d8
commit b0d61558e3
2 changed files with 36 additions and 6 deletions

View File

@ -1988,7 +1988,7 @@ implementation
end;
var
elem : tnode;
constr : tnode;
para : tcallparanode;
isarrconstrl,
isarrconstrr : boolean;
@ -2017,14 +2017,14 @@ implementation
if isarrconstrl then
begin
index:=0;
elem:=tarrayconstructornode(left).left;
tarrayconstructornode(left).left:=nil;
constr:=left;
left:=nil;
end
else
begin
index:=high(asizeint);
elem:=tarrayconstructornode(right).left;
tarrayconstructornode(right).left:=nil;
constr:=right;
right:=nil;
end;
{ we use the fact that insert() caps the index to avoid a copy }
@ -2033,7 +2033,7 @@ implementation
ccallparanode.create(
aktassignmentnode.left.getcopy,
ccallparanode.create(
elem,nil)));
constr,nil)));
result:=cinlinenode.create(in_insert_x_y_z,false,para);
include(aktassignmentnode.assignmentnodeflags,anf_assign_done_in_right);

30
tests/webtbf/tw40725.pp Normal file
View File

@ -0,0 +1,30 @@
{ %FAIL }
program tw40725;
{$mode delphi}
{$ModeSwitch functionreferences}
type
TMyProc = reference to procedure(const A: Integer; const B: string);
TMyProcArray = array of TMyProc;
function GetArray: TMyProcArray;
procedure MyProc(const A: TObject);
begin
end;
begin
//Result := [MyProc]; // compiler error -> OK
Result := Result + [MyProc]; // NO COMPILER ERROR -> BUG
end;
var
A: TMyProcArray;
P: TMyProc;
begin
A := GetArray;
for P in A do
P(1, '');
end.