paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-13 11:24:14 +02:00
Code Issues Packages Projects Releases Wiki Activity

* proper fix for 8481 et. al.

Browse Source 
git-svn-id: trunk@7691 -
This commit is contained in:
florian 2007-06-16 19:03:53 +00:00
parent 92975a7c99
commit 37bd49692e
3 changed files with 46 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
compiler/nld.pas
View File

@ -698,6 +698,23 @@ implementation
exit;
end;
{ call helpers for composite types containing automated types }
if (left.resultdef.needs_inittable) and
(left.resultdef.typ in [arraydef,objectdef,recorddef]) then
begin
hp:=ccallparanode.create(caddrnode.create_internal(
crttinode.create(tstoreddef(left.resultdef),fullrtti,rdt_normal)),
ccallparanode.create(ctypeconvnode.create_internal(
caddrnode.create_internal(left),voidpointertype),
ccallparanode.create(ctypeconvnode.create_internal(
caddrnode.create_internal(right),voidpointertype),
nil)));
result:=ccallnode.createintern('fpc_copy',hp);
left:=nil;
right:=nil;
exit;
end;
{ call helpers for windows widestrings, they aren't ref. counted }
if (tf_winlikewidestring in target_info.flags) and is_widestring(left.resultdef) then
begin

1
rtl/inc/compproc.inc
View File

@ -410,6 +410,7 @@ Procedure fpc_finalize (Data,TypeInfo: Pointer); compilerproc;
Procedure fpc_Addref (Data,TypeInfo : Pointer); compilerproc;
Procedure fpc_DecRef (Data,TypeInfo : Pointer); compilerproc;
procedure fpc_finalize_array(data,typeinfo : pointer;count,size : longint); compilerproc;
procedure fpc_Copy (Src, Dest, TypeInfo : Pointer); compilerproc;
{$endif FPC_HAS_FEATURE_RTTI}

39
rtl/inc/rtti.inc
View File

@ -45,6 +45,7 @@ Const
type
TRTTIProc=procedure(Data,TypeInfo:Pointer);
{ if you modify this procedure, fpc_copy must be probably modified as well }
procedure RecordRTTI(Data,TypeInfo:Pointer;rttiproc:TRTTIProc);
{
A record is designed as follows :
@ -87,6 +88,7 @@ begin
end;
{ if you modify this procedure, fpc_copy must be probably modified as well }
procedure ArrayRTTI(Data,TypeInfo:Pointer;rttiproc:TRTTIProc);
{
An array is designed as follows :
@ -220,15 +222,17 @@ begin
end;
end;
{ define alias for internal use in the system unit }
Procedure fpc_Copy_internal (Src, Dest, TypeInfo : Pointer);[external name 'FPC_COPY'];
(*
Procedure fpc_Copy (Src, Dest, TypeInfo : Pointer);[Public,alias : 'FPC_COPY']; compilerproc;
var
Temp : pbyte;
namelen : byte;
count,
offset,
i : longint;
size,
i : SizeInt;
info : pointer;
begin
case PByte(TypeInfo)^ of
@ -239,13 +243,26 @@ begin
PPointer(Dest)^:=PPointer(Src)^;
end;
tkWstring:
begin
fpc_WideStr_Incr_Ref(PPointer(Src)^);
fpc_WideStr_Decr_Ref(PPointer(Dest)^);
end;
fpc_WideStr_Assign(PPointer(Dest)^,PPointer(Src)^);
tkArray:
begin
arrayrtti(data,typeinfo,@fpc_systemDecRef);
Temp:=PByte(TypeInfo);
inc(Temp);
{ Skip Name }
namelen:=Temp^;
inc(temp,namelen+1);
temp:=aligntoptr(temp);
{ Element size }
size:=PSizeInt(Temp)^;
inc(Temp,sizeof(Size));
{ Element count }
Count:=PSizeInt(Temp)^;
inc(Temp,sizeof(Count));
Info:=PPointer(Temp)^;
inc(Temp,sizeof(Info));
{ Process elements }
for I:=0 to Count-1 do
fpc_Copy_internal(Src+(I*size),Dest+(I*size),Info);
end;
tkobject,
tkrecord:
@ -265,19 +282,20 @@ begin
{ Element count }
Count:=PLongint(Temp)^;
inc(Temp,sizeof(Count));
{ Process elements }
{ Process elements with rtti }
for i:=1 to count Do
begin
Info:=PPointer(Temp)^;
inc(Temp,sizeof(Info));
Offset:=PLongint(Temp)^;
inc(Temp,sizeof(Offset));
fpc_Copy(Src+Offset,Src+Offset,Info);
fpc_Copy_internal(Src+Offset,Dest+Offset,Info);
end;
end;
tkDynArray:
begin
fpc_dynarray_Incr_Ref(PPointer(Src)^);
fpc_dynarray_Decr_Ref(PPointer(Dest)^);
fpc_dynarray_Decr_Ref(PPointer(Dest)^,typeinfo);
PPointer(Dest)^:=PPointer(Src)^;
end;
tkInterface:
@ -290,7 +308,6 @@ begin
VarCopyProc(pvardata(dest)^,pvardata(src)^);
end;
end;
*)
procedure fpc_finalize_array(data,typeinfo : pointer;count,size : longint); [Public,Alias:'FPC_FINALIZEARRAY']; compilerproc;