tests.rtti.value.pas 63 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151
  1. unit tests.rtti.value;
  2. {$mode ObjFPC}{$H+}
  3. interface
  4. uses
  5. fpcunit,testregistry, testutils, typinfo,
  6. Classes, SysUtils, Rtti;
  7. Type
  8. TTestValueGeneral = Class(TTestCase)
  9. Published
  10. procedure TestDataSize;
  11. procedure TestDataSizeEmpty;
  12. procedure TestReferenceRawData;
  13. procedure TestReferenceRawDataEmpty;
  14. procedure TestIsManaged;
  15. procedure TestCasts;
  16. procedure TestAssignPointer;
  17. procedure TestAssignDateTime;
  18. procedure TestAssignDate;
  19. procedure TestAssignTime;
  20. end;
  21. TTestValueSimple = Class(TTestCase)
  22. private
  23. procedure MakeFromOrdinalTObject;
  24. procedure MakeFromOrdinalSet;
  25. procedure MakeFromOrdinalString;
  26. procedure MakeFromOrdinalNil;
  27. Published
  28. // Moved here from Tests.rtti
  29. procedure TestIsType;
  30. procedure TestMakeNil;
  31. procedure TestMakeObject;
  32. procedure TestMakeSingle;
  33. procedure TestMakeDouble;
  34. procedure TestMakeExtended;
  35. procedure TestMakeCurrency;
  36. procedure TestMakeComp;
  37. procedure TestMakeEnum;
  38. procedure TestMakeAnsiChar;
  39. procedure TestMakeWideChar;
  40. procedure TestMakeNativeInt;
  41. procedure TestMakeVariant;
  42. procedure TestMakeGenericNil;
  43. procedure TestMakeGenericLongInt;
  44. procedure TestMakeGenericString;
  45. procedure TestMakeGenericObject;
  46. procedure TestMakeGenericDouble;
  47. procedure TestMakeGenericAnsiChar;
  48. procedure TestMakeGenericWideChar;
  49. procedure TestFromOrdinal;
  50. Procedure TestTryCastUnicodeString;
  51. procedure TestMakeManagedRecord;
  52. procedure TestMakeStaticArrayOfManagedRecord;
  53. end;
  54. { TTestValueArray }
  55. TTestValueArray = class(TTestCase)
  56. Published
  57. procedure TestMakeArrayDynamic;
  58. procedure TestMakeArrayStatic;
  59. procedure TestMakeFromArray;
  60. {$ifdef fpc}
  61. procedure TestMakeArrayOpen;
  62. Procedure TestOpenArrayToDyn;
  63. {$ENDIF}
  64. end;
  65. { TTestValueVariant }
  66. TTestValueVariant = class(TTestCase)
  67. private
  68. FSrc: Variant;
  69. FValue: TValue;
  70. FVarRec: TVarRec;
  71. Public
  72. Procedure Setup; override;
  73. Procedure TearDown; override;
  74. Procedure DoFromVariant;
  75. Procedure DoFromVarRec;
  76. Property Value : TValue Read FValue;
  77. Property Src : Variant Read FSrc;
  78. Property VarRec : TVarRec Read FVarRec;
  79. Published
  80. Procedure TestFromVariantInteger;
  81. Procedure TestFromVariantBoolean;
  82. Procedure TestFromVariantSmallInt;
  83. Procedure TestFromVariantOleStr;
  84. Procedure TestFromVariantInt64;
  85. Procedure TestFromVariantQWord;
  86. Procedure TestFromVariantShortInt;
  87. Procedure TestFromVariantByte;
  88. Procedure TestFromVariantWord;
  89. Procedure TestFromVariantLongWord;
  90. Procedure TestFromVariantSingle;
  91. Procedure TestFromVariantDouble;
  92. Procedure TestFromVariantDate;
  93. Procedure TestFromVariantDispatch;
  94. Procedure TestFromVariantError;
  95. Procedure TestFromVariantUnknown;
  96. Procedure TestFromVariantCurrency;
  97. Procedure TestFromVariantString;
  98. Procedure TestFromVariantUnicodeString;
  99. Procedure TestFromVarrecInteger;
  100. Procedure TestFromVarrecBoolean;
  101. Procedure TestFromVarRecChar;
  102. Procedure TestFromVarRecExtended;
  103. Procedure TestFromVarRecString;
  104. Procedure TestFromVarRecPointer;
  105. Procedure TestFromVarRecPChar;
  106. Procedure TestFromVarRecObject;
  107. Procedure TestFromVarRecClass;
  108. Procedure TestFromVarRecWideChar;
  109. Procedure TestFromVarRecPWideChar;
  110. Procedure TestFromVarRecAnsiString;
  111. Procedure TestFromVarRecCurrency;
  112. Procedure TestFromVarRecVariant;
  113. Procedure TestFromVarRecInterface;
  114. Procedure TestFromVarRecWideString;
  115. Procedure TestFromVarRecInt64;
  116. Procedure TestFromVarRecQWord;
  117. Procedure TestFromVarRecUnicodeString;
  118. Procedure TestArrayOfConstToTValue;
  119. procedure TestCastAnsiString;
  120. {$ifndef FPC_WIDESTRING_EQUAL_UNICODESTRING}
  121. procedure TestCastUnicodeString;
  122. {$endif}
  123. procedure TestCastWideString;
  124. procedure TestCastShortString;
  125. end;
  126. { TMyUNknown }
  127. TMyUNknown = Class(TInterfacedObject,IDispatch)
  128. function GetTypeInfoCount(out count : longint) : HResult;stdcall;
  129. function GetTypeInfo(Index,LocaleID : longint; out TypeInfo): HResult;stdcall;
  130. function GetIDsOfNames(const iid: TGUID; names: Pointer; NameCount, LocaleID: LongInt; DispIDs: Pointer) : HResult;stdcall;
  131. function Invoke(DispID: LongInt;const iid : TGUID; LocaleID : longint; Flags: Word;var params; VarResult,ExcepInfo,ArgErr : pointer) : HResult;stdcall;
  132. end;
  133. implementation
  134. uses tests.rtti.types, variants;
  135. { TTestValueVariant }
  136. procedure TTestValueVariant.Setup;
  137. begin
  138. inherited Setup;
  139. FValue:=Default(TValue);
  140. FSrc:=unassigned;
  141. end;
  142. procedure TTestValueVariant.TearDown;
  143. begin
  144. FValue:=Default(TValue);
  145. FSrc:=unassigned;
  146. inherited TearDown;
  147. end;
  148. procedure TTestValueVariant.DoFromVariant;
  149. begin
  150. FValue:=TValue.FromVariant(Src);
  151. end;
  152. procedure TTestValueVariant.DoFromVarRec;
  153. begin
  154. FValue:=TValue.FromVarRec(FVarRec);
  155. end;
  156. procedure TTestValueVariant.TestFromVarrecInteger;
  157. begin
  158. FVarrec.VType:=vtInteger;
  159. FVarrec.VInteger:=1;
  160. DoFromVarRec;
  161. CheckEquals(1,Value.AsInteger,'Value');
  162. CheckTrue(TypeInfo(Integer)=Value.TypeInfo,'Correct typeinfo');
  163. CheckEquals(Value.IsClass, False,'Class');
  164. CheckEquals(Value.IsObject, False,'Object');
  165. CheckEquals(Value.IsOrdinal, True,'Ordinal');
  166. end;
  167. procedure TTestValueVariant.TestFromVarrecBoolean;
  168. begin
  169. FVarrec.VType:=vtBoolean;
  170. FVarrec.VBoolean:=True;
  171. DoFromVarRec;
  172. CheckEquals(True,Value.AsBoolean,'Value');
  173. CheckTrue(TypeInfo(Boolean)=Value.TypeInfo,'Correct typeinfo');
  174. CheckEquals(Value.IsClass, False,'Class');
  175. CheckEquals(Value.IsObject, False,'Object');
  176. CheckEquals(Value.IsOrdinal, True,'Ordinal');
  177. end;
  178. procedure TTestValueVariant.TestFromVarRecChar;
  179. begin
  180. FVarrec.VType:=vtChar;
  181. FVarrec.VChar:='c';
  182. DoFromVarRec;
  183. CheckEquals('c',Value.AsAnsiChar,'Value');
  184. CheckTrue(TypeInfo(AnsiChar)=Value.TypeInfo,'Correct typeinfo');
  185. CheckEquals(Value.IsClass, False,'Class');
  186. CheckEquals(Value.IsObject, False,'Object');
  187. CheckEquals(Value.IsOrdinal, True,'Ordinal');
  188. end;
  189. procedure TTestValueVariant.TestFromVarRecExtended;
  190. var
  191. E : Extended;
  192. begin
  193. E:=1.23;
  194. FVarRec.VExtended:=@E;
  195. FVarRec.vType:=vtExtended;
  196. DoFromVarRec;
  197. CheckEquals(1.23,Value.AsExtended,0.01,'Value');
  198. CheckTrue(TypeInfo(Extended)=Value.TypeInfo,'Correct typeinfo');
  199. CheckEquals(Value.IsClass, False,'Class');
  200. CheckEquals(Value.IsObject, False,'Object');
  201. CheckEquals(Value.IsOrdinal, False,'Ordinal');
  202. end;
  203. procedure TTestValueVariant.TestFromVarRecString;
  204. Var
  205. s : ShortString;
  206. begin
  207. S:='123';
  208. FVarrec.VType:=vtString;
  209. FVarrec.VString:=@S;
  210. DoFromVarRec;
  211. CheckEquals('123',Value.AsString,'Value');
  212. CheckTrue(TypeInfo(ShortString)=Value.TypeInfo,'Correct typeinfo');
  213. CheckEquals(Value.IsClass, False,'Class');
  214. CheckEquals(Value.IsObject, False,'Object');
  215. CheckEquals(Value.IsOrdinal, False,'Ordinal');
  216. end;
  217. procedure TTestValueVariant.TestFromVarRecPointer;
  218. Var
  219. s : ShortString;
  220. begin
  221. S:='123';
  222. FVarrec.VType:=vtPointer;
  223. FVarrec.VString:=@S;
  224. DoFromVarRec;
  225. CheckTrue(@S=Value.AsPointer,'Value');
  226. CheckTrue(TypeInfo(Pointer)=Value.TypeInfo,'Correct typeinfo');
  227. CheckEquals(Value.IsClass, False,'Class');
  228. CheckEquals(Value.IsObject, False,'Object');
  229. CheckEquals(Value.IsOrdinal, False,'Ordinal');
  230. end;
  231. procedure TTestValueVariant.TestFromVarRecPChar;
  232. Var
  233. s : AnsiString;
  234. begin
  235. S:='123';
  236. FVarrec.VType:=vtPChar;
  237. FVarrec.VPChar:=PAnsiChar(S);
  238. DoFromVarRec;
  239. CheckTrue(S=Value.AsAnsiString,'Value');
  240. // In delphi it is String, but not widestring !
  241. CheckTrue(TypeInfo(AnsiString)=Value.TypeInfo,'Correct typeinfo');
  242. CheckEquals(Value.IsClass, False,'Class');
  243. CheckEquals(Value.IsObject, False,'Object');
  244. CheckEquals(Value.IsOrdinal, False,'Ordinal');
  245. end;
  246. procedure TTestValueVariant.TestFromVarRecObject;
  247. Var
  248. C : TObject;
  249. begin
  250. C:=TComponent.Create(Nil);
  251. FVarrec.VType:=vtObject;
  252. FVarrec.VObject:=C;
  253. DoFromVarRec;
  254. CheckSame(C,Value.AsObject,'Value');
  255. // In delphi it is String, but not widestring !
  256. CheckTrue(TypeInfo(TComponent)=Value.TypeInfo,'Correct typeinfo');
  257. CheckEquals(Value.IsClass, False,'Class');
  258. CheckEquals(Value.IsObject, True,'Object');
  259. CheckEquals(Value.IsOrdinal, False,'Ordinal');
  260. end;
  261. procedure TTestValueVariant.TestFromVarRecClass;
  262. Var
  263. C : TClass;
  264. begin
  265. C:=TComponent;
  266. FVarrec.VType:=vtClass;
  267. FVarrec.VClass:=C;
  268. DoFromVarRec;
  269. CheckEquals(C,Value.AsClass,'Value');
  270. // In delphi it is String, but not widestring !
  271. CheckTrue(TypeInfo(TClass)=Value.TypeInfo,'Correct typeinfo');
  272. CheckEquals(Value.IsClass, True,'Class');
  273. CheckEquals(Value.IsObject, False,'Object');
  274. CheckEquals(Value.IsOrdinal, False,'Ordinal');
  275. end;
  276. procedure TTestValueVariant.TestFromVarRecWideChar;
  277. begin
  278. FVarrec.VType:=vtWideChar;
  279. FVarrec.VWideChar:='c';
  280. DoFromVarRec;
  281. CheckEquals('c',Value.AsWideChar,'Value');
  282. CheckTrue(TypeInfo(WideChar)=Value.TypeInfo,'Correct typeinfo');
  283. CheckEquals(Value.IsClass, False,'Class');
  284. CheckEquals(Value.IsObject, False,'Object');
  285. CheckEquals(Value.IsOrdinal, True,'Ordinal');
  286. end;
  287. procedure TTestValueVariant.TestFromVarRecPWideChar;
  288. Var
  289. s : WideString;
  290. begin
  291. S:='123';
  292. FVarrec.VType:=vtPWideChar;
  293. FVarrec.VPWideChar:=PWideChar(S);
  294. DoFromVarRec;
  295. CheckEquals('123',Value.AsUnicodeString,'Value');
  296. CheckTrue(TypeInfo(WideString)=Value.TypeInfo,'Correct typeinfo');
  297. CheckEquals(Value.IsClass, False,'Class');
  298. CheckEquals(Value.IsObject, False,'Object');
  299. CheckEquals(Value.IsOrdinal, False,'Ordinal');
  300. end;
  301. procedure TTestValueVariant.TestFromVarRecAnsiString;
  302. Var
  303. s : AnsiString;
  304. begin
  305. S:='123';
  306. FVarrec.VType:=vtAnsiString;
  307. FVarrec.VAnsiString:=Pointer(S);
  308. DoFromVarRec;
  309. CheckEquals('123',Value.AsAnsiString,'Value');
  310. CheckTrue(TypeInfo(AnsiString)=Value.TypeInfo,'Correct typeinfo');
  311. CheckEquals(Value.IsClass, False,'Class');
  312. CheckEquals(Value.IsObject, False,'Object');
  313. CheckEquals(Value.IsOrdinal, False,'Ordinal');
  314. end;
  315. procedure TTestValueVariant.TestFromVarRecCurrency;
  316. var
  317. C : Currency;
  318. begin
  319. C:=1.23;
  320. FVarRec.VCurrency:=@C;
  321. FVarRec.vType:=vtCurrency;
  322. DoFromVarRec;
  323. CheckEquals(1.23,Value.AsCurrency,0.01,'Value');
  324. CheckTrue(TypeInfo(Currency)=Value.TypeInfo,'Correct typeinfo');
  325. CheckEquals(Value.IsClass, False,'Class');
  326. CheckEquals(Value.IsObject, False,'Object');
  327. CheckEquals(Value.IsOrdinal, False,'Ordinal');
  328. end;
  329. procedure TTestValueVariant.TestFromVarRecVariant;
  330. var
  331. V : Variant;
  332. begin
  333. V:='1.23';
  334. FVarRec.VVariant:=@V;
  335. FVarRec.vType:=vtVariant;
  336. DoFromVarRec;
  337. CheckEquals(V,String(Value.AsVariant),'Value');
  338. CheckTrue(TypeInfo(Variant)=Value.TypeInfo,'Correct typeinfo');
  339. CheckEquals(Value.IsClass, False,'Class');
  340. CheckEquals(Value.IsObject, False,'Object');
  341. CheckEquals(Value.IsOrdinal, False,'Ordinal');
  342. end;
  343. procedure TTestValueVariant.TestFromVarRecInterface;
  344. Var
  345. U : IInterface;
  346. begin
  347. U:=TMyUNknown.Create;
  348. FVarRec.VInterface:=U;
  349. FVarRec.VType:=vtInterface;
  350. DoFromVarRec;
  351. CheckTrue(U=Value.AsInterface,'Value');
  352. CheckTrue(TypeInfo(IInterface)=Value.TypeInfo,'Correct typeinfo');
  353. CheckEquals(Value.IsClass, False,'Class');
  354. CheckEquals(Value.IsObject, False,'Object');
  355. CheckEquals(Value.IsOrdinal, False,'Ordinal');
  356. end;
  357. procedure TTestValueVariant.TestFromVarRecWideString;
  358. Var
  359. s : WideString;
  360. begin
  361. S:='123';
  362. FVarrec.VType:=vtWideString;
  363. FVarrec.VWideString:=Pointer(S);
  364. DoFromVarRec;
  365. CheckEquals('123',Value.AsUnicodeString,'Value');
  366. CheckTrue(TypeInfo(WideString)=Value.TypeInfo,'Correct typeinfo');
  367. CheckEquals(Value.IsClass, False,'Class');
  368. CheckEquals(Value.IsObject, False,'Object');
  369. CheckEquals(Value.IsOrdinal, False,'Ordinal');
  370. end;
  371. procedure TTestValueVariant.TestFromVarRecInt64;
  372. Var
  373. I : Int64;
  374. begin
  375. I:=Int64(1);
  376. FVarRec.VInt64:=@I;
  377. FVarRec.vType:=vtInt64;
  378. DoFromVarRec;
  379. CheckEquals(1,Value.AsInt64,'Value');
  380. CheckTrue(TypeInfo(Int64)=Value.TypeInfo,'Correct typeinfo');
  381. CheckEquals(Value.IsClass, False,'Class');
  382. CheckEquals(Value.IsObject, False,'Object');
  383. CheckEquals(Value.IsOrdinal, True,'Ordinal');
  384. end;
  385. procedure TTestValueVariant.TestFromVarRecQWord;
  386. Var
  387. Q : QWord;
  388. begin
  389. Q:=1;
  390. FVarRec.VQWord:=@Q;
  391. FVarRec.vType:=vtQWord;
  392. DoFromVarRec;
  393. CheckEquals(1,Value.AsUInt64,'Value');
  394. CheckTrue(TypeInfo(QWord)=Value.TypeInfo,'Correct typeinfo');
  395. CheckEquals(Value.IsClass, False,'Class');
  396. CheckEquals(Value.IsObject, False,'Object');
  397. CheckEquals(Value.IsOrdinal, True,'Ordinal');
  398. end;
  399. procedure TTestValueVariant.TestFromVarRecUnicodeString;
  400. Var
  401. s : UnicodeString;
  402. begin
  403. S:='123';
  404. FVarrec.VType:=vtUnicodeString;
  405. FVarrec.VUnicodeString:=Pointer(S);
  406. DoFromVarRec;
  407. CheckEquals('123',Value.AsUnicodeString,'Value');
  408. CheckTrue(TypeInfo(UnicodeString)=Value.TypeInfo,'Correct typeinfo');
  409. CheckEquals(Value.IsClass, False,'Class');
  410. CheckEquals(Value.IsObject, False,'Object');
  411. CheckEquals(Value.IsOrdinal, False,'Ordinal');
  412. end;
  413. procedure TTestValueVariant.TestFromVariantInteger;
  414. begin
  415. FSrc:=Integer(1);
  416. DoFromVariant;
  417. CheckEquals(1,Value.AsInteger,'Value');
  418. CheckTrue(TypeInfo(Longint)=Value.TypeInfo,'Correct typeinfo');
  419. CheckEquals(Value.IsClass, False,'Class');
  420. CheckEquals(Value.IsObject, False,'Object');
  421. CheckEquals(Value.IsOrdinal, True,'Ordinal');
  422. end;
  423. procedure TTestValueVariant.TestFromVariantBoolean;
  424. begin
  425. FSrc:=True;
  426. DoFromVariant;
  427. CheckEquals(True,Value.AsBoolean,'Value');
  428. CheckTrue(TypeInfo(Boolean)=Value.TypeInfo,'Correct typeinfo');
  429. CheckEquals(Value.IsClass, False,'Class');
  430. CheckEquals(Value.IsObject, False,'Object');
  431. CheckEquals(Value.IsOrdinal, True,'Ordinal');
  432. end;
  433. procedure TTestValueVariant.TestFromVariantSmallInt;
  434. begin
  435. FSrc:=SmallInt(1);
  436. DoFromVariant;
  437. CheckEquals(1,Value.AsInteger,'Value');
  438. CheckTrue(TypeInfo(SmallInt)=Value.TypeInfo,'Correct typeinfo');
  439. CheckEquals(Value.IsClass, False,'Class');
  440. CheckEquals(Value.IsObject, False,'Object');
  441. CheckEquals(Value.IsOrdinal, True,'Ordinal');
  442. end;
  443. procedure TTestValueVariant.TestFromVariantOleStr;
  444. begin
  445. FSrc:=WideString('1.23');
  446. DoFromVariant;
  447. CheckEquals('1.23',Value.AsUnicodeString,'Value');
  448. CheckTrue(TypeInfo(WideString)=Value.TypeInfo,'Correct typeinfo');
  449. CheckEquals(Value.IsClass, False,'Class');
  450. CheckEquals(Value.IsObject, False,'Object');
  451. CheckEquals(Value.IsOrdinal, False,'Ordinal');
  452. end;
  453. procedure TTestValueVariant.TestFromVariantInt64;
  454. begin
  455. FSrc:=Int64(1);
  456. DoFromVariant;
  457. CheckEquals(1,Value.AsInt64,'Value');
  458. CheckTrue(TypeInfo(Int64)=Value.TypeInfo,'Correct typeinfo');
  459. CheckEquals(Value.IsClass, False,'Class');
  460. CheckEquals(Value.IsObject, False,'Object');
  461. CheckEquals(Value.IsOrdinal, True,'Ordinal');
  462. end;
  463. procedure TTestValueVariant.TestFromVariantQWord;
  464. begin
  465. FSrc:=QWord(1);
  466. DoFromVariant;
  467. CheckEquals(1,Value.AsInt64,'Value');
  468. CheckTrue(TypeInfo(QWord)=Value.TypeInfo,'Correct typeinfo');
  469. CheckEquals(Value.IsClass, False,'Class');
  470. CheckEquals(Value.IsObject, False,'Object');
  471. CheckEquals(Value.IsOrdinal, True,'Ordinal');
  472. end;
  473. procedure TTestValueVariant.TestFromVariantShortInt;
  474. begin
  475. FSrc:=ShortInt(1);
  476. DoFromVariant;
  477. CheckEquals(1,Value.AsInteger,'Value');
  478. CheckTrue(TypeInfo(Shortint)=Value.TypeInfo,'Correct typeinfo');
  479. CheckEquals(Value.IsClass, False,'Class');
  480. CheckEquals(Value.IsObject, False,'Object');
  481. CheckEquals(Value.IsOrdinal, True,'Ordinal');
  482. end;
  483. procedure TTestValueVariant.TestFromVariantByte;
  484. begin
  485. FSrc:=Byte(1);
  486. DoFromVariant;
  487. CheckEquals(1,Value.AsInteger,'Value');
  488. CheckTrue(TypeInfo(Byte)=Value.TypeInfo,'Correct typeinfo');
  489. CheckEquals(Value.IsClass, False,'Class');
  490. CheckEquals(Value.IsObject, False,'Object');
  491. CheckEquals(Value.IsOrdinal, True,'Ordinal');
  492. end;
  493. procedure TTestValueVariant.TestFromVariantWord;
  494. begin
  495. FSrc:=Word(1);
  496. DoFromVariant;
  497. CheckEquals(1,Value.AsInteger,'Value');
  498. CheckTrue(TypeInfo(Word)=Value.TypeInfo,'Correct typeinfo');
  499. CheckEquals(Value.IsClass, False,'Class');
  500. CheckEquals(Value.IsObject, False,'Object');
  501. CheckEquals(Value.IsOrdinal, True,'Ordinal');
  502. end;
  503. procedure TTestValueVariant.TestFromVariantLongWord;
  504. begin
  505. FSrc:=Cardinal(1);
  506. DoFromVariant;
  507. CheckEquals(1,Value.AsInteger,'Value');
  508. CheckTrue(TypeInfo(Cardinal)=Value.TypeInfo,'Correct typeinfo');
  509. CheckEquals(Value.IsClass, False,'Class');
  510. CheckEquals(Value.IsObject, False,'Object');
  511. CheckEquals(Value.IsOrdinal, True,'Ordinal');
  512. end;
  513. procedure TTestValueVariant.TestFromVariantSingle;
  514. begin
  515. FSrc:=Single(1.23); // Results in double...
  516. VarCast(FSrc,FSrc,varSingle);
  517. DoFromVariant;
  518. CheckEquals(1.23,Value.AsSingle,0.01,'Value');
  519. CheckTrue(TypeInfo(Single)=Value.TypeInfo,'Correct typeinfo');
  520. CheckEquals(Value.IsClass, False,'Class');
  521. CheckEquals(Value.IsObject, False,'Object');
  522. CheckEquals(Value.IsOrdinal, False,'Ordinal');
  523. end;
  524. procedure TTestValueVariant.TestFromVariantDouble;
  525. begin
  526. FSrc:=Double(1.23);
  527. DoFromVariant;
  528. CheckEquals(1.23,Value.AsDouble,0.01,'Value');
  529. CheckTrue(TypeInfo(Double)=Value.TypeInfo,'Correct typeinfo');
  530. CheckEquals(Value.IsClass, False,'Class');
  531. CheckEquals(Value.IsObject, False,'Object');
  532. CheckEquals(Value.IsOrdinal, False,'Ordinal');
  533. end;
  534. procedure TTestValueVariant.TestFromVariantDate;
  535. Var
  536. D : TDateTime;
  537. begin
  538. D:=Time;
  539. FSrc:=D;
  540. DoFromVariant;
  541. CheckEquals(D,Value.AsDateTime,0.01,'Value');
  542. CheckTrue(TypeInfo(TDateTime)=Value.TypeInfo,'Correct typeinfo');
  543. CheckEquals(Value.IsClass, False,'Class');
  544. CheckEquals(Value.IsObject, False,'Object');
  545. CheckEquals(Value.IsOrdinal, False,'Ordinal');
  546. end;
  547. procedure TTestValueVariant.TestFromVariantDispatch;
  548. Var
  549. U : IDispatch;
  550. begin
  551. U:=TMyUNknown.Create;
  552. FSrc:=U;
  553. DoFromVariant;
  554. CheckTrue(U=Value.AsInterface,'Value');
  555. CheckTrue(TypeInfo(IDispatch)=Value.TypeInfo,'Correct typeinfo');
  556. CheckEquals(Value.IsClass, False,'Class');
  557. CheckEquals(Value.IsObject, False,'Object');
  558. CheckEquals(Value.IsOrdinal, False,'Ordinal');
  559. end;
  560. procedure TTestValueVariant.TestFromVariantError;
  561. begin
  562. TVarData(FSrc).verror:=S_FALSE;
  563. TVarData(FSrc).vtype:=varError;
  564. DoFromVariant;
  565. CheckTrue(S_FALSE=Value.AsError,'Value');
  566. CheckTrue(TypeInfo(HRESULT)=Value.TypeInfo,'Correct typeinfo');
  567. CheckEquals(Value.IsClass, False,'Class');
  568. CheckEquals(Value.IsObject, False,'Object');
  569. CheckEquals(Value.IsOrdinal, True,'Ordinal');
  570. end;
  571. procedure TTestValueVariant.TestFromVariantUnknown;
  572. Var
  573. U : IInterface;
  574. begin
  575. U:=TMyUNknown.Create;
  576. FSrc:=U;
  577. DoFromVariant;
  578. CheckTrue(U=Value.AsInterface,'Value');
  579. CheckTrue(TypeInfo(IInterface)=Value.TypeInfo,'Correct typeinfo');
  580. CheckEquals(Value.IsClass, False,'Class');
  581. CheckEquals(Value.IsObject, False,'Object');
  582. CheckEquals(Value.IsOrdinal, False,'Ordinal');
  583. end;
  584. procedure TTestValueVariant.TestFromVariantCurrency;
  585. begin
  586. FSrc:=Currency(1.23);
  587. DoFromVariant;
  588. CheckEquals(1.23,Value.AsCurrency,0.01,'Value');
  589. CheckTrue(TypeInfo(Currency)=Value.TypeInfo,'Correct typeinfo');
  590. CheckEquals(Value.IsClass, False,'Class');
  591. CheckEquals(Value.IsObject, False,'Object');
  592. CheckEquals(Value.IsOrdinal, False,'Ordinal');
  593. end;
  594. procedure TTestValueVariant.TestFromVariantString;
  595. begin
  596. FSrc:='1.23';
  597. DoFromVariant;
  598. CheckEquals('1.23',Value.AsString,'Value');
  599. CheckTrue(TypeInfo(AnsiString)=Value.TypeInfo,'Correct typeinfo');
  600. CheckEquals(Value.IsClass, False,'Class');
  601. CheckEquals(Value.IsObject, False,'Object');
  602. CheckEquals(Value.IsOrdinal, False,'Ordinal');
  603. end;
  604. procedure TTestValueVariant.TestFromVariantUnicodeString;
  605. begin
  606. TVarData(FSrc).vustring:=Pointer(UnicodeString('1.23'));
  607. TVarData(FSrc).vtype:=varUString;
  608. DoFromVariant;
  609. CheckEquals('1.23',Value.AsString,'Value');
  610. CheckTrue(TypeInfo(UnicodeString)=Value.TypeInfo,'Correct typeinfo');
  611. CheckEquals(Value.IsClass, False,'Class');
  612. CheckEquals(Value.IsObject, False,'Object');
  613. CheckEquals(Value.IsOrdinal, False,'Ordinal');
  614. end;
  615. procedure TTestValueVariant.TestArrayOfConstToTValue;
  616. Var
  617. S:TValueArray;
  618. begin
  619. S:=ArrayOfConstToTValueArray([1,'something',1.23]);
  620. CheckEquals(3,Length(S),'Length');
  621. CheckEquals(1,S[0].AsInteger,'Value 1');
  622. CheckEquals('something',S[1].AsString,'Value 3');
  623. CheckEquals(1.23,S[2].AsDouble,0.01,'Value 3');
  624. end;
  625. procedure TTestValueVariant.TestCastAnsiString;
  626. var
  627. s: AnsiString;
  628. v: Variant;
  629. vvar, vstr: TValue;
  630. begin
  631. s := 'Test';
  632. v := s;
  633. vvar := TValue.{$ifdef fpc}specialize{$endif}From<Variant>(v);
  634. CheckTrue(vvar.TryCast(TypeInfo(AnsiString), vstr));
  635. CheckEquals(s, vstr.AsAnsiString);
  636. end;
  637. {$ifndef FPC_WIDESTRING_EQUAL_UNICODESTRING}
  638. procedure TTestValueVariant.TestCastUnicodeString;
  639. var
  640. u: UnicodeString;
  641. v: Variant;
  642. vvar, vstr: TValue;
  643. begin
  644. u := 'Test';
  645. TVarData(v).vType := varUString;
  646. TVarData(v).vuString := Pointer(u);
  647. vvar := TValue.{$ifdef fpc}specialize{$endif}From<Variant>(v);
  648. CheckTrue(vvar.TryCast(TypeInfo(UnicodeString), vstr));
  649. CheckEquals(u, vstr.AsUnicodeString);
  650. end;
  651. {$endif}
  652. procedure TTestValueVariant.TestCastWideString;
  653. var
  654. w: WideString;
  655. v: Variant;
  656. vvar, vstr: TValue;
  657. begin
  658. w := 'Test';
  659. v := w;
  660. vvar := TValue.{$ifdef fpc}specialize{$endif}From<Variant>(v);
  661. CheckTrue(vvar.TryCast(TypeInfo(WideString), vstr));
  662. CheckEquals(w, vstr.AsUnicodeString);
  663. end;
  664. procedure TTestValueVariant.TestCastShortString;
  665. var
  666. s: ShortString;
  667. v: Variant;
  668. vvar, vstr: TValue;
  669. begin
  670. s := 'Test';
  671. v := s;
  672. vvar := TValue.{$ifdef fpc}specialize{$endif}From<Variant>(v);
  673. CheckTrue(vvar.TryCast(TypeInfo(ShortString), vstr));
  674. CheckEquals(s, vstr.AsAnsiString);
  675. end;
  676. { TMyUNknown }
  677. function TMyUNknown.GetTypeInfoCount(out count: longint): HResult; stdcall;
  678. begin
  679. count:=0;
  680. Result:=S_OK;
  681. end;
  682. function TMyUNknown.GetTypeInfo(Index, LocaleID: longint; out TypeInfo
  683. ): HResult; stdcall;
  684. begin
  685. Result:=S_OK;
  686. end;
  687. function TMyUNknown.GetIDsOfNames(const iid: TGUID; names: Pointer; NameCount,
  688. LocaleID: LongInt; DispIDs: Pointer): HResult; stdcall;
  689. begin
  690. Result:=S_OK;
  691. end;
  692. function TMyUNknown.Invoke(DispID: LongInt; const iid: TGUID;
  693. LocaleID: longint; Flags: Word; var params; VarResult, ExcepInfo,
  694. ArgErr: pointer): HResult; stdcall;
  695. begin
  696. Result:=S_OK;
  697. end;
  698. type
  699. TMyLongInt = type LongInt;
  700. procedure TTestValueSimple.TestIsType;
  701. { Delphi does not provide type information for local types :/ }
  702. {type
  703. TMyLongInt = type LongInt;}
  704. var
  705. v: TValue;
  706. l: LongInt;
  707. ml: TMyLongInt;
  708. begin
  709. l := 42;
  710. ml := 42;
  711. TValue.Make(@l, TypeInfo(LongInt), v);
  712. Check(v.IsType(TypeInfo(LongInt)));
  713. Check(not v.IsType(TypeInfo(TMyLongInt)));
  714. Check(not v.IsType(TypeInfo(String)));
  715. Check(v.{$ifdef fpc}specialize{$endif} IsType<LongInt>);
  716. Check(not v.{$ifdef fpc}specialize{$endif} IsType<TMyLongInt>);
  717. Check(not v.{$ifdef fpc}specialize{$endif} IsType<String>);
  718. TValue.Make(@ml, TypeInfo(TMyLongInt), v);
  719. Check(v.IsType(TypeInfo(TMyLongInt)));
  720. Check(not v.IsType(TypeInfo(LongInt)));
  721. Check(not v.IsType(TypeInfo(String)));
  722. Check(v.{$ifdef fpc}specialize{$endif} IsType<TMyLongInt>);
  723. Check(not v.{$ifdef fpc}specialize{$endif} IsType<LongInt>);
  724. Check(not v.{$ifdef fpc}specialize{$endif} IsType<String>);
  725. end;
  726. procedure TTestValueSimple.TestMakeNil;
  727. var
  728. value: TValue;
  729. begin
  730. TValue.Make(Nil, Nil, value);
  731. CheckTrue(value.Kind = tkUnknown);
  732. CheckTrue(value.IsEmpty);
  733. CheckTrue(value.IsObject);
  734. CheckTrue(value.IsClass);
  735. CheckTrue(value.IsOrdinal);
  736. CheckFalse(value.IsArray);
  737. CheckTrue(value.AsObject = Nil);
  738. CheckTrue(value.AsClass = Nil);
  739. CheckTrue(value.AsInterface = Nil);
  740. CheckEquals(0, value.AsOrdinal);
  741. TValue.Make(Nil, TypeInfo(TObject), value);
  742. CheckTrue(value.IsEmpty);
  743. CheckTrue(value.IsObject);
  744. CheckTrue(value.IsClass);
  745. CheckTrue(value.IsOrdinal);
  746. CheckFalse(value.IsArray);
  747. CheckTrue(value.AsObject=Nil);
  748. CheckTrue(value.AsClass=Nil);
  749. CheckTrue(value.AsInterface=Nil);
  750. CheckEquals(0, value.AsOrdinal);
  751. TValue.Make(Nil, TypeInfo(TClass), value);
  752. CheckTrue(value.IsEmpty);
  753. CheckTrue(value.IsClass);
  754. CheckTrue(value.IsOrdinal);
  755. CheckFalse(value.IsArray);
  756. CheckTrue(value.AsObject=Nil);
  757. CheckTrue(value.AsClass=Nil);
  758. CheckTrue(value.AsInterface=Nil);
  759. CheckEquals(0, value.AsOrdinal);
  760. TValue.Make(Nil, TypeInfo(LongInt), value);
  761. CheckTrue(value.IsOrdinal);
  762. CheckFalse(value.IsEmpty);
  763. CheckFalse(value.IsClass);
  764. CheckFalse(value.IsObject);
  765. CheckFalse(value.IsArray);
  766. CheckEquals(0, value.AsOrdinal);
  767. CheckEquals(0, value.AsInteger);
  768. CheckEquals(0, value.AsInt64);
  769. CheckEquals(0, value.AsUInt64);
  770. TValue.Make(Nil, TypeInfo(String), value);
  771. CheckFalse(value.IsEmpty);
  772. CheckFalse(value.IsObject);
  773. CheckFalse(value.IsClass);
  774. CheckFalse(value.IsArray);
  775. CheckEquals('', value.AsString);
  776. end;
  777. procedure TTestValueSimple.TestMakeObject;
  778. var
  779. AValue: TValue;
  780. ATestClass: TTestValueClass;
  781. begin
  782. ATestClass := TTestValueClass.Create;
  783. ATestClass.AInteger := 54329;
  784. TValue.Make(@ATestClass, TypeInfo(TTestValueClass),AValue);
  785. CheckEquals(AValue.IsClass, False);
  786. CheckEquals(AValue.IsObject, True);
  787. Check(AValue.AsObject=ATestClass);
  788. Check(PPointer(AValue.GetReferenceToRawData)^ = Pointer(ATestClass));
  789. CheckEquals(TTestValueClass(AValue.AsObject).AInteger, 54329);
  790. ATestClass.Free;
  791. end;
  792. procedure TTestValueArray.TestMakeArrayDynamic;
  793. var
  794. arr: TArrayOfLongintDyn;
  795. value: TValue;
  796. begin
  797. SetLength(arr, 2);
  798. arr[0] := 42;
  799. arr[1] := 21;
  800. TValue.Make(@arr, TypeInfo(TArrayOfLongintDyn), value);
  801. CheckEquals(value.IsArray, True);
  802. CheckEquals(value.IsObject, False);
  803. CheckEquals(value.IsOrdinal, False);
  804. CheckEquals(value.IsClass, False);
  805. CheckEquals(value.GetArrayLength, 2);
  806. CheckEquals(value.GetArrayElement(0).AsInteger, 42);
  807. CheckEquals(value.GetArrayElement(1).AsInteger, 21);
  808. Check(PPointer(value.GetReferenceToRawData)^ = Pointer(arr));
  809. value.SetArrayElement(0, Integer(84));
  810. CheckEquals(arr[0], 84);
  811. end;
  812. procedure TTestValueArray.TestMakeArrayStatic;
  813. type
  814. TArrStat = array[0..1] of LongInt;
  815. TArrStat2D = array[0..1, 0..1] of LongInt;
  816. var
  817. arr: TArrStat;
  818. arr2D: TArrStat2D;
  819. value: TValue;
  820. begin
  821. arr[0] := 42;
  822. arr[1] := 21;
  823. TValue.Make(@arr, TypeInfo(TArrStat), value);
  824. CheckEquals(value.IsArray, True);
  825. CheckEquals(value.IsObject, False);
  826. CheckEquals(value.IsOrdinal, False);
  827. CheckEquals(value.IsClass, False);
  828. CheckEquals(value.GetArrayLength, 2);
  829. CheckEquals(value.GetArrayElement(0).AsInteger, 42);
  830. CheckEquals(value.GetArrayElement(1).AsInteger, 21);
  831. value.SetArrayElement(0, integer(84));
  832. { since this is a static array the original array isn't touched! }
  833. CheckEquals(arr[0], 42);
  834. arr2D[0, 0] := 42;
  835. arr2D[0, 1] := 21;
  836. arr2D[1, 0] := 84;
  837. arr2D[1, 1] := 63;
  838. TValue.Make(@arr2D, TypeInfo(TArrStat2D), value);
  839. CheckEquals(value.IsArray, True);
  840. CheckEquals(value.GetArrayLength, 4);
  841. CheckEquals(value.GetArrayElement(0).AsInteger, 42);
  842. CheckEquals(value.GetArrayElement(1).AsInteger, 21);
  843. CheckEquals(value.GetArrayElement(2).AsInteger, 84);
  844. CheckEquals(value.GetArrayElement(3).AsInteger, 63);
  845. end;
  846. {$ifdef fpc}
  847. procedure TTestValueArray.TestMakeArrayOpen;
  848. procedure TestOpenArrayValueCopy(aArr: array of LongInt);
  849. var
  850. value: TValue;
  851. begin
  852. TValue.MakeOpenArray(@aArr[0], Length(aArr), PTypeInfo(TypeInfo(aArr)), value);
  853. CheckEquals(value.IsArray, True);
  854. CheckEquals(value.IsOpenArray, True);
  855. CheckEquals(value.IsObject, False);
  856. CheckEquals(value.IsOrdinal, False);
  857. CheckEquals(value.IsClass, False);
  858. CheckEquals(value.GetArrayLength, 2);
  859. CheckEquals(value.GetArrayElement(0).AsInteger, 42);
  860. CheckEquals(value.GetArrayElement(1).AsInteger, 21);
  861. value.SetArrayElement(0, Integer(84));
  862. { since this is an open array the original array is modified! }
  863. CheckEquals(aArr[0], 84);
  864. end;
  865. procedure TestOpenArrayValueVar(var aArr: array of LongInt);
  866. var
  867. value: TValue;
  868. begin
  869. TValue.MakeOpenArray(@aArr[0], Length(aArr), PTypeInfo(TypeInfo(aArr)), value);
  870. CheckEquals(value.IsArray, True);
  871. CheckEquals(value.IsOpenArray, True);
  872. CheckEquals(value.IsObject, False);
  873. CheckEquals(value.IsOrdinal, False);
  874. CheckEquals(value.IsClass, False);
  875. CheckEquals(value.GetArrayLength, 2);
  876. CheckEquals(value.GetArrayElement(0).AsInteger, 42);
  877. CheckEquals(value.GetArrayElement(1).AsInteger, 21);
  878. value.SetArrayElement(0, 84);
  879. { since this is an open array the original array is modified! }
  880. CheckEquals(aArr[0], 84);
  881. end;
  882. procedure TestOpenArrayValueOut(var aArr: array of LongInt);
  883. var
  884. value: TValue;
  885. begin
  886. TValue.MakeOpenArray(@aArr[0], Length(aArr), PTypeInfo(TypeInfo(aArr)), value);
  887. CheckEquals(value.IsArray, True);
  888. CheckEquals(value.IsOpenArray, True);
  889. CheckEquals(value.IsObject, False);
  890. CheckEquals(value.IsOrdinal, False);
  891. CheckEquals(value.IsClass, False);
  892. CheckEquals(value.GetArrayLength, 2);
  893. CheckEquals(value.GetArrayElement(0).AsInteger, 42);
  894. CheckEquals(value.GetArrayElement(1).AsInteger, 21);
  895. value.SetArrayElement(0, 84);
  896. value.SetArrayElement(1, 128);
  897. { since this is an open array the original array is modified! }
  898. CheckEquals(aArr[0], 84);
  899. CheckEquals(aArr[1], 128);
  900. CheckEquals(value.GetArrayElement(0).AsInteger, 84);
  901. CheckEquals(value.GetArrayElement(1).AsInteger, 128);
  902. end;
  903. var
  904. arr: array of LongInt;
  905. begin
  906. TestOpenArrayValueCopy([42, 21]);
  907. arr := [42, 21];
  908. TestOpenArrayValueVar(arr);
  909. CheckEquals(arr[0], 84);
  910. CheckEquals(arr[1], 21);
  911. arr := [42, 21];
  912. TestOpenArrayValueOut(arr);
  913. CheckEquals(arr[0], 84);
  914. CheckEquals(arr[1], 128);
  915. end;
  916. {$endif}
  917. procedure TTestValueSimple.TestMakeSingle;
  918. var
  919. fs: Single;
  920. v: TValue;
  921. hadexcept: Boolean;
  922. begin
  923. fs := 3.14;
  924. TValue.Make(@fs, TypeInfo(Single), v);
  925. CheckEquals(v.IsClass, False);
  926. CheckEquals(v.IsObject, False);
  927. CheckEquals(v.IsOrdinal, False);
  928. Check(v.AsExtended=fs);
  929. Check(v.GetReferenceToRawData <> @fs);
  930. try
  931. hadexcept := False;
  932. v.AsInt64;
  933. except
  934. hadexcept := True;
  935. end;
  936. CheckTrue(hadexcept, 'No signed type conversion exception');
  937. try
  938. hadexcept := False;
  939. v.AsUInt64;
  940. except
  941. hadexcept := True;
  942. end;
  943. CheckTrue(hadexcept, 'No unsigned type conversion exception');
  944. end;
  945. procedure TTestValueSimple.TestMakeDouble;
  946. var
  947. fd: Double;
  948. v: TValue;
  949. hadexcept: Boolean;
  950. begin
  951. fd := 3.14;
  952. TValue.Make(@fd, TypeInfo(Double), v);
  953. CheckEquals(v.IsClass, False);
  954. CheckEquals(v.IsObject, False);
  955. CheckEquals(v.IsOrdinal, False);
  956. Check(v.AsExtended=fd);
  957. Check(v.GetReferenceToRawData <> @fd);
  958. try
  959. hadexcept := False;
  960. v.AsInt64;
  961. except
  962. hadexcept := True;
  963. end;
  964. CheckTrue(hadexcept, 'No signed type conversion exception');
  965. try
  966. hadexcept := False;
  967. v.AsUInt64;
  968. except
  969. hadexcept := True;
  970. end;
  971. CheckTrue(hadexcept, 'No unsigned type conversion exception');
  972. end;
  973. procedure TTestValueSimple.TestMakeExtended;
  974. var
  975. fe: Extended;
  976. v: TValue;
  977. hadexcept: Boolean;
  978. begin
  979. fe := 3.14;
  980. TValue.Make(@fe, TypeInfo(Extended), v);
  981. CheckEquals(v.IsClass, False);
  982. CheckEquals(v.IsObject, False);
  983. CheckEquals(v.IsOrdinal, False);
  984. Check(v.AsExtended=fe);
  985. Check(v.GetReferenceToRawData <> @fe);
  986. try
  987. hadexcept := False;
  988. v.AsInt64;
  989. except
  990. hadexcept := True;
  991. end;
  992. CheckTrue(hadexcept, 'No signed type conversion exception');
  993. try
  994. hadexcept := False;
  995. v.AsUInt64;
  996. except
  997. hadexcept := True;
  998. end;
  999. CheckTrue(hadexcept, 'No unsigned type conversion exception');
  1000. end;
  1001. procedure TTestValueSimple.TestMakeCurrency;
  1002. var
  1003. fcu: Currency;
  1004. v: TValue;
  1005. hadexcept: Boolean;
  1006. begin
  1007. fcu := 3.14;
  1008. TValue.Make(@fcu, TypeInfo(Currency), v);
  1009. CheckEquals(v.IsClass, False);
  1010. CheckEquals(v.IsObject, False);
  1011. CheckEquals(v.IsOrdinal, False);
  1012. Check(v.AsExtended=Extended(fcu));
  1013. Check(v.AsCurrency=fcu);
  1014. Check(v.GetReferenceToRawData <> @fcu);
  1015. try
  1016. hadexcept := False;
  1017. v.AsInt64;
  1018. except
  1019. hadexcept := True;
  1020. end;
  1021. CheckTrue(hadexcept, 'No signed type conversion exception');
  1022. try
  1023. hadexcept := False;
  1024. v.AsUInt64;
  1025. except
  1026. hadexcept := True;
  1027. end;
  1028. CheckTrue(hadexcept, 'No unsigned type conversion exception');
  1029. end;
  1030. procedure TTestValueSimple.TestMakeComp;
  1031. var
  1032. fco: Comp;
  1033. v: TValue;
  1034. hadexcept: Boolean;
  1035. begin
  1036. fco := 314;
  1037. TValue.Make(@fco, TypeInfo(Comp), v);
  1038. if v.Kind <> tkFloat then
  1039. Exit;
  1040. CheckEquals(v.IsClass, False);
  1041. CheckEquals(v.IsObject, False);
  1042. CheckEquals(v.IsOrdinal, False);
  1043. Check(v.AsExtended=Extended(fco));
  1044. Check(v.GetReferenceToRawData <> @fco);
  1045. try
  1046. hadexcept := False;
  1047. CheckEquals(v.AsInt64, 314);
  1048. except
  1049. hadexcept := True;
  1050. end;
  1051. CheckFalse(hadexcept, 'Had signed type conversion exception');
  1052. try
  1053. hadexcept := False;
  1054. CheckEquals(v.AsUInt64, 314);
  1055. except
  1056. hadexcept := True;
  1057. end;
  1058. CheckFalse(hadexcept, 'Had unsigned type conversion exception');
  1059. end;
  1060. procedure TTestValueSimple.TestMakeEnum;
  1061. var
  1062. e: TTestEnum;
  1063. v: TValue;
  1064. begin
  1065. e := te1;
  1066. TValue.Make(@e, TypeInfo(TTestEnum), v);
  1067. Check(not v.IsClass);
  1068. Check(not v.IsArray);
  1069. Check(not v.IsEmpty);
  1070. {$ifdef fpc}
  1071. Check(not v.IsOpenArray);
  1072. {$endif}
  1073. Check(not v.IsObject);
  1074. Check(v.IsOrdinal);
  1075. Check(v.GetReferenceToRawData <> @e);
  1076. Check(TTestEnum(v.AsOrdinal) = te1);
  1077. end;
  1078. procedure TTestValueSimple.TestMakeAnsiChar;
  1079. var
  1080. c: AnsiChar;
  1081. v: TValue;
  1082. begin
  1083. c := #20;
  1084. TValue.Make(@c, TypeInfo(AnsiChar), v);
  1085. Check(not v.IsClass);
  1086. Check(not v.IsArray);
  1087. Check(not v.IsEmpty);
  1088. {$ifdef fpc}
  1089. Check(not v.IsOpenArray);
  1090. {$endif}
  1091. Check(not v.IsObject);
  1092. Check(v.IsOrdinal);
  1093. Check(v.GetReferenceToRawData <> @c);
  1094. Check(AnsiChar(v.AsOrdinal) = #20);
  1095. Check(v.AsAnsiChar = #20);
  1096. end;
  1097. procedure TTestValueSimple.TestMakeWideChar;
  1098. var
  1099. c: WideChar;
  1100. v: TValue;
  1101. begin
  1102. c := #$1234;
  1103. TValue.Make(@c, TypeInfo(WideChar), v);
  1104. Check(not v.IsClass);
  1105. Check(not v.IsArray);
  1106. Check(not v.IsEmpty);
  1107. {$ifdef fpc}
  1108. Check(not v.IsOpenArray);
  1109. {$endif}
  1110. Check(not v.IsObject);
  1111. Check(v.IsOrdinal);
  1112. Check(v.GetReferenceToRawData <> @c);
  1113. Check(WideChar(v.AsOrdinal) = #$1234);
  1114. Check(v.AsWideChar = #$1234);
  1115. end;
  1116. procedure TTestValueSimple.TestMakeNativeInt;
  1117. var
  1118. fni: NativeInt;
  1119. s: AnsiString;
  1120. v: TValue;
  1121. o: TObject;
  1122. begin
  1123. fni := 2021;
  1124. TValue.Make(fni, TypeInfo(LongInt), v);
  1125. CheckEquals(v.IsClass, False);
  1126. CheckEquals(v.IsObject, False);
  1127. CheckEquals(v.IsOrdinal, True);
  1128. Check(NativeInt(v.GetReferenceToRawData) <> fni);
  1129. CheckEquals(v.AsOrdinal, 2021);
  1130. s := 'Hello World';
  1131. TValue.Make(NativeInt(s), TypeInfo(AnsiString), v);
  1132. CheckEquals(v.IsClass, False);
  1133. CheckEquals(v.IsObject, False);
  1134. CheckEquals(v.IsOrdinal, False);
  1135. CheckEquals(v.AsString, s);
  1136. o := TObject.Create;
  1137. TValue.Make(NativeInt(o), TypeInfo(TObject), v);
  1138. CheckEquals(v.IsClass, False);
  1139. CheckEquals(v.IsObject, True);
  1140. CheckEquals(v.IsOrdinal, False);
  1141. Check(PPointer(v.GetReferenceToRawData)^ = Pointer(o));
  1142. Check(v.AsObject = o);
  1143. o.Free;
  1144. end;
  1145. procedure TTestValueSimple.TestMakeVariant;
  1146. var
  1147. vv : Variant;
  1148. vd : TVarData;
  1149. v: TValue;
  1150. begin
  1151. vv := 'Some String';
  1152. TValue.Make(@vv, TypeInfo(Variant), v);
  1153. Check(not v.IsClass);
  1154. Check(not v.IsArray);
  1155. Check(not v.IsEmpty);
  1156. {$ifdef fpc}
  1157. Check(not v.IsOpenArray);
  1158. {$endif}
  1159. Check(not v.IsObject);
  1160. Check(not v.IsOrdinal);
  1161. Check(v.GetReferenceToRawData <> @vv);
  1162. Check(String(v.AsVariant) = 'Some String');
  1163. end;
  1164. procedure TTestValueArray.TestMakeFromArray;
  1165. var
  1166. arr, subarr: array of TValue;
  1167. v, varr: TValue;
  1168. ti: PTypeInfo;
  1169. i: LongInt;
  1170. begin
  1171. SetLength(arr, 3 * 4);
  1172. for i := 0 to High(arr) do
  1173. TValue.{$ifdef fpc}specialize{$endif} Make<LongInt>(i + 1, arr[i]);
  1174. ti := PTypeInfo(TypeInfo(LongInt));
  1175. v := TValue.FromArray(TypeInfo(TArrayOfLongintDyn), arr);
  1176. Check(not v.IsEmpty, 'Array is empty');
  1177. Check(v.IsArray, 'Value is not an array');
  1178. CheckEquals(Length(arr), v.GetArrayLength, 'Array length does not match');
  1179. for i := 0 to High(arr) do begin
  1180. varr := v.GetArrayElement(i);
  1181. Check(varr.TypeInfo = ti, 'Type info of array element does not match');
  1182. Check(varr.IsOrdinal, 'Array element is not an ordinal');
  1183. Check(varr.AsInteger = arr[i].AsInteger, 'Value of array element does not match');
  1184. end;
  1185. subarr := Copy(arr, 0, 4);
  1186. v := TValue.FromArray(TypeInfo(TArrayOfLongintStatic), subarr);
  1187. Check(not v.IsEmpty, 'Array is empty');
  1188. Check(v.IsArray, 'Value is not an array');
  1189. CheckEquals(Length(subarr), v.GetArrayLength, 'Array length does not match');
  1190. for i := 0 to High(subarr) do begin
  1191. varr := v.GetArrayElement(i);
  1192. Check(varr.TypeInfo = ti, 'Type info of array element does not match');
  1193. Check(varr.IsOrdinal, 'Array element is not an ordinal');
  1194. Check(varr.AsInteger = subarr[i].AsInteger, 'Value of array element does not match');
  1195. end;
  1196. v := TValue.FromArray(TypeInfo(TArrayOfLongint2DStatic), arr);
  1197. Check(not v.IsEmpty, 'Array is empty');
  1198. Check(v.IsArray, 'Value is not an array');
  1199. CheckEquals(Length(arr), v.GetArrayLength, 'Array length does not match');
  1200. for i := 0 to High(arr) do begin
  1201. varr := v.GetArrayElement(i);
  1202. Check(varr.TypeInfo = ti, 'Type info of array element does not match');
  1203. Check(varr.IsOrdinal, 'Array element is not an ordinal');
  1204. Check(varr.AsInteger = arr[i].AsInteger, 'Value of array element does not match');
  1205. end;
  1206. end;
  1207. procedure TTestValueSimple.TestMakeGenericNil;
  1208. var
  1209. value: TValue;
  1210. begin
  1211. TValue.{$ifdef fpc}specialize{$endif} Make<TObject>(Nil, value);
  1212. CheckTrue(value.IsEmpty);
  1213. CheckTrue(value.IsObject);
  1214. CheckTrue(value.IsClass);
  1215. CheckTrue(value.IsOrdinal);
  1216. CheckFalse(value.IsArray);
  1217. CheckTrue(value.AsObject=Nil);
  1218. CheckTrue(value.AsClass=Nil);
  1219. CheckTrue(value.AsInterface=Nil);
  1220. CheckEquals(0, value.AsOrdinal);
  1221. TValue.{$ifdef fpc}specialize{$endif} Make<TClass>(Nil, value);
  1222. CheckTrue(value.IsEmpty);
  1223. CheckTrue(value.IsClass);
  1224. CheckTrue(value.IsOrdinal);
  1225. CheckFalse(value.IsArray);
  1226. CheckTrue(value.AsObject=Nil);
  1227. CheckTrue(value.AsClass=Nil);
  1228. CheckTrue(value.AsInterface=Nil);
  1229. CheckEquals(0, value.AsOrdinal);
  1230. end;
  1231. procedure TTestValueSimple.TestMakeGenericLongInt;
  1232. var
  1233. value: TValue;
  1234. begin
  1235. TValue.{$ifdef fpc}specialize{$endif} Make<LongInt>(0, value);
  1236. CheckTrue(value.IsOrdinal);
  1237. CheckFalse(value.IsEmpty);
  1238. CheckFalse(value.IsClass);
  1239. CheckFalse(value.IsObject);
  1240. CheckFalse(value.IsArray);
  1241. CheckEquals(0, value.AsOrdinal);
  1242. CheckEquals(0, value.AsInteger);
  1243. CheckEquals(0, value.AsInt64);
  1244. CheckEquals(0, value.AsUInt64);
  1245. end;
  1246. procedure TTestValueSimple.TestMakeGenericString;
  1247. var
  1248. value: TValue;
  1249. begin
  1250. TValue.{$ifdef fpc}specialize{$endif} Make<String>('test', value);
  1251. CheckFalse(value.IsEmpty);
  1252. CheckFalse(value.IsObject);
  1253. CheckFalse(value.IsClass);
  1254. CheckFalse(value.IsArray);
  1255. CheckEquals('test', value.AsString);
  1256. end;
  1257. procedure TTestValueSimple.TestMakeGenericObject;
  1258. var
  1259. value: TValue;
  1260. TestClass: TTestValueClass;
  1261. begin
  1262. TestClass := TTestValueClass.Create;
  1263. TestClass.AInteger := 54329;
  1264. TValue.{$ifdef fpc}specialize{$endif} Make<TTestValueClass>(TestClass, value);
  1265. CheckEquals(value.IsClass, False);
  1266. CheckEquals(value.IsObject, True);
  1267. Check(value.AsObject=TestClass);
  1268. Check(PPointer(value.GetReferenceToRawData)^ = Pointer(TestClass));
  1269. CheckEquals(TTestValueClass(value.AsObject).AInteger, 54329);
  1270. TestClass.Free;
  1271. end;
  1272. procedure TTestValueSimple.TestMakeGenericDouble;
  1273. var
  1274. fd: Double;
  1275. v: TValue;
  1276. hadexcept: Boolean;
  1277. begin
  1278. fd := 3.14;
  1279. TValue.{$ifdef fpc}specialize{$endif} Make<Double>(fd, v);
  1280. CheckEquals(v.IsClass, False);
  1281. CheckEquals(v.IsObject, False);
  1282. CheckEquals(v.IsOrdinal, False);
  1283. Check(v.AsExtended=fd);
  1284. Check(v.GetReferenceToRawData <> @fd);
  1285. try
  1286. hadexcept := False;
  1287. v.AsInt64;
  1288. except
  1289. hadexcept := True;
  1290. end;
  1291. CheckTrue(hadexcept, 'No signed type conversion exception');
  1292. try
  1293. hadexcept := False;
  1294. v.AsUInt64;
  1295. except
  1296. hadexcept := True;
  1297. end;
  1298. CheckTrue(hadexcept, 'No unsigned type conversion exception');
  1299. end;
  1300. procedure TTestValueSimple.TestMakeGenericAnsiChar;
  1301. var
  1302. c: AnsiChar;
  1303. v: TValue;
  1304. begin
  1305. c := #20;
  1306. TValue.{$ifdef fpc}specialize{$endif} Make<AnsiChar>(c, v);
  1307. Check(not v.IsClass);
  1308. Check(not v.IsArray);
  1309. Check(not v.IsEmpty);
  1310. {$ifdef fpc}
  1311. Check(not v.IsOpenArray);
  1312. {$endif}
  1313. Check(not v.IsObject);
  1314. Check(v.IsOrdinal);
  1315. Check(v.GetReferenceToRawData <> @c);
  1316. Check(AnsiChar(v.AsOrdinal) = #20);
  1317. Check(v.AsAnsiChar = #20);
  1318. end;
  1319. procedure TTestValueSimple.TestMakeGenericWideChar;
  1320. var
  1321. c: WideChar;
  1322. v: TValue;
  1323. begin
  1324. c := #$1234;
  1325. TValue.{$ifdef fpc}specialize{$endif} Make<WideChar>(c, v);
  1326. Check(not v.IsClass);
  1327. Check(not v.IsArray);
  1328. Check(not v.IsEmpty);
  1329. {$ifdef fpc}
  1330. Check(not v.IsOpenArray);
  1331. {$endif}
  1332. Check(not v.IsObject);
  1333. Check(v.IsOrdinal);
  1334. Check(v.GetReferenceToRawData <> @c);
  1335. Check(WideChar(v.AsOrdinal) = #$1234);
  1336. Check(v.AsWideChar = #$1234);
  1337. end;
  1338. procedure TTestValueSimple.MakeFromOrdinalTObject;
  1339. begin
  1340. TValue.FromOrdinal(TypeInfo(TObject), 42);
  1341. end;
  1342. procedure TTestValueSimple.MakeFromOrdinalSet;
  1343. begin
  1344. TValue.FromOrdinal(TypeInfo(TTestSet), 42);
  1345. end;
  1346. procedure TTestValueSimple.MakeFromOrdinalString;
  1347. begin
  1348. TValue.FromOrdinal(TypeInfo(AnsiString), 42);
  1349. end;
  1350. procedure TTestValueSimple.MakeFromOrdinalNil;
  1351. begin
  1352. TValue.FromOrdinal(Nil, 42);
  1353. end;
  1354. procedure TTestValueSimple.TestFromOrdinal;
  1355. var
  1356. v: TValue;
  1357. begin
  1358. v := TValue.FromOrdinal(TypeInfo(LongInt), 42);
  1359. Check(v.IsOrdinal);
  1360. CheckEquals(v.AsOrdinal, 42);
  1361. v := TValue.FromOrdinal(TypeInfo(Boolean), Ord(True));
  1362. Check(v.IsOrdinal);
  1363. CheckEquals(v.AsOrdinal, Ord(True));
  1364. v := TValue.FromOrdinal(TypeInfo(Int64), $1234123412341234);
  1365. Check(v.IsOrdinal);
  1366. CheckEquals(v.AsOrdinal, $1234123412341234);
  1367. v := TValue.FromOrdinal(TypeInfo(QWord), $1234123412341234);
  1368. Check(v.IsOrdinal);
  1369. CheckEquals(v.AsOrdinal, $1234123412341234);
  1370. v := TValue.FromOrdinal(TypeInfo(LongBool), Ord(True));
  1371. Check(v.IsOrdinal);
  1372. CheckEquals(v.AsOrdinal, Ord(True));
  1373. v := TValue.FromOrdinal(TypeInfo(TTestEnum), Ord(te1));
  1374. Check(v.IsOrdinal);
  1375. CheckEquals(v.AsOrdinal, Ord(te1));
  1376. v := TValue.FromOrdinal(TypeInfo(AnsiChar), Ord(#20));
  1377. Check(v.IsOrdinal);
  1378. CheckEquals(v.AsOrdinal, Ord(#20));
  1379. v := TValue.FromOrdinal(TypeInfo(WideChar), Ord(#$1234));
  1380. Check(v.IsOrdinal);
  1381. CheckEquals(v.AsOrdinal, Ord(#$1234));
  1382. CheckException({$ifdef fpc}@{$endif}MakeFromOrdinalNil, EInvalidCast);
  1383. CheckException({$ifdef fpc}@{$endif}MakeFromOrdinalTObject, EInvalidCast);
  1384. CheckException({$ifdef fpc}@{$endif}MakeFromOrdinalSet, EInvalidCast);
  1385. CheckException({$ifdef fpc}@{$endif}MakeFromOrdinalString, EInvalidCast);
  1386. end;
  1387. procedure TTestValueSimple.TestTryCastUnicodeString;
  1388. var
  1389. S: string;
  1390. V, V2: TValue;
  1391. begin
  1392. S := 'str';
  1393. V := S;
  1394. CheckTrue(V.TryCast(TypeInfo(UnicodeString), V2),'Cast OK');
  1395. end;
  1396. type
  1397. TMyManagedRecord = record
  1398. I: IntPtr;
  1399. Intf: IUnknown;
  1400. end;
  1401. TTestIntfObject = class(TInterfacedObject);
  1402. procedure TTestValueSimple.TestMakeManagedRecord;
  1403. function GetValue: TValue;
  1404. var
  1405. R: TMyManagedRecord;
  1406. begin
  1407. R.Intf := TTestIntfObject.Create;
  1408. Result := TValue.{$ifdef fpc}specialize{$endif} From<TMyManagedRecord>(R);
  1409. end;
  1410. var
  1411. P: Pointer;
  1412. R: TMyManagedRecord;
  1413. V: TValue;
  1414. begin
  1415. V := GetValue();
  1416. P := AllocMem(64);
  1417. R := V.{$ifdef fpc}specialize{$endif} AsType<TMyManagedRecord>;
  1418. Check((R.Intf as TTestIntfObject).RefCount >= 2, 'RefCount should be >= 2. One ref in in V, and another one is in R');
  1419. FreeMem(P);
  1420. end;
  1421. procedure TTestValueSimple.TestMakeStaticArrayOfManagedRecord;
  1422. type
  1423. TArrayOfRec = array[0..0] of TMyManagedRecord;
  1424. function GetValue: TValue;
  1425. var
  1426. Arr: TArrayOfRec;
  1427. begin
  1428. Arr[0].Intf := TTestIntfObject.Create;
  1429. Result := TValue.{$ifdef fpc}specialize{$endif} From<TArrayOfRec>(Arr);
  1430. end;
  1431. var
  1432. P: Pointer;
  1433. Arr: TArrayOfRec;
  1434. V: TValue;
  1435. begin
  1436. V := GetValue();
  1437. P := AllocMem(64);
  1438. Arr := V.{$ifdef fpc}specialize{$endif} AsType<TArrayOfRec>;
  1439. Check((Arr[0].Intf as TTestIntfObject).RefCount >= 2, 'RefCount should be >= 2. One ref in in V, and another one is in Arr');
  1440. FreeMem(P);
  1441. end;
  1442. { TTestValueArray }
  1443. {$ifdef fpc}
  1444. procedure TTestValueArray.TestOpenArrayToDyn;
  1445. procedure OpenArrayProc(aArr: array of LongInt);
  1446. var
  1447. value: TValue;
  1448. begin
  1449. {$ifndef InLazIDE}
  1450. value := specialize OpenArrayToDynArrayValue<LongInt>(aArr);
  1451. {$endif}
  1452. CheckEquals(value.IsArray, True);
  1453. CheckEquals(value.IsOpenArray, False);
  1454. CheckEquals(value.IsObject, False);
  1455. CheckEquals(value.IsOrdinal, False);
  1456. CheckEquals(value.IsClass, False);
  1457. CheckEquals(value.GetArrayLength, 2);
  1458. CheckEquals(value.GetArrayElement(0).AsInteger, 42);
  1459. CheckEquals(value.GetArrayElement(1).AsInteger, 84);
  1460. value.SetArrayElement(0, Integer(21));
  1461. { since this is a copy the original array is not modified! }
  1462. CheckEquals(aArr[0], 42);
  1463. end;
  1464. begin
  1465. OpenArrayProc([42, 84]);
  1466. end;
  1467. {$endif}
  1468. procedure TTestValueGeneral.TestDataSize;
  1469. var
  1470. u8: UInt8;
  1471. u16: UInt16;
  1472. u32: UInt32;
  1473. u64: UInt64;
  1474. s8: Int8;
  1475. s16: Int16;
  1476. s32: Int32;
  1477. s64: Int64;
  1478. f32: Single;
  1479. f64: Double;
  1480. {$ifdef FPC_HAS_TYPE_EXTENDED}
  1481. f80: Extended;
  1482. {$endif}
  1483. fco: Comp;
  1484. fcu: Currency;
  1485. ss: ShortString;
  1486. sa: AnsiString;
  1487. su: UnicodeString;
  1488. sw: WideString;
  1489. o: TObject;
  1490. c: TClass;
  1491. i: IInterface;
  1492. ad: TArrayOfLongintDyn;
  1493. _as: TArrayOfLongintStatic;
  1494. b8: Boolean;
  1495. {$ifdef fpc}
  1496. b16: Boolean16;
  1497. b32: Boolean32;
  1498. b64: Boolean64;
  1499. {$endif}
  1500. bl8: ByteBool;
  1501. bl16: WordBool;
  1502. bl32: LongBool;
  1503. {$ifdef fpc}
  1504. bl64: QWordBool;
  1505. {$endif}
  1506. e: TTestEnum;
  1507. s: TTestSet;
  1508. t: TTestRecord;
  1509. p: Pointer;
  1510. proc: TTestProc;
  1511. method: TTestMethod;
  1512. value: TValue;
  1513. begin
  1514. u8:=245;
  1515. TValue.Make(@u8, TypeInfo(UInt8), value);
  1516. CheckEquals(1, value.DataSize, 'Size of UInt8 differs');
  1517. u16:=789;
  1518. TValue.Make(@u16, TypeInfo(UInt16), value);
  1519. CheckEquals(2, value.DataSize, 'Size of UInt16 differs');
  1520. u32:=568789;
  1521. TValue.Make(@u32, TypeInfo(UInt32), value);
  1522. CheckEquals(4, value.DataSize, 'Size of UInt32 differs');
  1523. u64:=$abdcefadbcef;
  1524. TValue.Make(@u64, TypeInfo(UInt64), value);
  1525. CheckEquals(8, value.DataSize, 'Size of UInt64 differs');
  1526. s8:=-32;
  1527. TValue.Make(@s8, TypeInfo(Int8), value);
  1528. CheckEquals(1, value.DataSize, 'Size of Int8 differs');
  1529. s16:=-5345;
  1530. TValue.Make(@s16, TypeInfo(Int16), value);
  1531. CheckEquals(2, value.DataSize, 'Size of Int16 differs');
  1532. s32:=-234567;
  1533. TValue.Make(@s32, TypeInfo(Int32), value);
  1534. CheckEquals(4, value.DataSize, 'Size of Int32 differs');
  1535. s64:=23456789012;
  1536. TValue.Make(@s64, TypeInfo(Int64), value);
  1537. CheckEquals(8, value.DataSize, 'Size of Int64 differs');
  1538. b8:=false;
  1539. TValue.Make(@b8, TypeInfo(Boolean), value);
  1540. CheckEquals(1, value.DataSize, 'Size of Boolean differs');
  1541. {$ifdef fpc}
  1542. b16:=true;
  1543. TValue.Make(@b16, TypeInfo(Boolean16), value);
  1544. CheckEquals(2, value.DataSize, 'Size of Boolean16 differs');
  1545. b32:=false;
  1546. TValue.Make(@b32, TypeInfo(Boolean32), value);
  1547. CheckEquals(4, value.DataSize, 'Size of Boolean32 differs');
  1548. b64:=true;
  1549. TValue.Make(@b64, TypeInfo(Boolean64), value);
  1550. CheckEquals(8, value.DataSize, 'Size of Boolean64 differs');
  1551. {$endif}
  1552. bl8:=true;
  1553. TValue.Make(@bl8, TypeInfo(ByteBool), value);
  1554. CheckEquals(1, value.DataSize, 'Size of ByteBool differs');
  1555. bl16:=false;
  1556. TValue.Make(@bl16, TypeInfo(WordBool), value);
  1557. CheckEquals(2, value.DataSize, 'Size of WordBool differs');
  1558. bl32:=false;
  1559. TValue.Make(@bl32, TypeInfo(LongBool), value);
  1560. CheckEquals(4, value.DataSize, 'Size of LongBool differs');
  1561. {$ifdef fpc}
  1562. bl64:=true;
  1563. TValue.Make(@bl64, TypeInfo(QWordBool), value);
  1564. CheckEquals(8, value.DataSize, 'Size of QWordBool differs');
  1565. {$endif}
  1566. f32:=4.567;
  1567. TValue.Make(@f32, TypeInfo(Single), value);
  1568. CheckEquals(4, value.DataSize, 'Size of Single differs');
  1569. f64:=-3456.678;
  1570. TValue.Make(@f64, TypeInfo(Double), value);
  1571. CheckEquals(8, value.DataSize, 'Size of Double differs');
  1572. {$ifdef FPC_HAS_TYPE_EXTENDED}
  1573. f80:=-2345.678;
  1574. TValue.Make(@f80, TypeInfo(Extended), value);
  1575. CheckEquals(10, value.DataSize, 'Size of Extended differs');
  1576. {$endif}
  1577. fcu:=56.78;
  1578. TValue.Make(@fcu, TypeInfo(Currency), value);
  1579. CheckEquals(SizeOf(Currency), value.DataSize, 'Size of Currency differs');
  1580. fco:=456;
  1581. TValue.Make(@fco, TypeInfo(Comp), value);
  1582. CheckEquals(SizeOf(Comp), value.DataSize, 'Size of Comp differs');
  1583. ss := '';
  1584. TValue.Make(@ss, TypeInfo(ShortString), value);
  1585. CheckEquals(254, value.DataSize, 'Size ofShortString differs');
  1586. sa:= '';
  1587. TValue.Make(@sa, TypeInfo(AnsiString), value);
  1588. CheckEquals(SizeOf(Pointer), value.DataSize, 'Size of AnsiString differs');
  1589. sw := '';
  1590. TValue.Make(@sw, TypeInfo(WideString), value);
  1591. CheckEquals(SizeOf(Pointer), value.DataSize, 'Size of WideString differs');
  1592. su:='';
  1593. TValue.Make(@su, TypeInfo(UnicodeString), value);
  1594. CheckEquals(SizeOf(Pointer), value.DataSize, 'Size of UnicodeString differs');
  1595. o := TTestValueClass.Create;
  1596. TValue.Make(@o, TypeInfo(TObject), value);
  1597. CheckEquals(SizeOf(Pointer), value.DataSize, 'Size of TObject differs');
  1598. o.Free;
  1599. c := TObject;
  1600. TValue.Make(@c, TypeInfo(TClass), value);
  1601. CheckEquals(SizeOf(Pointer), value.DataSize, 'Size of TClass differs');
  1602. i := Nil;
  1603. TValue.Make(@i, TypeInfo(IInterface), value);
  1604. CheckEquals(SizeOf(Pointer), value.DataSize, 'Size of IInterface differs');
  1605. TValue.Make(@t, TypeInfo(TTestRecord), value);
  1606. CheckEquals(SizeOf(TTestRecord), value.DataSize, 'Size of TTestRecord differs');
  1607. proc := Nil;
  1608. TValue.Make(@proc, TypeInfo(TTestProc), value);
  1609. CheckEquals(SizeOf(TTestProc), value.DataSize, 'Size of TTestProc differs');
  1610. method := Nil;
  1611. TValue.Make(@method, TypeInfo(TTestMethod), value);
  1612. CheckEquals(SizeOf(TTestMethod), value.DataSize, 'Size of TTestMethod differs');
  1613. TValue.Make(@_as, TypeInfo(TArrayOfLongintStatic), value);
  1614. CheckEquals(SizeOf(TArrayOfLongintStatic), value.DataSize, 'Size of TArrayOfLongintStatic differs');
  1615. TValue.Make(@ad, TypeInfo(TArrayOfLongintDyn), value);
  1616. CheckEquals(SizeOf(TArrayOfLongintDyn), value.DataSize, 'Size of TArrayOfLongintDyn differs');
  1617. e:=low(TTestEnum);
  1618. TValue.Make(@e, TypeInfo(TTestEnum), value);
  1619. CheckEquals(SizeOf(TTestEnum), value.DataSize, 'Size of TTestEnum differs');
  1620. s:=[low(TTestEnum),high(TTestEnum)];
  1621. TValue.Make(@s, TypeInfo(TTestSet), value);
  1622. CheckEquals(SizeOf(TTestSet), value.DataSize, 'Size of TTestSet differs');
  1623. p := Self;
  1624. TValue.Make(@p, TypeInfo(Pointer), value);
  1625. CheckEquals(SizeOf(Pointer), value.DataSize, 'Size of Pointer differs');
  1626. end;
  1627. procedure TTestValueGeneral.TestDataSizeEmpty;
  1628. var
  1629. value: TValue;
  1630. begin
  1631. TValue.Make(Nil, TypeInfo(UInt8), value);
  1632. CheckEquals(1, value.DataSize, 'Size of UInt8 differs');
  1633. TValue.Make(Nil, TypeInfo(UInt16), value);
  1634. CheckEquals(2, value.DataSize, 'Size of UInt16 differs');
  1635. TValue.Make(Nil, TypeInfo(UInt32), value);
  1636. CheckEquals(4, value.DataSize, 'Size of UInt32 differs');
  1637. TValue.Make(Nil, TypeInfo(UInt64), value);
  1638. CheckEquals(8, value.DataSize, 'Size of UInt64 differs');
  1639. TValue.Make(Nil, TypeInfo(Int8), value);
  1640. CheckEquals(1, value.DataSize, 'Size of Int8 differs');
  1641. TValue.Make(Nil, TypeInfo(Int16), value);
  1642. CheckEquals(2, value.DataSize, 'Size of Int16 differs');
  1643. TValue.Make(Nil, TypeInfo(Int32), value);
  1644. CheckEquals(4, value.DataSize, 'Size of Int32 differs');
  1645. TValue.Make(Nil, TypeInfo(Int64), value);
  1646. CheckEquals(8, value.DataSize, 'Size of Int64 differs');
  1647. TValue.Make(Nil, TypeInfo(Boolean), value);
  1648. CheckEquals(1, value.DataSize, 'Size of Boolean differs');
  1649. {$ifdef fpc}
  1650. TValue.Make(Nil, TypeInfo(Boolean16), value);
  1651. CheckEquals(2, value.DataSize, 'Size of Boolean16 differs');
  1652. TValue.Make(Nil, TypeInfo(Boolean32), value);
  1653. CheckEquals(4, value.DataSize, 'Size of Boolean32 differs');
  1654. TValue.Make(Nil, TypeInfo(Boolean64), value);
  1655. CheckEquals(8, value.DataSize, 'Size of Boolean64 differs');
  1656. {$endif}
  1657. TValue.Make(Nil, TypeInfo(ByteBool), value);
  1658. CheckEquals(1, value.DataSize, 'Size of ByteBool differs');
  1659. TValue.Make(Nil, TypeInfo(WordBool), value);
  1660. CheckEquals(2, value.DataSize, 'Size of WordBool differs');
  1661. TValue.Make(Nil, TypeInfo(LongBool), value);
  1662. CheckEquals(4, value.DataSize, 'Size of LongBool differs');
  1663. {$ifdef fpc}
  1664. TValue.Make(Nil, TypeInfo(QWordBool), value);
  1665. CheckEquals(8, value.DataSize, 'Size of QWordBool differs');
  1666. {$endif}
  1667. TValue.Make(Nil, TypeInfo(Single), value);
  1668. CheckEquals(4, value.DataSize, 'Size of Single differs');
  1669. TValue.Make(Nil, TypeInfo(Double), value);
  1670. CheckEquals(8, value.DataSize, 'Size of Double differs');
  1671. {$ifdef FPC_HAS_TYPE_EXTENDED}
  1672. TValue.Make(Nil, TypeInfo(Extended), value);
  1673. CheckEquals(10, value.DataSize, 'Size of Extended differs');
  1674. {$endif}
  1675. TValue.Make(Nil, TypeInfo(Currency), value);
  1676. CheckEquals(SizeOf(Currency), value.DataSize, 'Size of Currency differs');
  1677. TValue.Make(Nil, TypeInfo(Comp), value);
  1678. CheckEquals(SizeOf(Comp), value.DataSize, 'Size of Comp differs');
  1679. TValue.Make(Nil, TypeInfo(ShortString), value);
  1680. CheckEquals(254, value.DataSize, 'Size of ShortString differs');
  1681. TValue.Make(Nil, TypeInfo(AnsiString), value);
  1682. CheckEquals(SizeOf(Pointer), value.DataSize, 'Size of Pointer differs');
  1683. TValue.Make(Nil, TypeInfo(WideString), value);
  1684. CheckEquals(SizeOf(Pointer), value.DataSize, 'Size of WideString differs');
  1685. TValue.Make(Nil, TypeInfo(UnicodeString), value);
  1686. CheckEquals(SizeOf(Pointer), value.DataSize, 'Size of UnicodeString differs');
  1687. TValue.Make(Nil, TypeInfo(TObject), value);
  1688. CheckEquals(SizeOf(Pointer), value.DataSize, 'Size of TObject differs');
  1689. TValue.Make(Nil, TypeInfo(TClass), value);
  1690. CheckEquals(SizeOf(Pointer), value.DataSize, 'Size of TClass differs');
  1691. TValue.Make(Nil, TypeInfo(IInterface), value);
  1692. CheckEquals(SizeOf(Pointer), value.DataSize, 'Size of IInterface differs');
  1693. TValue.Make(Nil, TypeInfo(TTestRecord), value);
  1694. CheckEquals(SizeOf(TTestRecord), value.DataSize, 'Size of TTestRecord differs');
  1695. TValue.Make(Nil, TypeInfo(TTestProc), value);
  1696. CheckEquals(SizeOf(TTestProc), value.DataSize, 'Size of TTestProc differs');
  1697. TValue.Make(Nil, TypeInfo(TTestMethod), value);
  1698. CheckEquals(SizeOf(TTestMethod), value.DataSize, 'Size of TTestMethod differs');
  1699. TValue.Make(Nil, TypeInfo(TArrayOfLongintStatic), value);
  1700. CheckEquals(SizeOf(TArrayOfLongintStatic), value.DataSize, 'Size of TArrayOfLongintStatic differs');
  1701. TValue.Make(Nil, TypeInfo(TArrayOfLongintDyn), value);
  1702. CheckEquals(SizeOf(TArrayOfLongintDyn), value.DataSize, 'Size of TArrayOfLongintDyn differs');
  1703. TValue.Make(Nil, TypeInfo(TTestEnum), value);
  1704. CheckEquals(SizeOf(TTestEnum), value.DataSize, 'Size of TTestEnum differs');
  1705. TValue.Make(Nil, TypeInfo(TTestSet), value);
  1706. CheckEquals(SizeOf(TTestSet), value.DataSize, 'Size of TTestSet differs');
  1707. TValue.Make(Nil, TypeInfo(Pointer), value);
  1708. CheckEquals(SizeOf(Pointer), value.DataSize, 'Size of Pointer differs');
  1709. end;
  1710. procedure TTestValueGeneral.TestIsManaged;
  1711. begin
  1712. CheckEquals(true, IsManaged(TypeInfo(ansistring)), 'IsManaged for tkAString');
  1713. CheckEquals(true, IsManaged(TypeInfo(widestring)), 'IsManaged for tkWString');
  1714. CheckEquals(true, IsManaged(TypeInfo(Variant)), 'IsManaged for tkVariant');
  1715. CheckEquals(true, IsManaged(TypeInfo(TArrayOfManagedRec)),
  1716. 'IsManaged for tkArray (with managed ElType)');
  1717. CheckEquals(true, IsManaged(TypeInfo(TArrayOfString)),
  1718. 'IsManaged for tkArray (with managed ElType)');
  1719. CheckEquals(true, IsManaged(TypeInfo(TManagedRec)), 'IsManaged for tkRecord');
  1720. {$ifdef fpc}
  1721. CheckEquals(true, IsManaged(TypeInfo(TManagedRecOp)), 'IsManaged for tkRecord');
  1722. {$endif}
  1723. CheckEquals(true, IsManaged(TypeInfo(IInterface)), 'IsManaged for tkInterface');
  1724. CheckEquals(true, IsManaged(TypeInfo(TManagedObj)), 'IsManaged for tkObject');
  1725. {$ifdef fpc}
  1726. CheckEquals(true, IsManaged(TypeInfo(specialize TArray<byte>)), 'IsManaged for tkDynArray');
  1727. {$else}
  1728. CheckEquals(true, IsManaged(TypeInfo(TArray<byte>)), 'IsManaged for tkDynArray');
  1729. {$endif}
  1730. CheckEquals(true, IsManaged(TypeInfo(unicodestring)), 'IsManaged for tkUString');
  1731. CheckEquals(false, IsManaged(TypeInfo(shortstring)), 'IsManaged for tkSString');
  1732. CheckEquals(false, IsManaged(TypeInfo(Byte)), 'IsManaged for tkInteger');
  1733. CheckEquals(false, IsManaged(TypeInfo(Char)), 'IsManaged for tkChar');
  1734. CheckEquals(false, IsManaged(TypeInfo(TTestEnum)), 'IsManaged for tkEnumeration');
  1735. CheckEquals(false, IsManaged(TypeInfo(Single)), 'IsManaged for tkFloat');
  1736. CheckEquals(false, IsManaged(TypeInfo(TTestSet)), 'IsManaged for tkSet');
  1737. {$ifdef fpc}
  1738. CheckEquals(false, IsManaged(TypeInfo(TTestMethod)), 'IsManaged for tkMethod');
  1739. {$else}
  1740. { Delphi bug (or sabotage). For some reason Delphi considers method pointers to be managed (only in newer versions, probably since XE7) :/ }
  1741. CheckEquals({$if RTLVersion>=28}true{$else}false{$endif}, IsManaged(TypeInfo(TTestMethod)), 'IsManaged for tkMethod');
  1742. {$endif}
  1743. CheckEquals(false, IsManaged(TypeInfo(TArrayOfByte)),
  1744. 'IsManaged for tkArray (with non managed ElType)');
  1745. CheckEquals(false, IsManaged(TypeInfo(TArrayOfNonManagedRec)),
  1746. 'IsManaged for tkArray (with non managed ElType)');
  1747. CheckEquals(false, IsManaged(TypeInfo(TNonManagedRec)), 'IsManaged for tkRecord');
  1748. CheckEquals(false, IsManaged(TypeInfo(TObject)), 'IsManaged for tkClass');
  1749. CheckEquals(false, IsManaged(TypeInfo(TNonManagedObj)), 'IsManaged for tkObject');
  1750. CheckEquals(false, IsManaged(TypeInfo(WideChar)), 'IsManaged for tkWChar');
  1751. CheckEquals(false, IsManaged(TypeInfo(Boolean)), 'IsManaged for tkBool');
  1752. CheckEquals(false, IsManaged(TypeInfo(Int64)), 'IsManaged for tkInt64');
  1753. CheckEquals(false, IsManaged(TypeInfo(UInt64)), 'IsManaged for tkQWord');
  1754. {$ifdef fpc}
  1755. CheckEquals(false, IsManaged(TypeInfo(ICORBATest)), 'IsManaged for tkInterfaceRaw');
  1756. {$endif}
  1757. CheckEquals(false, IsManaged(TypeInfo(TTestProc)), 'IsManaged for tkProcVar');
  1758. CheckEquals(false, IsManaged(TypeInfo(TTestHelper)), 'IsManaged for tkHelper');
  1759. {$ifdef fpc}
  1760. CheckEquals(false, IsManaged(TypeInfo(file)), 'IsManaged for tkFile');
  1761. {$endif}
  1762. CheckEquals(false, IsManaged(TypeInfo(TClass)), 'IsManaged for tkClassRef');
  1763. CheckEquals(false, IsManaged(TypeInfo(Pointer)), 'IsManaged for tkPointer');
  1764. CheckEquals(false, IsManaged(nil), 'IsManaged for nil');
  1765. end;
  1766. Type
  1767. TEnum1 = (en1_1, en1_2);
  1768. TEnum2 = (en2_1);
  1769. TEnum3 = en1_1..en1_1;
  1770. procedure TTestValueGeneral.TestCasts;
  1771. var
  1772. TempV,T1,T2,T3 : TValue;
  1773. begin
  1774. T1:=TValue. specialize From<TEnum1>(en1_1);
  1775. T2:=T1. specialize Cast<TEnum3>;
  1776. // T3:=T2. specialize AsType<TEnum3>;
  1777. CheckTrue((en1_1 = T2. specialize AsType<TEnum3>), 'en1_1 = (TValue.From<TEnum1>(en1_1).Cast<TEnum3>.AsType<TEnum3>)');
  1778. CheckFalse(TValue. specialize From<Integer>(32).TryCast(TypeInfo(AnsiChar), TempV), 'not (TValue.From<Integer>(32).TryCast(TypeInfo(AnsiChar), V)');
  1779. CheckFalse(TValue. specialize From<Integer>(32).TryCast(TypeInfo(WideChar), TempV), 'not (TValue.From<Integer>(32).TryCast(TypeInfo(WideChar), V)');
  1780. {$ifdef fpc}
  1781. CheckFalse(TValue. specialize From<Integer>(32).TryCast(TypeInfo(UnicodeChar), TempV), 'not (TValue.From<Integer>(32).TryCast(TypeInfo(UnicodeChar), V)');
  1782. {$endif}
  1783. CheckTrue(Byte(397) = (TValue. specialize From<Integer>(397). specialize Cast<Byte>(). specialize AsType<Byte>), 'Byte(397) = (TValue.From<Integer>(397).Cast<Byte>().AsType<Byte>)');
  1784. CheckTrue(32 = (TValue. specialize From<Byte>(32). specialize Cast<Integer>(). specialize AsType<Integer>), '32 = (TValue.From<Byte>(32).Cast<Integer>().AsType<Integer>)');
  1785. CheckTrue('test_str' = TValue.{$ifdef fpc}specialize{$endif} From<ShortString>('test_str')
  1786. .{$ifdef fpc}specialize{$endif} Cast<AnsiString>
  1787. .{$ifdef fpc}specialize{$endif} AsType<AnsiString>, 'TValue.From<shortring>.Cast<AnsiString> failed');
  1788. end;
  1789. procedure TTestValueGeneral.TestAssignPointer;
  1790. var
  1791. V : TValue;
  1792. begin
  1793. V:=Pointer(Nil);
  1794. AssertSame('Correct type info', TypeInfo(Pointer),V.TypeInfo);
  1795. end;
  1796. procedure TTestValueGeneral.TestAssignDateTime;
  1797. var
  1798. dt: TDateTime;
  1799. v: TValue;
  1800. begin
  1801. dt := Now;
  1802. v := dt;
  1803. AssertSame('Incorrect type info', TypeInfo(TDateTime), V.TypeInfo);
  1804. CheckEquals(dt, V.AsDateTime, 'Incorrect value');
  1805. end;
  1806. procedure TTestValueGeneral.TestAssignDate;
  1807. var
  1808. d: TDate;
  1809. v: TValue;
  1810. begin
  1811. d := Date;
  1812. v := d;
  1813. AssertSame('Incorrect type info', TypeInfo(TDate), V.TypeInfo);
  1814. CheckEquals(d, V.AsDateTime, 'Incorrect value');
  1815. end;
  1816. procedure TTestValueGeneral.TestAssignTime;
  1817. var
  1818. t: TTime;
  1819. v: TValue;
  1820. begin
  1821. t := Time;
  1822. v := t;
  1823. AssertSame('Incorrect type info', TypeInfo(TTime), V.TypeInfo);
  1824. CheckEquals(t, V.AsDateTime, 'Incorrect value');
  1825. end;
  1826. procedure TTestValueGeneral.TestReferenceRawData;
  1827. var
  1828. value: TValue;
  1829. str: String;
  1830. intf: IInterface;
  1831. i: LongInt;
  1832. test: TTestRecord;
  1833. arrdyn: TArrayOfLongintDyn;
  1834. arrstat: TArrayOfLongintStatic;
  1835. begin
  1836. str := 'Hello World';
  1837. UniqueString(str);
  1838. TValue.Make(@str, TypeInfo(String), value);
  1839. Check(PPointer(value.GetReferenceToRawData)^ = Pointer(str), 'Reference to string data differs');
  1840. intf := TInterfacedObject.Create;
  1841. TValue.Make(@intf, TypeInfo(IInterface), value);
  1842. Check(PPointer(value.GetReferenceToRawData)^ = Pointer(intf), 'Reference to interface data differs');
  1843. i := 42;
  1844. TValue.Make(@i, TypeInfo(LongInt), value);
  1845. Check(value.GetReferenceToRawData <> @i, 'Reference to longint is equal');
  1846. Check(PLongInt(value.GetReferenceToRawData)^ = PLongInt(@i)^, 'Reference to longint data differs');
  1847. test.value1 := 42;
  1848. test.value2 := 'Hello World';
  1849. TValue.Make(@test, TypeInfo(TTestRecord), value);
  1850. Check(value.GetReferenceToRawData <> @test, 'Reference to record is equal');
  1851. Check(PTestRecord(value.GetReferenceToRawData)^.value1 = PTestRecord(@test)^.value1, 'Reference to record data value1 differs');
  1852. Check(PTestRecord(value.GetReferenceToRawData)^.value2 = PTestRecord(@test)^.value2, 'Reference to record data value2 differs');
  1853. SetLength(arrdyn, 3);
  1854. arrdyn[0] := 42;
  1855. arrdyn[1] := 23;
  1856. arrdyn[2] := 49;
  1857. TValue.Make(@arrdyn, TypeInfo(TArrayOfLongintDyn), value);
  1858. Check(PPointer(value.GetReferenceToRawData)^ = Pointer(arrdyn), 'Reference to dynamic array data differs');
  1859. arrstat[0] := 42;
  1860. arrstat[1] := 23;
  1861. arrstat[2] := 49;
  1862. arrstat[3] := 59;
  1863. TValue.Make(@arrstat, TypeInfo(TArrayOfLongintStatic), value);
  1864. Check(value.GetReferenceToRawData <> @arrstat, 'Reference to static array is equal');
  1865. Check(PLongInt(value.GetReferenceToRawData)^ = PLongInt(@arrstat)^, 'Reference to static array data differs');
  1866. end;
  1867. procedure TTestValueGeneral.TestReferenceRawDataEmpty;
  1868. var
  1869. value: TValue;
  1870. begin
  1871. TValue.Make(Nil, TypeInfo(String), value);
  1872. Check(Assigned(value.GetReferenceToRawData()), 'Reference to empty String is not assigned');
  1873. Check(not Assigned(PPointer(value.GetReferenceToRawData)^), 'Empty String data is assigned');
  1874. TValue.Make(Nil, TypeInfo(IInterface), value);
  1875. Check(Assigned(value.GetReferenceToRawData()), 'Reference to empty interface is not assigned');
  1876. Check(not Assigned(PPointer(value.GetReferenceToRawData)^), 'Empty interface data is assigned');
  1877. TValue.Make(Nil, TypeInfo(LongInt), value);
  1878. Check(Assigned(value.GetReferenceToRawData()), 'Reference to empty LongInt is not assigned');
  1879. Check(PLongInt(value.GetReferenceToRawData)^ = 0, 'Empty longint data is not 0');
  1880. TValue.Make(Nil, TypeInfo(TTestRecord), value);
  1881. Check(Assigned(value.GetReferenceToRawData()), 'Reference to empty record is not assigned');
  1882. Check(PTestRecord(value.GetReferenceToRawData)^.value1 = 0, 'Empty record data value1 is not 0');
  1883. Check(PTestRecord(value.GetReferenceToRawData)^.value2 = '', 'Empty record data value2 is not empty');
  1884. TValue.Make(Nil, TypeInfo(TArrayOfLongintDyn), value);
  1885. Check(Assigned(value.GetReferenceToRawData()), 'Reference to empty dynamic array is not assigned');
  1886. Check(not Assigned(PPointer(value.GetReferenceToRawData)^), 'Empty dynamic array data is assigned');
  1887. TValue.Make(Nil, TypeInfo(TArrayOfLongintStatic), value);
  1888. Check(Assigned(value.GetReferenceToRawData()), 'Reference to empty static array is not assigned');
  1889. Check(PLongInt(value.GetReferenceToRawData)^ = 0, 'Empty static array data is not 0');
  1890. end;
  1891. initialization
  1892. RegisterTest(TTestValueGeneral);
  1893. RegisterTest(TTestValueSimple);
  1894. RegisterTest(TTestValueSimple);
  1895. RegisterTest(TTestValueVariant);
  1896. end.