From d98e5518820785693b02d8094a0745ab48407f59 Mon Sep 17 00:00:00 2001
From: svenbarth <pascaldragon@googlemail.com>
Date: Mon, 25 Nov 2019 21:13:37 +0000
Subject: [PATCH] + add a generic variant of TValue.IsType * extended test
git-svn-id: trunk@43591 -
---
packages/rtl-objpas/src/inc/rtti.pp | 10 ++++++++
packages/rtl-objpas/tests/tests.rtti.pas | 29 ++++++++++++++++++++++++
2 files changed, 39 insertions(+)
diff --git a/packages/rtl-objpas/src/inc/rtti.pp b/packages/rtl-objpas/src/inc/rtti.pp
index 9572060fd7..f3b0c78c00 100644
--- a/packages/rtl-objpas/src/inc/rtti.pp
+++ b/packages/rtl-objpas/src/inc/rtti.pp
@@ -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
diff --git a/packages/rtl-objpas/tests/tests.rtti.pas b/packages/rtl-objpas/tests/tests.rtti.pas
index 2993eb7ac3..30f6081627 100644
--- a/packages/rtl-objpas/tests/tests.rtti.pas
+++ b/packages/rtl-objpas/tests/tests.rtti.pas
@@ -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;