+ add Rtti types for static and dynamic arrays

+ added tests
This commit is contained in:
Sven/Sarah Barth 2021-12-24 13:59:58 +01:00
parent f1059679a1
commit caaed25f18
2 changed files with 176 additions and 0 deletions

View File

@ -312,6 +312,32 @@ type
property ReferredType: TRttiType read GetReferredType;
end;
TRttiArrayType = class(TRttiType)
private
function GetDimensionCount: SizeUInt; inline;
function GetDimension(aIndex: SizeInt): TRttiType; inline;
function GetElementType: TRttiType; inline;
function GetTotalElementCount: SizeInt; inline;
public
property DimensionCount: SizeUInt read GetDimensionCount;
property Dimensions[Index: SizeInt]: TRttiType read GetDimension;
property ElementType: TRttiType read GetElementType;
property TotalElementCount: SizeInt read GetTotalElementCount;
end;
TRttiDynamicArrayType = class(TRttiType)
private
function GetDeclaringUnitName: String; inline;
function GetElementSize: SizeUInt; inline;
function GetElementType: TRttiType; inline;
function GetOleAutoVarType: TVarType; inline;
public
property DeclaringUnitName: String read GetDeclaringUnitName;
property ElementSize: SizeUInt read GetElementSize;
property ElementType: TRttiType read GetElementType;
property OleAutoVarType: TVarType read GetOleAutoVarType;
end;
{ TRttiMember }
TMemberVisibility=(mvPrivate, mvProtected, mvPublic, mvPublished);
@ -1274,6 +1300,8 @@ begin
tkClass : Result := TRttiInstanceType.Create(ATypeInfo);
tkInterface: Result := TRttiRefCountedInterfaceType.Create(ATypeInfo);
tkInterfaceRaw: Result := TRttiRawInterfaceType.Create(ATypeInfo);
tkArray: Result := TRttiArrayType.Create(ATypeInfo);
tkDynArray: Result := TRttiDynamicArrayType.Create(ATypeInfo);
tkInt64,
tkQWord: Result := TRttiInt64Type.Create(ATypeInfo);
tkInteger,
@ -2590,6 +2618,52 @@ begin
Result := GRttiPool.GetType(FTypeData^.RefType);
end;
{ TRttiArrayType }
function TRttiArrayType.GetDimensionCount: SizeUInt;
begin
Result := FTypeData^.ArrayData.DimCount;
end;
function TRttiArrayType.GetDimension(aIndex: SizeInt): TRttiType;
begin
if aIndex >= FTypeData^.ArrayData.DimCount then
raise ERtti.CreateFmt(SErrDimensionOutOfRange, [aIndex, FTypeData^.ArrayData.DimCount]);
Result := GRttiPool.GetType(FTypeData^.ArrayData.Dims[Byte(aIndex)]);
end;
function TRttiArrayType.GetElementType: TRttiType;
begin
Result := GRttiPool.GetType(FTypeData^.ArrayData.ElType);
end;
function TRttiArrayType.GetTotalElementCount: SizeInt;
begin
Result := FTypeData^.ArrayData.ElCount;
end;
{ TRttiDynamicArrayType }
function TRttiDynamicArrayType.GetDeclaringUnitName: String;
begin
Result := FTypeData^.DynUnitName;
end;
function TRttiDynamicArrayType.GetElementSize: SizeUInt;
begin
Result := FTypeData^.elSize;
end;
function TRttiDynamicArrayType.GetElementType: TRttiType;
begin
Result := GRttiPool.GetType(FTypeData^.ElType2);
end;
function TRttiDynamicArrayType.GetOleAutoVarType: TVarType;
begin
Result := Word(FTypeData^.varType);
end;
{ TRttiRefCountedInterfaceType }
function TRttiRefCountedInterfaceType.IntfData: PInterfaceData;

View File

