Quellcode durchsuchen

+ add TValue.FromArray to create a TValue type for a static or dynamic array from an array of TValues
+ added test

Sven/Sarah Barth vor 3 Jahren
Ursprung
Commit
bf37616514
2 geänderte Dateien mit 77 neuen und 0 gelöschten Zeilen
  1. 27 0
      packages/rtl-objpas/src/inc/rtti.pp
  2. 50 0
      packages/rtl-objpas/tests/tests.rtti.pas

+ 27 - 0
packages/rtl-objpas/src/inc/rtti.pp

@@ -124,6 +124,7 @@ type
     generic class function FromOpenArray<T>(constref aValue: array of T): TValue; static; inline;
 {$endif}
     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 IsOpenArray: Boolean; inline;
     function AsString: string; inline;
@@ -800,6 +801,8 @@ type
 resourcestring
   SErrUnableToGetValueForType = 'Unable to get 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';
   SErrRttiObjectNoHandle      = 'RTTI object instance has no valid handle property';
   SErrRttiObjectAlreadyRegistered = 'A RTTI object with handle 0x%x is already registered';
@@ -1841,6 +1844,30 @@ begin
 {$endif}
 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;
 begin
   result := (FData.FTypeInfo=nil) or

+ 50 - 0
packages/rtl-objpas/tests/tests.rtti.pas

@@ -80,6 +80,8 @@ type
 
     procedure TestMakeNativeInt;
 
+    procedure TestMakeFromArray;
+
     procedure TestMakeGenericNil;
     procedure TestMakeGenericLongInt;
     procedure TestMakeGenericString;
@@ -842,6 +844,54 @@ begin
   o.Free;
 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;
 var
   value: TValue;