mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-30 11:20:23 +02:00
+ add TValue.FromArray to create a TValue type for a static or dynamic array from an array of TValues
+ added test
This commit is contained in:
parent
caaed25f18
commit
bf37616514
@ -124,6 +124,7 @@ type
|
|||||||
generic class function FromOpenArray<T>(constref aValue: array of T): TValue; static; inline;
|
generic class function FromOpenArray<T>(constref aValue: array of T): TValue; static; inline;
|
||||||
{$endif}
|
{$endif}
|
||||||
class function FromOrdinal(aTypeInfo: PTypeInfo; aValue: Int64): TValue; static; {inline;}
|
class function FromOrdinal(aTypeInfo: PTypeInfo; aValue: Int64): TValue; static; {inline;}
|
||||||
|
class function FromArray(aArrayTypeInfo: PTypeInfo; const aValues: array of TValue): TValue; static;
|
||||||
function IsArray: boolean; inline;
|
function IsArray: boolean; inline;
|
||||||
function IsOpenArray: Boolean; inline;
|
function IsOpenArray: Boolean; inline;
|
||||||
function AsString: string; inline;
|
function AsString: string; inline;
|
||||||
@ -800,6 +801,8 @@ type
|
|||||||
resourcestring
|
resourcestring
|
||||||
SErrUnableToGetValueForType = 'Unable to get value for type %s';
|
SErrUnableToGetValueForType = 'Unable to get value for type %s';
|
||||||
SErrUnableToSetValueForType = 'Unable to set value for type %s';
|
SErrUnableToSetValueForType = 'Unable to set value for type %s';
|
||||||
|
SErrDimensionOutOfRange = 'Dimension index %d is out of range [0, %d[';
|
||||||
|
SErrLengthOfArrayMismatch = 'Length of static array does not match: Got %d, but expected %d';
|
||||||
SErrInvalidTypecast = 'Invalid class typecast';
|
SErrInvalidTypecast = 'Invalid class typecast';
|
||||||
SErrRttiObjectNoHandle = 'RTTI object instance has no valid handle property';
|
SErrRttiObjectNoHandle = 'RTTI object instance has no valid handle property';
|
||||||
SErrRttiObjectAlreadyRegistered = 'A RTTI object with handle 0x%x is already registered';
|
SErrRttiObjectAlreadyRegistered = 'A RTTI object with handle 0x%x is already registered';
|
||||||
@ -1841,6 +1844,30 @@ begin
|
|||||||
{$endif}
|
{$endif}
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
class function TValue.FromArray(aArrayTypeInfo: PTypeInfo; const aValues: array of TValue): TValue; static;
|
||||||
|
var
|
||||||
|
i, sz: SizeInt;
|
||||||
|
data: TValueDataIntImpl;
|
||||||
|
begin
|
||||||
|
Result.Init;
|
||||||
|
Result.FData.FTypeInfo := aArrayTypeInfo;
|
||||||
|
if not Assigned(aArrayTypeInfo) then
|
||||||
|
Exit;
|
||||||
|
if aArrayTypeInfo^.Kind = tkDynArray then begin
|
||||||
|
data := TValueDataIntImpl.CreateRef(Nil, aArrayTypeInfo, True);
|
||||||
|
sz := Length(aValues);
|
||||||
|
DynArraySetLength(data.FBuffer, aArrayTypeInfo, 1, @sz);
|
||||||
|
Result.FData.FValueData := data;
|
||||||
|
end else if aArrayTypeInfo^.Kind = tkArray then begin
|
||||||
|
if Result.GetArrayLength <> Length(aValues) then
|
||||||
|
raise ERtti.CreateFmt(SErrLengthOfArrayMismatch, [Length(aValues), Result.GetArrayLength]);
|
||||||
|
Result.FData.FValueData := TValueDataIntImpl.CreateCopy(Nil, Result.TypeData^.ArrayData.Size, aArrayTypeInfo, False);
|
||||||
|
end else
|
||||||
|
raise ERtti.CreateFmt(SErrTypeKindNotSupported, [aArrayTypeInfo^.Name]);
|
||||||
|
for i := 0 to High(aValues) do
|
||||||
|
Result.SetArrayElement(i, aValues[i]);
|
||||||
|
end;
|
||||||
|
|
||||||
function TValue.GetIsEmpty: boolean;
|
function TValue.GetIsEmpty: boolean;
|
||||||
begin
|
begin
|
||||||
result := (FData.FTypeInfo=nil) or
|
result := (FData.FTypeInfo=nil) or
|
||||||
|
@ -80,6 +80,8 @@ type
|
|||||||
|
|
||||||
procedure TestMakeNativeInt;
|
procedure TestMakeNativeInt;
|
||||||
|
|
||||||
|
procedure TestMakeFromArray;
|
||||||
|
|
||||||
procedure TestMakeGenericNil;
|
procedure TestMakeGenericNil;
|
||||||
procedure TestMakeGenericLongInt;
|
procedure TestMakeGenericLongInt;
|
||||||
procedure TestMakeGenericString;
|
procedure TestMakeGenericString;
|
||||||
@ -842,6 +844,54 @@ begin
|
|||||||
o.Free;
|
o.Free;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure TTestCase1.TestMakeFromArray;
|
||||||
|
var
|
||||||
|
arr, subarr: array of TValue;
|
||||||
|
v, varr: TValue;
|
||||||
|
ti: PTypeInfo;
|
||||||
|
i: LongInt;
|
||||||
|
begin
|
||||||
|
SetLength(arr, 3 * 4);
|
||||||
|
for i := 0 to High(arr) do
|
||||||
|
TValue.{$ifdef fpc}specialize{$endif} Make<LongInt>(i + 1, arr[i]);
|
||||||
|
|
||||||
|
ti := PTypeInfo(TypeInfo(LongInt));
|
||||||
|
|
||||||
|
v := TValue.FromArray(TypeInfo(TArrayOfLongintDyn), arr);
|
||||||
|
Check(not v.IsEmpty, 'Array is empty');
|
||||||
|
Check(v.IsArray, 'Value is not an array');
|
||||||
|
CheckEquals(Length(arr), v.GetArrayLength, 'Array length does not match');
|
||||||
|
for i := 0 to High(arr) do begin
|
||||||
|
varr := v.GetArrayElement(i);
|
||||||
|
Check(varr.TypeInfo = ti, 'Type info of array element does not match');
|
||||||
|
Check(varr.IsOrdinal, 'Array element is not an ordinal');
|
||||||
|
Check(varr.AsInteger = arr[i].AsInteger, 'Value of array element does not match');
|
||||||
|
end;
|
||||||
|
|
||||||
|
subarr := Copy(arr, 0, 4);
|
||||||
|
v := TValue.FromArray(TypeInfo(TArrayOfLongintStatic), subarr);
|
||||||
|
Check(not v.IsEmpty, 'Array is empty');
|
||||||
|
Check(v.IsArray, 'Value is not an array');
|
||||||
|
CheckEquals(Length(subarr), v.GetArrayLength, 'Array length does not match');
|
||||||
|
for i := 0 to High(subarr) do begin
|
||||||
|
varr := v.GetArrayElement(i);
|
||||||
|
Check(varr.TypeInfo = ti, 'Type info of array element does not match');
|
||||||
|
Check(varr.IsOrdinal, 'Array element is not an ordinal');
|
||||||
|
Check(varr.AsInteger = subarr[i].AsInteger, 'Value of array element does not match');
|
||||||
|
end;
|
||||||
|
|
||||||
|
v := TValue.FromArray(TypeInfo(TArrayOfLongint2DStatic), arr);
|
||||||
|
Check(not v.IsEmpty, 'Array is empty');
|
||||||
|
Check(v.IsArray, 'Value is not an array');
|
||||||
|
CheckEquals(Length(arr), v.GetArrayLength, 'Array length does not match');
|
||||||
|
for i := 0 to High(arr) do begin
|
||||||
|
varr := v.GetArrayElement(i);
|
||||||
|
Check(varr.TypeInfo = ti, 'Type info of array element does not match');
|
||||||
|
Check(varr.IsOrdinal, 'Array element is not an ordinal');
|
||||||
|
Check(varr.AsInteger = arr[i].AsInteger, 'Value of array element does not match');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
procedure TTestCase1.TestMakeGenericNil;
|
procedure TTestCase1.TestMakeGenericNil;
|
||||||
var
|
var
|
||||||
value: TValue;
|
value: TValue;
|
||||||
|
Loading…
Reference in New Issue
Block a user