@ -105,6 +105,9 @@ type
procedure TestInterfaceRaw;
{$endif}
procedure TestArray;
procedure TestDynArray;
procedure TestProcVar;
procedure TestMethod;
@ -246,6 +249,7 @@ type
TArrayOfLongintDyn = array of LongInt;
TArrayOfLongintStatic = array[0..3] of LongInt;
TArrayOfLongint2DStatic = array[0..3, 2..4] of LongInt;
TTestRecord = record
Value1: LongInt;
@ -2675,6 +2679,104 @@ begin
end;
{$endif}
procedure TTestCase1.TestArray;
var
context: TRttiContext;
t, el: TRttiType;
a: TRttiArrayType;
o: TRttiOrdinalType;
begin
context := TRttiContext.Create;
try
t := context.GetType(PTypeInfo(TypeInfo(TArrayOfLongintStatic)));
Check(t is TRttiArrayType, 'Type is not a TRttiArrayType');
a := TRttiArrayType(t);
CheckEquals(1, a.DimensionCount, 'Dimension count does not match');
CheckEquals(4, a.TotalElementCount, 'Total element count does not match');
el := a.ElementType;
Check(el is TRttiOrdinalType, 'Element type is not a TRttiOrdinalType');
Check(el = context.GetType(PTypeInfo(TypeInfo(LongInt))), 'Element type is not a LongInt');
t := a.Dimensions[0];
{$ifdef fpc}
Check(t is TRttiOrdinalType, 'Index type is not a TRttiOrdinalType');
o := TRttiOrdinalType(t);
{ Currently this is a full type :/ }
{CheckEquals(0, o.MinValue, 'Minimum value of 1st dimension does not match');
CheckEquals(3, o.MaxValue, 'Maximum value of 1st dimension does not match');}
{$else}
Check(t = Nil, 'Index type is not Nil');
{$endif}
t := context.GetType(PTypeInfo(TypeInfo(TArrayOfLongint2DStatic)));
Check(t is TRttiArrayType, 'Type is not a TRttiArrayType');
a := TRttiArrayType(t);
CheckEquals(2, a.DimensionCount, 'Dimension count does not match');
CheckEquals(4 * 3, a.TotalElementCount, 'Total element count does not match');
el := a.ElementType;
Check(el is TRttiOrdinalType, 'Element type is not a TRttiOrdinalType');
Check(el = context.GetType(PTypeInfo(TypeInfo(LongInt))), 'Element type is not a LongInt');
t := a.Dimensions[0];
{$ifdef fpc}
Check(t is TRttiOrdinalType, 'Index type is not a TRttiOrdinalType');
o := TRttiOrdinalType(t);
{ Currently this is a full type :/ }
{CheckEquals(0, o.MinValue, 'Minimum value of 1st dimension does not match');
CheckEquals(3, o.MaxValue, 'Maximum value of 1st dimension does not match');}
{$else}
Check(t = Nil, 'Index type is not Nil');
{$endif}
t := a.Dimensions[1];
{$ifdef fpc}
Check(t is TRttiOrdinalType, 'Index type is not a TRttiOrdinalType');
o := TRttiOrdinalType(t);
{ Currently this is a full type :/ }
{CheckEquals(2, o.MinValue, 'Minimum value of 1st dimension does not match');
CheckEquals(4, o.MaxValue, 'Maximum value of 1st dimension does not match');}
{$else}
Check(t = Nil, 'Index type is not Nil');
{$endif}
finally
context.Free;
end;
end;
procedure TTestCase1.TestDynArray;
var
context: TRttiContext;
t, el: TRttiType;
a: TRttiDynamicArrayType;
begin
context := TRttiContext.Create;
try
t := context.GetType(PTypeInfo(TypeInfo(TArrayOfLongintDyn)));
Check(t is TRttiDynamicArrayType, 'Type is not a TRttiDynamicArrayType');
a := TRttiDynamicArrayType(t);
CheckEquals('tests.rtti', LowerCase(a.DeclaringUnitName), 'Unit type does not match for dynamic array');
CheckEquals(a.ElementSize, SizeUInt(SizeOf(LongInt)), 'Element size does not match for dynamic array');
el := a.ElementType;
Check(el is TRttiOrdinalType, 'Element type is not a TRttiOrdinalType');
Check(el = context.GetType(PTypeInfo(TypeInfo(LongInt))), 'Element type is not a LongInt');
{ ToDo: check OLE type }
finally
context.Free;
end;
end;
procedure TTestCase1.TestProcVar;
var
context: TRttiContext;