tests.value.pas 57 KB

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