tests.rtti.value.pas 59 KB

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