mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-19 23:19:24 +02:00
+ add Rtti types for static and dynamic arrays
+ added tests
This commit is contained in:
parent
f1059679a1
commit
caaed25f18
@ -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;
|
||||
|
@ -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;
|
||||
|
Loading…
Reference in New Issue
Block a user