diff --git a/.gitattributes b/.gitattributes index 609ef238ff..f740667dc7 100644 --- a/.gitattributes +++ b/.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 diff --git a/compiler/ncgutil.pas b/compiler/ncgutil.pas index 29912918ba..5b377000ce 100644 --- a/compiler/ncgutil.pas +++ b/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 diff --git a/compiler/pinline.pas b/compiler/pinline.pas index 2c3904abae..58fe2b9184 100644 --- a/compiler/pinline.pas +++ b/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 diff --git a/rtl/inc/aliases.inc b/rtl/inc/aliases.inc index e9431cc5b8..7a7e90794c 100644 --- a/rtl/inc/aliases.inc +++ b/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']; diff --git a/rtl/inc/compproc.inc b/rtl/inc/compproc.inc index 365992cf4d..90f4dbb5cf 100644 --- a/rtl/inc/compproc.inc +++ b/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; diff --git a/rtl/inc/dynarr.inc b/rtl/inc/dynarr.inc index 33fca66d96..78eb834d70 100644 --- a/rtl/inc/dynarr.inc +++ b/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 diff --git a/rtl/inc/rtti.inc b/rtl/inc/rtti.inc index 60fe9b5c9b..2fa20a1df6 100644 --- a/rtl/inc/rtti.inc +++ b/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; diff --git a/tests/test/tarray8.pp b/tests/test/tarray8.pp new file mode 100644 index 0000000000..3ce505c0f1 --- /dev/null +++ b/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.