2
0
Эх сурвалжийг харах

* test for variant TValue

Michaël Van Canneyt 2 жил өмнө
parent
commit
336b362204

+ 25 - 0
packages/rtl-objpas/tests/tests.value.pas

@@ -19,6 +19,8 @@ Type
     procedure TestIsManaged;
   end;
 
+  { TTestValueSimple }
+
   TTestValueSimple = Class(TTestCase)
   private
     procedure MakeFromOrdinalTObject;
@@ -40,6 +42,7 @@ Type
     procedure TestMakeWideChar;
 
     procedure TestMakeNativeInt;
+    procedure TestMakeVariant;
 
 
     procedure TestMakeGenericNil;
@@ -1251,6 +1254,28 @@ begin
   o.Free;
 end;
 
+procedure TTestValueSimple.TestMakeVariant;
+var
+  vv : Variant;
+  vd : TVarData;
+  v: TValue;
+begin
+  vv := 'Some String';
+
+  TValue.Make(@vv, TypeInfo(Variant), v);
+  Check(not v.IsClass);
+  Check(not v.IsArray);
+  Check(not v.IsEmpty);
+{$ifdef fpc}
+  Check(not v.IsOpenArray);
+{$endif}
+  Check(not v.IsObject);
+  Check(not v.IsOrdinal);
+
+  Check(v.GetReferenceToRawData <> @vv);
+  Check(String(v.AsVariant) = 'Some String');
+end;
+
 procedure TTestValueArray.TestMakeFromArray;
 var
   arr, subarr: array of TValue;