Browse Source

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

Sven/Sarah Barth 1 năm trước cách đây
mục cha
commit
b0d61558e3
2 tập tin đã thay đổi với 36 bổ sung6 xóa
  1. 6 6
      compiler/nadd.pas
  2. 30 0
      tests/webtbf/tw40725.pp

+ 6 - 6
compiler/nadd.pas

@@ -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 - 0
tests/webtbf/tw40725.pp

@@ -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.
+