mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-18 21:49:15 +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;
|
property ReferredType: TRttiType read GetReferredType;
|
||||||
end;
|
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 }
|
{ TRttiMember }
|
||||||
|
|
||||||
TMemberVisibility=(mvPrivate, mvProtected, mvPublic, mvPublished);
|
TMemberVisibility=(mvPrivate, mvProtected, mvPublic, mvPublished);
|
||||||
@ -1274,6 +1300,8 @@ begin
|
|||||||
tkClass : Result := TRttiInstanceType.Create(ATypeInfo);
|
tkClass : Result := TRttiInstanceType.Create(ATypeInfo);
|
||||||
tkInterface: Result := TRttiRefCountedInterfaceType.Create(ATypeInfo);
|
tkInterface: Result := TRttiRefCountedInterfaceType.Create(ATypeInfo);
|
||||||
tkInterfaceRaw: Result := TRttiRawInterfaceType.Create(ATypeInfo);
|
tkInterfaceRaw: Result := TRttiRawInterfaceType.Create(ATypeInfo);
|
||||||
|
tkArray: Result := TRttiArrayType.Create(ATypeInfo);
|
||||||
|
tkDynArray: Result := TRttiDynamicArrayType.Create(ATypeInfo);
|
||||||
tkInt64,
|
tkInt64,
|
||||||
tkQWord: Result := TRttiInt64Type.Create(ATypeInfo);
|
tkQWord: Result := TRttiInt64Type.Create(ATypeInfo);
|
||||||
tkInteger,
|
tkInteger,
|
||||||
@ -2590,6 +2618,52 @@ begin
|
|||||||
Result := GRttiPool.GetType(FTypeData^.RefType);
|
Result := GRttiPool.GetType(FTypeData^.RefType);
|
||||||
end;
|
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 }
|
{ TRttiRefCountedInterfaceType }
|
||||||
|
|
||||||
function TRttiRefCountedInterfaceType.IntfData: PInterfaceData;
|
function TRttiRefCountedInterfaceType.IntfData: PInterfaceData;
|
||||||
|
@ -105,6 +105,9 @@ type
|
|||||||
procedure TestInterfaceRaw;
|
procedure TestInterfaceRaw;
|
||||||
{$endif}
|
{$endif}
|
||||||
|
|
||||||
|
procedure TestArray;
|
||||||
|
procedure TestDynArray;
|
||||||
|
|
||||||
procedure TestProcVar;
|
procedure TestProcVar;
|
||||||
procedure TestMethod;
|
procedure TestMethod;
|
||||||
|
|
||||||
@ -246,6 +249,7 @@ type
|
|||||||
|
|
||||||
TArrayOfLongintDyn = array of LongInt;
|
TArrayOfLongintDyn = array of LongInt;
|
||||||
TArrayOfLongintStatic = array[0..3] of LongInt;
|
TArrayOfLongintStatic = array[0..3] of LongInt;
|
||||||
|
TArrayOfLongint2DStatic = array[0..3, 2..4] of LongInt;
|
||||||
|
|
||||||
TTestRecord = record
|
TTestRecord = record
|
||||||
Value1: LongInt;
|
Value1: LongInt;
|
||||||
@ -2675,6 +2679,104 @@ begin
|
|||||||
end;
|
end;
|
||||||
{$endif}
|
{$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;
|
procedure TTestCase1.TestProcVar;
|
||||||
var
|
var
|
||||||
context: TRttiContext;
|
context: TRttiContext;
|
||||||
|
Loading…
Reference in New Issue
Block a user