paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-13 00:09:32 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ add a generic variant of TValue.IsType

Browse Source 
* extended test

git-svn-id: trunk@43591 -
This commit is contained in:
svenbarth 2019-11-25 21:13:37 +00:00
parent fb4b1cbf35
commit d98e551882
2 changed files with 39 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
packages/rtl-objpas/src/inc/rtti.pp
View File

@ -144,6 +144,9 @@ type
function GetArrayElement(AIndex: SizeInt): TValue;
procedure SetArrayElement(AIndex: SizeInt; constref AValue: TValue);
function IsType(ATypeInfo: PTypeInfo): boolean; inline;
{$ifndef NoGenericMethods}
generic function IsType<T>: Boolean; inline;
{$endif}
function TryAsOrdinal(out AResult: int64): boolean;
function GetReferenceToRawData: Pointer;
procedure ExtractRawData(ABuffer: Pointer);
@ -1856,6 +1859,13 @@ begin
result := ATypeInfo = TypeInfo;
end;
{$ifndef NoGenericMethods}
generic function TValue.IsType<T>: Boolean;
begin
Result := IsType(PTypeInfo(System.TypeInfo(T)));
end;
{$endif}
function TValue.AsObject: TObject;
begin
if IsObject or (IsClass and not Assigned(FData.FAsObject)) then

29
packages/rtl-objpas/tests/tests.rtti.pas
View File

@ -48,6 +48,8 @@ type
procedure TestGetIsReadable;
procedure TestIsWritable;
procedure TestIsType;
procedure TestMakeNil;
procedure TestMakeObject;
procedure TestMakeArrayDynamic;
@ -839,6 +841,33 @@ begin
end;
end;
procedure TTestCase1.TestIsType;
type
TMyLongInt = type LongInt;
var
v: TValue;
l: LongInt;
ml: TMyLongInt;
begin
l := 42;
ml := 42;
TValue.Make(@l, TypeInfo(l), v);
Check(v.IsType(TypeInfo(l)));
Check(not v.IsType(TypeInfo(ml)));
Check(not v.IsType(TypeInfo(String)));
Check(v.specialize IsType<LongInt>);
Check(not v.specialize IsType<TMyLongInt>);
Check(not v.specialize IsType<String>);
TValue.Make(@ml, TypeInfo(ml), v);
Check(v.IsType(TypeInfo(ml)));
Check(not v.IsType(TypeInfo(l)));
Check(not v.IsType(TypeInfo(String)));
Check(v.specialize IsType<TMyLongInt>);
Check(not v.specialize IsType<LongInt>);
Check(not v.specialize IsType<String>);
end;
procedure TTestCase1.TestPropGetValueBoolean;
var
ATestClass : TTestValueClass;