* Fixed reference counting of open array parameters passed by value. RTTI of the array itself is useless in this case, as it does not provide correct element count. Now using dedicated helpers which take RTTI of array element and the element count. Resolves #18859.

git-svn-id: trunk@17068 -

.gitattributes

@@ -11199,6 +11199,7 @@ tests/webtbs/tw1867.pp svneol=native#text/plain
 tests/webtbs/tw18690.pp svneol=native#text/plain
 tests/webtbs/tw1873.pp svneol=native#text/plain
 tests/webtbs/tw1883.pp svneol=native#text/plain
+tests/webtbs/tw18859.pp svneol=native#text/plain
 tests/webtbs/tw1888.pp svneol=native#text/plain
 tests/webtbs/tw1889.pp svneol=native#text/plain
 tests/webtbs/tw1896.pp svneol=native#text/plain

compiler/cgobj.pas

@@ -451,6 +451,8 @@ unit cgobj;
 
           procedure g_incrrefcount(list : TAsmList;t: tdef; const ref: treference);
           procedure g_decrrefcount(list : TAsmList;t: tdef; const ref: treference);
+          procedure g_array_rtti_helper(list: TAsmList; t: tdef; const ref: treference; const highloc: tlocation;
+            const name: string);
           procedure g_initialize(list : TAsmList;t : tdef;const ref : treference);
           procedure g_finalize(list : TAsmList;t : tdef;const ref : treference);
 
@@ -3580,6 +3582,44 @@ implementation
         cgpara1.done;
       end;
 
+    procedure tcg.g_array_rtti_helper(list: TAsmList; t: tdef; const ref: treference; const highloc: tlocation; const name: string);
+      var
+        cgpara1,cgpara2,cgpara3: TCGPara;
+        href: TReference;
+        hreg: TRegister;
+      begin
+        cgpara1.init;
+        cgpara2.init;
+        cgpara3.init;
+        paramanager.getintparaloc(pocall_default,1,cgpara1);
+        paramanager.getintparaloc(pocall_default,2,cgpara2);
+        paramanager.getintparaloc(pocall_default,3,cgpara3);
+
+        reference_reset_symbol(href,RTTIWriter.get_rtti_label(t,initrtti),0,sizeof(pint));
+        if highloc.loc in [LOC_REGISTER,LOC_CREGISTER] then
+          hreg:=highloc.register
+        else
+          begin
+            hreg:=getintregister(list,OS_INT);
+            a_load_loc_reg(list,OS_INT,highloc,hreg);
+          end;
+        { increment, converts high(x) to length(x) }
+        a_op_const_reg(list,OP_ADD,OS_INT,1,hreg);
+
+        a_load_reg_cgpara(list,OS_INT,hreg,cgpara3);
+        a_loadaddr_ref_cgpara(list,href,cgpara2);
+        a_loadaddr_ref_cgpara(list,ref,cgpara1);
+        paramanager.freecgpara(list,cgpara1);
+        paramanager.freecgpara(list,cgpara2);
+        paramanager.freecgpara(list,cgpara3);
+        allocallcpuregisters(list);
+        a_call_name(list,name,false);
+        deallocallcpuregisters(list);
+
+        cgpara3.done;
+        cgpara2.done;
+        cgpara1.done;
+      end;
 
     procedure tcg.g_initialize(list : TAsmList;t : tdef;const ref : treference);
       var

compiler/ncgutil.pas

@@ -1561,6 +1561,8 @@ implementation
     procedure init_paras(p:TObject;arg:pointer);
       var
         href : treference;
+        hsym : tparavarsym;
+        eldef : tdef;
         tmpreg : tregister;
         list : TAsmList;
         needs_inittable,
@@ -1584,7 +1586,18 @@ implementation
                      paramanager.push_addr_param(tparavarsym(p).varspez,tparavarsym(p).vardef,current_procinfo.procdef.proccalloption)) then
                      begin
                        location_get_data_ref(list,tparavarsym(p).initialloc,href,is_open_array(tparavarsym(p).vardef),sizeof(pint));
-                       cg.g_incrrefcount(list,tparavarsym(p).vardef,href);
+                       if is_open_array(tparavarsym(p).vardef) then
+                         begin
+                           { open arrays do not contain correct element count in their rtti,
+                             the actual count must be passed separately. }
+                           hsym:=tparavarsym(tsym(p).owner.Find('high'+tsym(p).name));
+                           eldef:=tarraydef(tparavarsym(p).vardef).elementdef;
+                           if not assigned(hsym) then
+                             internalerror(201003031);
+                           cg.g_array_rtti_helper(list,eldef,href,hsym.initialloc,'FPC_ADDREF_ARRAY');
+                         end
+                       else
+                         cg.g_incrrefcount(list,tparavarsym(p).vardef,href);
                      end;
                  end;
              vs_out :
@@ -1642,6 +1655,8 @@ implementation
       var
         list : TAsmList;
         href : treference;
+        hsym : tparavarsym;
+        eldef : tdef;
       begin
         if not(tsym(p).typ=paravarsym) then
           exit;
