* Fixed handling of "open array of managed type" out-parameters at caller side. Reference count should be decremented only for those array elements which are actually passed to the called procedure; it may be a part of original array if range or slice is used. Concludes work on #18859.

+ Test

git-svn-id: trunk@17136 -

.gitattributes

@@ -9457,6 +9457,7 @@ tests/test/tarray5.pp svneol=native#text/plain
 tests/test/tarray6.pp svneol=native#text/plain
 tests/test/tarray7.pp svneol=native#text/plain
 tests/test/tarray8.pp svneol=native#text/plain
+tests/test/tarray9.pp svneol=native#text/plain
 tests/test/tasmread.pp svneol=native#text/plain
 tests/test/tasout.pp svneol=native#text/plain
 tests/test/tassignmentoperator1.pp svneol=native#text/pascal

compiler/ncal.pas

@@ -201,6 +201,9 @@ interface
           function can_be_inlined: boolean;
 
           property nextpara : tnode read right write right;
+          { third is reused to store the parameter name (only while parsing
+            vardispatch calls, never in real node tree) and copy of 'high'
+            parameter tree when the parameter is an open array of managed type }
           property parametername : tnode read third write third;
 
           { returns whether the evaluation of this parameter involves a
@@ -620,6 +623,8 @@ implementation
          old_array_constructor:=allow_array_constructor;
          allow_array_constructor:=true;
          typecheckpass(left);
+         if assigned(third) then
+           typecheckpass(third);
          allow_array_constructor:=old_array_constructor;
          if codegenerror then
           resultdef:=generrordef
@@ -635,6 +640,8 @@ implementation
         if not assigned(left.resultdef) then
           get_paratype;
         firstpass(left);
+        if assigned(third) then
+          firstpass(third);
         expectloc:=left.expectloc;
       end;
 
@@ -2492,6 +2499,7 @@ implementation
         varargspara,
         currpara : tparavarsym;
         hiddentree : tnode;
+        paradef  : tdef;
       begin
         pt:=tcallparanode(left);
         oldppt:=pcallparanode(@left);
@@ -2527,7 +2535,19 @@ implementation
                   if not assigned(pt) or (i=0) then
                     internalerror(200304081);
                   { we need the information of the previous parameter }
-                  hiddentree:=gen_high_tree(pt.left,tparavarsym(procdefinition.paras[i-1]).vardef);
+                  paradef:=tparavarsym(procdefinition.paras[i-1]).vardef;
+                  hiddentree:=gen_high_tree(pt.left,paradef);
+                  { for open array of managed type, a copy of high parameter is
+                    necessary to properly initialize before the call }
+                  if is_open_array(paradef) and
+                    (tparavarsym(procdefinition.paras[i-1]).varspez=vs_out) and
+                     is_managed_type(tarraydef(paradef).elementdef) then
+                    begin
+                      typecheckpass(hiddentree);
+                      {this eliminates double call to fpc_dynarray_high, if any}
+                      maybe_load_in_temp(hiddentree);
+                      oldppt^.third:=hiddentree.getcopy;
+                    end;
                 end
               else
                 if vo_is_typinfo_para in currpara.varoptions then

compiler/ncgcal.pas

@@ -167,6 +167,15 @@ implementation
                 is_managed_type(left.resultdef) then
                begin
                  location_get_data_ref(current_asmdata.CurrAsmList,left.location,href,false,sizeof(pint));
+                 if is_open_array(resultdef) then
+                   begin
+                     if third=nil then
+                       InternalError(201103063);
+                     secondpass(third);
+                     cg.g_array_rtti_helper(current_asmdata.CurrAsmList,tarraydef(resultdef).elementdef,
+                       href,third.location,'FPC_DECREF_ARRAY');
+                   end
+                 else
                    cg.g_decrrefcount(current_asmdata.CurrAsmList,left.resultdef,href);
                end;
 

tests/test/tarray9.pp

@@ -0,0 +1,122 @@
+{ %OPT=-gh }
+
+{ Test correct RTTI handling of open arrays with managed elements. 
+  When a part (slice or range) of array is passed as an out-parameter open array
+  to a procedure, the entire array should NOT be finalized, only part that is actually passed should. }
+
+{$mode objfpc}{$h+}
+uses SysUtils;
+
+
+procedure test3(out arr: array of string);
+var
+  i: Integer;
+begin
+  { implicit initialization happens here }
+  for i := 0 to High(arr) do
+  begin
+    Pointer(arr[i]):=nil;            // if array initialization was correct, this will be a no-op
+                                     // otherwise, it will trigger a memory leak 
+    arr[i] := 'tested'+IntToStr(i);
+  end;
+end;
+
+procedure test_entire_openarray(var arr: array of string);
+begin
+  test3(arr);
+end;
+
+procedure test_openarray_subrange(var arr: array of string);
+begin
+  test3(arr[1..2]);
+end;
+
+procedure test_openarray_slice(var arr: array of string);
+begin
+  test3(slice(arr,2));
+end;
+
+
+var
+  sarr: array[0..3] of string;
+  darr: array of string;
+
+procedure prepare;
+var
+  i: Integer;
+begin
+  for i := 0 to 3 do
+  begin
+    sarr[i] := 'static'+IntToStr(i);
+    darr[i] := 'dynamic'+IntToStr(i);
+  end;  
+end;
+
+begin
+  HaltOnNotReleased := True;
+  SetLength(darr,4);
+
+  prepare;
+  test_entire_openarray(sarr);
+  if sarr[0] <> 'tested0' then Halt(1);
+  if sarr[1] <> 'tested1' then Halt(2);
+  if sarr[2] <> 'tested2' then Halt(3);
+  if sarr[3] <> 'tested3' then Halt(4);
+
+  prepare;
+  test_openarray_subrange(sarr);            // must leave elements 0 and 3 intact
+  if sarr[0] <> 'static0' then Halt(11);
+  if sarr[1] <> 'tested0' then Halt(12);
+  if sarr[2] <> 'tested1' then Halt(13);
+  if sarr[3] <> 'static3' then Halt(14);
+
+  prepare;
+  test_openarray_slice(sarr);               // must leave elements 2 and 3 intact
+  if sarr[0] <> 'tested0' then Halt(21);
+  if sarr[1] <> 'tested1' then Halt(22);
+  if sarr[2] <> 'static2' then Halt(23);
+  if sarr[3] <> 'static3' then Halt(24);
+
+  prepare;
+  test3(sarr);           // entire static array
+  if sarr[0] <> 'tested0' then Halt(31);
+  if sarr[1] <> 'tested1' then Halt(32);
+  if sarr[2] <> 'tested2' then Halt(33);
+  if sarr[3] <> 'tested3' then Halt(34);
+
+  prepare;
+  test3(sarr[1..2]);     // static array subrange
+  if sarr[0] <> 'static0' then Halt(41);
+  if sarr[1] <> 'tested0' then Halt(42);
+  if sarr[2] <> 'tested1' then Halt(43);
+  if sarr[3] <> 'static3' then Halt(44);
+
+  prepare;
+  test3(slice(sarr,2));  // static array slice
+  if sarr[0] <> 'tested0' then Halt(51);
+  if sarr[1] <> 'tested1' then Halt(52);
+  if sarr[2] <> 'static2' then Halt(53);
+  if sarr[3] <> 'static3' then Halt(54);
+
+  prepare;
+  test3(darr);           // entire dynamic array
+  if darr[0] <> 'tested0' then Halt(61);
+  if darr[1] <> 'tested1' then Halt(62);
+  if darr[2] <> 'tested2' then Halt(63);
+  if darr[3] <> 'tested3' then Halt(64);
+
+  prepare;
+  test3(darr[1..2]);     // dynamic array subrange
+  if darr[0] <> 'dynamic0' then Halt(71);
+  if darr[1] <> 'tested0' then Halt(72);
+  if darr[2] <> 'tested1' then Halt(73);
+  if darr[3] <> 'dynamic3' then Halt(74);
+
+  prepare;
+  test3(slice(darr,2));  // dynamic array slice
+  if darr[0] <> 'tested0' then Halt(81);
+  if darr[1] <> 'tested1' then Halt(82);
+  if darr[2] <> 'dynamic2' then Halt(83);
+  if darr[3] <> 'dynamic3' then Halt(84);
+
+end.