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

* adjust handling of empty buffer as a valid reference is needed nevertheless

Browse Source 
git-svn-id: trunk@37074 -
This commit is contained in:
svenbarth 2017-08-27 14:01:36 +00:00
parent 25d9c85a87
commit a06ed3c929
1 changed files with 43 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

51
packages/rtl-objpas/src/inc/rtti.pp
View File

@ -445,6 +445,8 @@ end;
procedure IntFinalize(APointer, ATypeInfo: Pointer);
external name 'FPC_FINALIZE';
procedure IntInitialize(APointer, ATypeInfo: Pointer);
external name 'FPC_INITIALIZE';
procedure IntAddRef(APointer, ATypeInfo: Pointer);
external name 'FPC_ADDREF';
function IntCopy(ASource, ADest, ATypeInfo: Pointer): SizeInt;
@ -457,22 +459,32 @@ begin
if ALen>0 then
begin
Getmem(FBuffer,FDataSize);
system.move(ACopyFromBuffer^,FBuffer^,FDataSize);
if Assigned(ACopyFromBuffer) then
system.move(ACopyFromBuffer^,FBuffer^,FDataSize)
else
FillChar(FBuffer^, FDataSize, 0);
end;
FIsCopy := True;
FUseAddRef := AAddRef;
if AAddRef and (ALen > 0) then
IntAddRef(FBuffer, FTypeInfo);
if AAddRef and (ALen > 0) then begin
if Assigned(ACopyFromBuffer) then
IntAddRef(FBuffer, FTypeInfo)
else
IntInitialize(FBuffer, FTypeInfo);
end;
end;
constructor TValueDataIntImpl.CreateRef(AData: Pointer; ATypeInfo: PTypeInfo; AAddRef: Boolean);
begin
FTypeInfo := ATypeInfo;
FDataSize := SizeOf(Pointer);
FBuffer := PPointer(AData)^;
if Assigned(AData) then
FBuffer := PPointer(AData)^
else
FBuffer := Nil;
FIsCopy := False;
FUseAddRef := AAddRef;
if AAddRef then
if AAddRef and Assigned(AData) then
IntAddRef(@FBuffer, FTypeInfo);
end;
@ -565,10 +577,17 @@ begin
{$else}
Result.FData.FAsUInt64 := 0;
{$endif}
if not Assigned(ABuffer) or not Assigned(ATypeInfo) then
if not Assigned(ATypeInfo) then
Exit;
{ first handle those types that need a TValueData implementation }
case ATypeInfo^.Kind of
tkSString : result.FData.FValueData := TValueDataIntImpl.CreateCopy(ABuffer, Length(PShortString(ABuffer)^) + 1, ATypeInfo, True);
tkSString : begin
if Assigned(ABuffer) then
size := Length(PShortString(ABuffer)^) + 1
else
size := 256;
result.FData.FValueData := TValueDataIntImpl.CreateCopy(ABuffer, size, ATypeInfo, True);
end;
tkWString,
tkUString,
tkAString : result.FData.FValueData := TValueDataIntImpl.CreateRef(ABuffer, ATypeInfo, True);
@ -576,10 +595,26 @@ begin
tkArray : result.FData.FValueData := TValueDataIntImpl.CreateCopy(ABuffer, Result.TypeData^.ArrayData.Size, ATypeInfo, False);
tkObject,
tkRecord : result.FData.FValueData := TValueDataIntImpl.CreateCopy(ABuffer, Result.TypeData^.RecSize, ATypeInfo, False);
tkInterface: result.FData.FValueData := TValueDataIntImpl.CreateRef(ABuffer, ATypeInfo, True);
end;
if not Assigned(ABuffer) then
Exit;
{ now handle those that are happy with the variant part of FData }
case ATypeInfo^.Kind of
tkSString,
tkWString,
tkUString,
tkAString,
tkDynArray,
tkArray,
tkObject,
tkRecord,
tkInterface:
{ ignore }
;
tkClass : result.FData.FAsObject := PPointer(ABuffer)^;
tkClassRef : result.FData.FAsClass := PClass(ABuffer)^;
tkInterfaceRaw : result.FData.FAsPointer := PPointer(ABuffer)^;
tkInterface: result.FData.FValueData := TValueDataIntImpl.CreateRef(ABuffer, ATypeInfo, True);
tkInt64 : result.FData.FAsSInt64 := PInt64(ABuffer)^;
tkQWord : result.FData.FAsUInt64 := PQWord(ABuffer)^;
tkProcVar : result.FData.FAsMethod.Code := PCodePointer(ABuffer)^;