tests.value.pas 58 KB

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