@@ -1652,7 +1667,16 @@ implementation
             begin
               include(current_procinfo.flags,pi_needs_implicit_finally);
               location_get_data_ref(list,tparavarsym(p).localloc,href,is_open_array(tparavarsym(p).vardef),sizeof(pint));
-              cg.g_decrrefcount(list,tparavarsym(p).vardef,href);
+              if is_open_array(tparavarsym(p).vardef) then
+                begin
+                  hsym:=tparavarsym(tsym(p).owner.Find('high'+tsym(p).name));
+                  eldef:=tarraydef(tparavarsym(p).vardef).elementdef;
+                  if not assigned(hsym) then
+                    internalerror(201003032);
+                  cg.g_array_rtti_helper(list,eldef,href,hsym.initialloc,'FPC_DECREF_ARRAY');
+                end
+              else
+                cg.g_decrrefcount(list,tparavarsym(p).vardef,href);
             end;
          end;
         { open arrays can contain elements requiring init/final code, so the else has been removed here }

rtl/inc/compproc.inc

@@ -673,6 +673,8 @@ Procedure fpc_Addref (Data,TypeInfo : Pointer); compilerproc;
 Procedure fpc_DecRef (Data,TypeInfo : Pointer);  compilerproc;
 procedure fpc_initialize_array(data,typeinfo : pointer;count,size : SizeInt); compilerproc;
 procedure fpc_finalize_array(data,typeinfo : pointer;count,size : SizeInt); compilerproc;
+procedure fpc_addref_array(data,typeinfo: pointer; count: SizeInt); compilerproc;
+procedure fpc_decref_array(data,typeinfo: pointer; count: sizeint); compilerproc;
 Function fpc_Copy (Src, Dest, TypeInfo : Pointer) : SizeInt; compilerproc;
 Procedure fpc_Copy_proc (Src, Dest, TypeInfo : Pointer); compilerproc; inline;
 {$endif FPC_HAS_FEATURE_RTTI}

rtl/inc/rtti.inc

@@ -19,6 +19,37 @@
 type
   TRTTIProc=procedure(Data,TypeInfo:Pointer);
 
+function RTTIArraySize(typeInfo: Pointer): SizeInt;
+begin
+  typeInfo:=aligntoptr(typeInfo+2+PByte(typeInfo)[1]);
+  result:=PSizeInt(typeInfo)[0] * PSizeInt(typeInfo)[1];
+end;
+
+function RTTIRecordSize(typeInfo: Pointer): SizeInt;
+begin
+  typeInfo:=aligntoptr(typeInfo+2+PByte(typeInfo)[1]);
+  result:=PLongInt(typeInfo)^;
+end;
+
+function RTTISize(typeInfo: Pointer): SizeInt;
+begin
+  case PByte(typeinfo)^ of
+    tkAString,tkWString,tkUString,
+    tkInterface,tkDynarray:
+      result:=sizeof(Pointer);
+{$ifdef FPC_HAS_FEATURE_VARIANTS}
+    tkVariant:
+      result:=sizeof(TVarData);
+{$endif FPC_HAS_FEATURE_VARIANTS}
+    tkArray:
+      result:=RTTIArraySize(typeinfo);
+    tkObject,tkRecord:
+      result:=RTTIRecordSize(typeinfo);
+  else
+    result:=-1;
+  end;
+end;
+
 { if you modify this procedure, fpc_copy must be probably modified as well }
 procedure RecordRTTI(Data,TypeInfo:Pointer;rttiproc:TRTTIProc);
 {
@@ -413,3 +444,23 @@ procedure fpc_finalize_array(data,typeinfo : pointer;count,size : SizeInt); [Pub
          int_finalize(data+size*i,typeinfo);
   end;
 
+procedure fpc_addref_array(data,typeinfo: pointer; count: SizeInt); [public,alias:'FPC_ADDREF_ARRAY']; compilerproc;
+  var
+    i, size: SizeInt;
+  begin
+    size:=RTTISize(typeinfo);
+    if size>0 then
+      for i:=0 to count-1 do
+        int_addref(data+size*i,typeinfo);
+  end;
+
+procedure fpc_decref_array(data,typeinfo: pointer; count: SizeInt); [public,alias:'FPC_DECREF_ARRAY']; compilerproc;
+  var
+    i, size: SizeInt;
+  begin
+    size:=RTTISize(typeinfo);
+    if size>0 then
+      for i:=0 to count-1 do
+        int_decref(data+size*i,typeinfo);
+  end;
+

tests/webtbs/tw18859.pp

@@ -0,0 +1,37 @@
+{ %OPT=-gh }
+Program project1;
+
+{$mode objfpc}
+{$h+}
+
+type
+  trec = record
+    s: string;
+  end;
+
+procedure test1(values: array of string);
+begin
+   if paramcount = 0 then
+     values[0] := values[0] + '1'
+   else
+     values[0] := '1';
+end;
+
+
+procedure test2(values: array of trec);
+begin
+   if paramcount = 0 then
+     values[0].s := values[0].s + '1'
+   else
+     values[0].s := '1';
+end;
+
+var
+  tr: trec;
+
+begin
+  tr.s := 'test';
+  uniquestring(tr.s);
+  test1([tr.s]);
+  test2([tr]);
+end.