Continue fixing open array handling:

* Unified fpc_initialize_array,fpc_finalize_array with fpc_decref_array and fpc_addref_array by removing 'size' parameter from the former two. Element size is easily calculated from RTTI, so omitting it simplifies code generation. All four helpers are now callable by tcg.g_array_rtti_helper().
* ncgutil.pas: initialization of open array out-parameters is now done properly (using fpc_initialize_array).
+ Test

git-svn-id: trunk@17081 -

.gitattributes

@@ -9453,6 +9453,7 @@ tests/test/tarray4.pp svneol=native#text/plain
 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/tasmread.pp svneol=native#text/plain
 tests/test/tasout.pp svneol=native#text/plain
 tests/test/tassignmentoperator1.pp svneol=native#text/pascal

compiler/ncgutil.pas

@@ -1622,7 +1622,18 @@ implementation
                        else
                          trash_reference(list,href,2);
                      if needs_inittable then
-                       cg.g_initialize(list,tparavarsym(p).vardef,href);
+                       begin
+                         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(201103033);
+                             cg.g_array_rtti_helper(list,eldef,href,hsym.initialloc,'FPC_INITIALIZE_ARRAY');
+                           end
+                         else
+                           cg.g_initialize(list,tparavarsym(p).vardef,href);
+                       end;
                    end;
                end;
              else if do_trashing and

compiler/pinline.pas

@@ -620,14 +620,12 @@ implementation
          begin
            destppn:=tcallparanode(ppn.right);
            { create call to fpc_initialize/finalize_array }
-           npara:=ccallparanode.create(cordconstnode.create
-                     (destppn.left.resultdef.size,s32inttype,true),
-                  ccallparanode.create(ctypeconvnode.create
+           npara:=ccallparanode.create(ctypeconvnode.create
                      (ppn.left,s32inttype),
                   ccallparanode.create(caddrnode.create_internal
                      (crttinode.create(tstoreddef(destppn.left.resultdef),initrtti,rdt_normal)),
                   ccallparanode.create(caddrnode.create_internal
-                     (destppn.left),nil))));
+                     (destppn.left),nil)));
            if isinit then
              newblock:=ccallnode.createintern('fpc_initialize_array',npara)
            else

rtl/inc/aliases.inc

@@ -28,5 +28,5 @@ Procedure int_Finalize (Data,TypeInfo: Pointer); [external name 'FPC_FINALIZE'];
 Procedure int_Addref (Data,TypeInfo : Pointer); [external name 'FPC_ADDREF'];
 Procedure int_DecRef (Data, TypeInfo : Pointer); [external name 'FPC_DECREF'];
 Procedure int_Initialize (Data,TypeInfo: Pointer); [external name 'FPC_INITIALIZE'];
-procedure int_FinalizeArray(data,typeinfo : pointer;count,size : longint); [external name 'FPC_FINALIZEARRAY'];
+procedure int_FinalizeArray(data,typeinfo : pointer;count : longint); [external name 'FPC_FINALIZE_ARRAY'];
 

rtl/inc/compproc.inc

@@ -671,8 +671,8 @@ Procedure fpc_Initialize (Data,TypeInfo : pointer); compilerproc;
 Procedure fpc_finalize (Data,TypeInfo: Pointer); compilerproc;
 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_initialize_array(data,typeinfo : pointer;count : SizeInt); compilerproc;
+procedure fpc_finalize_array(data,typeinfo : pointer;count : 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;

rtl/inc/dynarr.inc

@@ -53,7 +53,6 @@ function fpc_dynarray_high(p : pointer) : tdynarrayindex;[Public,Alias:'FPC_DYNA
 { releases and finalizes the data of a dyn. array and sets p to nil }
 procedure fpc_dynarray_clear_internal(p : pointer;ti : pointer);
   var
-    elesize : sizeint;
     eletype : pdynarraytypeinfo;
   begin
      if p=nil then
@@ -64,12 +63,10 @@ procedure fpc_dynarray_clear_internal(p : pointer;ti : pointer);
 
      ti:=aligntoptr(ti);
 
-     elesize:=psizeint(ti)^;
      eletype:=pdynarraytypeinfo(pointer(pdynarraytypeinfo(pointer(ti)+sizeof(sizeint)))^);
 
      { finalize all data }
-     int_finalizearray(p+sizeof(tdynarray),eletype,pdynarray(p)^.high+1,
-                       elesize);
+     int_finalizearray(p+sizeof(tdynarray),eletype,pdynarray(p)^.high+1);
 
      { release the data }
      freemem(p);
@@ -243,7 +240,7 @@ procedure fpc_dynarray_setlength(var p : pointer;pti : pointer;
                       begin
                           int_finalizearray(pointer(realp)+sizeof(tdynarray)+
                             elesize*dims[dimcount-1],
-                            eletype,realp^.high-dims[dimcount-1]+1,elesize);
+                            eletype,realp^.high-dims[dimcount-1]+1);
                          reallocmem(realp,size);
                       end
                     else if dims[dimcount-1]>realp^.high+1 then

rtl/inc/rtti.inc

@@ -423,23 +423,23 @@ begin
 end;
 
 
-procedure fpc_initialize_array(data,typeinfo : pointer;count,size : SizeInt); compilerproc;
+procedure fpc_initialize_array(data,typeinfo : pointer;count : SizeInt); [public,alias:'FPC_INITIALIZE_ARRAY'] compilerproc;
   var
-     i : SizeInt;
+     i, size : SizeInt;
   begin
-     if not(PByte(typeinfo)^ in [tkInteger,tkChar,tkEnumeration,tkFloat,tkSet,
-       tkMethod,tkSString,tkLString,tkWChar,tkBool,tkInt64,tkQWord]) then
+     size:=RTTISize(typeinfo);
+     if size>0 then
        for i:=0 to count-1 do
          int_initialize(data+size*i,typeinfo);
   end;
 
 
-procedure fpc_finalize_array(data,typeinfo : pointer;count,size : SizeInt); [Public,Alias:'FPC_FINALIZEARRAY'];  compilerproc;
+procedure fpc_finalize_array(data,typeinfo : pointer;count : SizeInt); [Public,Alias:'FPC_FINALIZE_ARRAY'];  compilerproc;
   var
-     i : SizeInt;
+     i, size: SizeInt;
   begin
-     if not(PByte(typeinfo)^ in [tkInteger,tkChar,tkEnumeration,tkFloat,tkSet,
-       tkMethod,tkSString,tkLString,tkWChar,tkBool,tkInt64,tkQWord]) then
+     size:=RTTISize(typeinfo);
+     if size>0 then
        for i:=0 to count-1 do
          int_finalize(data+size*i,typeinfo);
   end;

tests/test/tarray8.pp

@@ -0,0 +1,27 @@
+{ Test correct RTTI handling of open arrays with managed elements.
+  See also webtbs/tw18859.pp }
+
+{$mode objfpc}{$h+}
+
+procedure test3(out arr: array of string);
+begin
+  { implicit initialize happens here }
+  arr[0] := '';  // if initialization does not happen correctly, teststring will be destroyed
+end;
+
+var
+  teststring: string;
+  arrs: array[0..3] of string;
+
+begin
+  teststring := 'test';
+  uniquestring(teststring);
+  // Must be a string with refcount>1, otherwise decref before call will release it and
+  // zero the pointer, thus masking the issue.
+  arrs[0] := teststring;
+  { implicit decref happens here }
+  test3(arrs);
+  if teststring <> 'test' then
+    Halt(1);
+  Halt(0);  
+end.