paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-30 20:40:20 +02:00
Code Issues Packages Projects Releases Wiki Activity

Continue fixing open array handling:

Browse Source 
* 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 -
This commit is contained in:
sergei 2011-03-05 18:45:44 +00:00
parent 7c1f4b8f20
commit 1fcd40ee64
8 changed files with 55 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

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

13
compiler/ncgutil.pas
View File

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

6
compiler/pinline.pas
View File

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

2
rtl/inc/aliases.inc
View File

@ -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'];

4
rtl/inc/compproc.inc
View File

@ -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;

7
rtl/inc/dynarr.inc
View File

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

16
rtl/inc/rtti.inc
View File

@ -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;

27
tests/test/tarray8.pp Normal file
View File

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