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

+ add TValue.GetArrayLength, TValue.GetArrayElement and TValue.SetArrayElement

Browse Source 
git-svn-id: trunk@36970 -
This commit is contained in:
svenbarth 2017-08-20 18:28:38 +00:00
parent 9c0423b3a4
commit b6fa83fe92
1 changed files with 65 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -87,6 +87,9 @@ type
function AsInteger: Integer;
function AsInterface: IInterface;
function ToString: String;
function GetArrayLength: SizeInt;
function GetArrayElement(AIndex: SizeInt): TValue;
procedure SetArrayElement(AIndex: SizeInt; constref AValue: TValue);
function IsType(ATypeInfo: PTypeInfo): boolean; inline;
function TryAsOrdinal(out AResult: int64): boolean;
function GetReferenceToRawData: Pointer;
@ -442,6 +445,8 @@ procedure IntFinalize(APointer, ATypeInfo: Pointer);
external name 'FPC_FINALIZE';
procedure IntAddRef(APointer, ATypeInfo: Pointer);
external name 'FPC_ADDREF';
function IntCopy(ASource, ADest, ATypeInfo: Pointer): SizeInt;
external name 'FPC_COPY';
constructor TValueDataIntImpl.CreateCopy(ACopyFromBuffer: Pointer; ALen: SizeInt; ATypeInfo: PTypeInfo; AAddRef: Boolean);
begin
@ -834,6 +839,66 @@ begin
end;
end;
function TValue.GetArrayLength: SizeInt;
begin
if not IsArray then
raise EInvalidCast.Create(SErrInvalidTypecast);
if Kind = tkDynArray then
Result := DynArraySize(PPointer(FData.FValueData.GetReferenceToRawData)^)
else
Result := TypeData^.ArrayData.ElCount;
end;
function TValue.GetArrayElement(AIndex: SizeInt): TValue;
var
data: Pointer;
eltype: PTypeInfo;
td: PTypeData;
begin
if not IsArray then
raise EInvalidCast.Create(SErrInvalidTypecast);
if Kind = tkDynArray then begin
data := DynArrayIndex(PPointer(FData.FValueData.GetReferenceToRawData)^, [AIndex], FData.FTypeInfo);
eltype := TypeData^.elType2;
end else begin
td := TypeData;
eltype := td^.ArrayData.ElType;
data := PByte(FData.FValueData.GetReferenceToRawData) + AIndex * (td^.ArrayData.Size div td^.ArrayData.ElCount);
end;
{ MakeWithoutCopy? }
Make(data, eltype, Result);
end;
procedure TValue.SetArrayElement(AIndex: SizeInt; constref AValue: TValue);
var
data: Pointer;
eltype: PTypeInfo;
td, tdv: PTypeData;
begin
if not IsArray then
raise EInvalidCast.Create(SErrInvalidTypecast);
if Kind = tkDynArray then begin
data := DynArrayIndex(PPointer(FData.FValueData.GetReferenceToRawData)^, [AIndex], FData.FTypeInfo);
eltype := TypeData^.elType2;
end else begin
td := TypeData;
eltype := td^.ArrayData.ElType;
data := PByte(FData.FValueData.GetReferenceToRawData) + AIndex * (td^.ArrayData.Size div td^.ArrayData.ElCount);
end;
{ maybe we'll later on allow some typecasts, but for now be restrictive }
if eltype^.Kind <> AValue.Kind then
raise EInvalidCast.Create(SErrInvalidTypecast);
td := GetTypeData(eltype);
tdv := AValue.TypeData;
if ((eltype^.Kind in [tkInteger, tkBool, tkEnumeration, tkSet]) and (td^.OrdType <> tdv^.OrdType)) or
((eltype^.Kind = tkFloat) and (td^.FloatType <> tdv^.FloatType)) then
raise EInvalidCast.Create(SErrInvalidTypecast);
if Assigned(AValue.FData.FValueData) and (eltype^.Kind <> tkSString) then
IntCopy(AValue.FData.FValueData.GetReferenceToRawData, data, eltype)
else
Move(AValue.GetReferenceToRawData^, data^, AValue.DataSize);
end;
function TValue.IsType(ATypeInfo: PTypeInfo): boolean;
begin
result := ATypeInfo = TypeInfo;