tests.rtti.pas 39 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267
  1. unit tests.rtti;
  2. {$ifdef fpc}
  3. {$mode objfpc}{$H+}
  4. {$modeswitch advancedrecords}
  5. {$endif}
  6. interface
  7. uses
  8. {$IFDEF FPC}
  9. fpcunit,testregistry, testutils,
  10. {$ELSE FPC}
  11. TestFramework,
  12. {$ENDIF FPC}
  13. Classes, SysUtils, typinfo,
  14. Rtti;
  15. type
  16. { TTestCase1 }
  17. TTestCase1= class(TTestCase)
  18. published
  19. //procedure GetTypes;
  20. procedure GetTypeInteger;
  21. procedure GetTypePointer;
  22. procedure GetClassProperties;
  23. procedure GetClassPropertiesValue;
  24. procedure TestTRttiTypeProperties;
  25. procedure TestPropGetValueString;
  26. procedure TestPropGetValueInteger;
  27. procedure TestPropGetValueBoolean;
  28. procedure TestPropGetValueShortString;
  29. procedure TestPropGetValueProcString;
  30. procedure TestPropGetValueProcInteger;
  31. procedure TestPropGetValueProcBoolean;
  32. procedure TestPropGetValueProcShortString;
  33. procedure TestPropSetValueString;
  34. procedure TestPropSetValueInteger;
  35. procedure TestPropSetValueBoolean;
  36. procedure TestPropSetValueShortString;
  37. procedure TestGetValueStringCastError;
  38. procedure TestGetIsReadable;
  39. procedure TestIsWritable;
  40. procedure TestMakeNil;
  41. procedure TestMakeObject;
  42. procedure TestMakeArrayDynamic;
  43. procedure TestMakeArrayStatic;
  44. procedure TestDataSize;
  45. procedure TestDataSizeEmpty;
  46. procedure TestReferenceRawData;
  47. procedure TestReferenceRawDataEmpty;
  48. procedure TestIsManaged;
  49. end;
  50. implementation
  51. type
  52. {$M+}
  53. TGetClassProperties = class
  54. private
  55. FPubPropRO: integer;
  56. FPubPropRW: integer;
  57. published
  58. property PubPropRO: integer read FPubPropRO;
  59. property PubPropRW: integer read FPubPropRW write FPubPropRW;
  60. property PubPropSetRO: integer read FPubPropRO;
  61. property PubPropSetRW: integer read FPubPropRW write FPubPropRW;
  62. end;
  63. {$M-}
  64. { TTestValueClass }
  65. {$M+}
  66. TTestValueClass = class
  67. private
  68. FAInteger: integer;
  69. FAString: string;
  70. FABoolean: boolean;
  71. FAShortString: ShortString;
  72. function GetAInteger: integer;
  73. function GetAString: string;
  74. function GetABoolean: boolean;
  75. function GetAShortString: ShortString;
  76. procedure SetWriteOnly(AValue: integer);
  77. published
  78. property AInteger: Integer read FAInteger write FAInteger;
  79. property AString: string read FAString write FAString;
  80. property ABoolean: boolean read FABoolean write FABoolean;
  81. property AShortString: ShortString read FAShortString write FAShortString;
  82. property AGetInteger: Integer read GetAInteger;
  83. property AGetString: string read GetAString;
  84. property AGetBoolean: boolean read GetABoolean;
  85. property AGetShortString: ShortString read GetAShortString;
  86. property AWriteOnly: integer write SetWriteOnly;
  87. end;
  88. {$M-}
  89. TManagedRec = record
  90. s: string;
  91. end;
  92. {$ifdef fpc}
  93. TManagedRecOp = record
  94. class operator AddRef(var a: TManagedRecOp);
  95. end;
  96. {$endif}
  97. TNonManagedRec = record
  98. i: Integer;
  99. end;
  100. TManagedObj = object
  101. i: IInterface;
  102. end;
  103. TNonManagedObj = object
  104. d: double;
  105. end;
  106. TTestEnum = (te1, te2, te3, te4, te5);
  107. TTestSet = set of TTestEnum;
  108. TTestProc = procedure;
  109. TTestMethod = procedure of object;
  110. TTestHelper = class helper for TObject
  111. end;
  112. TArrayOfString = array[0..0] of string;
  113. TArrayOfManagedRec = array[0..0] of TManagedRec;
  114. TArrayOfNonManagedRec = array[0..0] of TNonManagedRec;
  115. TArrayOfByte = array[0..0] of byte;
  116. TArrayOfLongintDyn = array of LongInt;
  117. TArrayOfLongintStatic = array[0..3] of LongInt;
  118. TTestRecord = record
  119. Value1: LongInt;
  120. Value2: String;
  121. end;
  122. PTestRecord = ^TTestRecord;
  123. {$ifdef fpc}
  124. {$PUSH}
  125. {$INTERFACES CORBA}
  126. ICORBATest = interface
  127. end;
  128. {$POP}
  129. {$endif}
  130. {$ifdef fpc}
  131. class operator TManagedRecOp.AddRef(var a: TManagedRecOp);
  132. begin
  133. end;
  134. {$endif}
  135. { TTestValueClass }
  136. function TTestValueClass.GetAInteger: integer;
  137. begin
  138. result := FAInteger;
  139. end;
  140. function TTestValueClass.GetAString: string;
  141. begin
  142. result := FAString;
  143. end;
  144. function TTestValueClass.GetABoolean: boolean;
  145. begin
  146. result := FABoolean;
  147. end;
  148. function TTestValueClass.GetAShortString: ShortString;
  149. begin
  150. Result := FAShortString;
  151. end;
  152. procedure TTestValueClass.SetWriteOnly(AValue: integer);
  153. begin
  154. // Do nothing
  155. end;
  156. { Note: GetTypes currently only returns those types that had been acquired using
  157. GetType, so GetTypes itself can't be really tested currently }
  158. (*procedure TTestCase1.GetTypes;
  159. var
  160. LContext: TRttiContext;
  161. LType: TRttiType;
  162. IsTestCaseClassFound: boolean;
  163. begin
  164. LContext := TRttiContext.Create;
  165. { Enumerate all types declared in the application }
  166. for LType in LContext.GetTypes() do
  167. begin
  168. if LType.Name='TTestCase1' then
  169. IsTestCaseClassFound:=true;
  170. end;
  171. LContext.Free;
  172. CheckTrue(IsTestCaseClassFound, 'RTTI information does not contain class of testcase.');
  173. end;*)
  174. procedure TTestCase1.TestGetValueStringCastError;
  175. var
  176. ATestClass : TTestValueClass;
  177. c: TRttiContext;
  178. ARttiType: TRttiType;
  179. AValue: TValue;
  180. i: integer;
  181. HadException: boolean;
  182. begin
  183. c := TRttiContext.Create;
  184. try
  185. ATestClass := TTestValueClass.Create;
  186. ATestClass.AString := '12';
  187. try
  188. ARttiType := c.GetType(ATestClass.ClassInfo);
  189. AValue := ARttiType.GetProperty('astring').GetValue(ATestClass);
  190. HadException := false;
  191. try
  192. i := AValue.AsInteger;
  193. except
  194. on E: Exception do
  195. if E.ClassType=EInvalidCast then
  196. HadException := true;
  197. end;
  198. Check(HadException, 'No or invalid exception on invalid cast');
  199. finally
  200. AtestClass.Free;
  201. end;
  202. finally
  203. c.Free;
  204. end;
  205. end;
  206. procedure TTestCase1.TestMakeNil;
  207. var
  208. value: TValue;
  209. begin
  210. TValue.Make(Nil, Nil, value);
  211. CheckTrue(value.Kind = tkUnknown);
  212. CheckTrue(value.IsEmpty);
  213. CheckTrue(value.IsObject);
  214. CheckTrue(value.IsClass);
  215. CheckTrue(value.IsOrdinal);
  216. CheckFalse(value.IsArray);
  217. CheckTrue(value.AsObject = Nil);
  218. CheckTrue(value.AsClass = Nil);
  219. CheckTrue(value.AsInterface = Nil);
  220. CheckEquals(0, value.AsOrdinal);
  221. TValue.Make(Nil, TypeInfo(TObject), value);
  222. CheckTrue(value.IsEmpty);
  223. CheckTrue(value.IsObject);
  224. CheckTrue(value.IsClass);
  225. CheckTrue(value.IsOrdinal);
  226. CheckFalse(value.IsArray);
  227. CheckTrue(value.AsObject=Nil);
  228. CheckTrue(value.AsClass=Nil);
  229. CheckTrue(value.AsInterface=Nil);
  230. CheckEquals(0, value.AsOrdinal);
  231. TValue.Make(Nil, TypeInfo(TClass), value);
  232. CheckTrue(value.IsEmpty);
  233. CheckTrue(value.IsClass);
  234. CheckTrue(value.IsOrdinal);
  235. CheckFalse(value.IsArray);
  236. CheckTrue(value.AsObject=Nil);
  237. CheckTrue(value.AsClass=Nil);
  238. CheckTrue(value.AsInterface=Nil);
  239. CheckEquals(0, value.AsOrdinal);
  240. TValue.Make(Nil, TypeInfo(LongInt), value);
  241. CheckTrue(value.IsOrdinal);
  242. CheckFalse(value.IsEmpty);
  243. CheckFalse(value.IsClass);
  244. CheckFalse(value.IsObject);
  245. CheckFalse(value.IsArray);
  246. CheckEquals(0, value.AsOrdinal);
  247. CheckEquals(0, value.AsInteger);
  248. CheckEquals(0, value.AsInt64);
  249. CheckEquals(0, value.AsUInt64);
  250. TValue.Make(Nil, TypeInfo(String), value);
  251. CheckFalse(value.IsEmpty);
  252. CheckFalse(value.IsObject);
  253. CheckFalse(value.IsClass);
  254. CheckFalse(value.IsArray);
  255. CheckEquals('', value.AsString);
  256. end;
  257. procedure TTestCase1.TestMakeObject;
  258. var
  259. AValue: TValue;
  260. ATestClass: TTestValueClass;
  261. begin
  262. ATestClass := TTestValueClass.Create;
  263. ATestClass.AInteger := 54329;
  264. TValue.Make(@ATestClass, TypeInfo(TTestValueClass),AValue);
  265. CheckEquals(AValue.IsClass, False);
  266. CheckEquals(AValue.IsObject, True);
  267. Check(AValue.AsObject=ATestClass);
  268. CheckEquals(TTestValueClass(AValue.AsObject).AInteger, 54329);
  269. ATestClass.Free;
  270. end;
  271. procedure TTestCase1.TestMakeArrayDynamic;
  272. var
  273. arr: TArrayOfLongintDyn;
  274. value: TValue;
  275. begin
  276. SetLength(arr, 2);
  277. arr[0] := 42;
  278. arr[1] := 21;
  279. TValue.Make(@arr, TypeInfo(TArrayOfLongintDyn), value);
  280. CheckEquals(value.IsArray, True);
  281. CheckEquals(value.IsObject, False);
  282. CheckEquals(value.IsOrdinal, False);
  283. CheckEquals(value.IsClass, False);
  284. CheckEquals(value.GetArrayLength, 2);
  285. CheckEquals(value.GetArrayElement(0).AsInteger, 42);
  286. CheckEquals(value.GetArrayElement(1).AsInteger, 21);
  287. value.SetArrayElement(0, 84);
  288. CheckEquals(arr[0], 84);
  289. end;
  290. procedure TTestCase1.TestMakeArrayStatic;
  291. type
  292. TArrStat = array[0..1] of LongInt;
  293. TArrStat2D = array[0..1, 0..1] of LongInt;
  294. var
  295. arr: TArrStat;
  296. arr2D: TArrStat2D;
  297. value: TValue;
  298. begin
  299. arr[0] := 42;
  300. arr[1] := 21;
  301. TValue.Make(@arr, TypeInfo(TArrStat), value);
  302. CheckEquals(value.IsArray, True);
  303. CheckEquals(value.IsObject, False);
  304. CheckEquals(value.IsOrdinal, False);
  305. CheckEquals(value.IsClass, False);
  306. CheckEquals(value.GetArrayLength, 2);
  307. CheckEquals(value.GetArrayElement(0).AsInteger, 42);
  308. CheckEquals(value.GetArrayElement(1).AsInteger, 21);
  309. value.SetArrayElement(0, 84);
  310. { since this is a static array the original array isn't touched! }
  311. CheckEquals(arr[0], 42);
  312. arr2D[0, 0] := 42;
  313. arr2D[0, 1] := 21;
  314. arr2D[1, 0] := 84;
  315. arr2D[1, 1] := 63;
  316. TValue.Make(@arr2D, TypeInfo(TArrStat2D), value);
  317. CheckEquals(value.IsArray, True);
  318. CheckEquals(value.GetArrayLength, 4);
  319. CheckEquals(value.GetArrayElement(0).AsInteger, 42);
  320. CheckEquals(value.GetArrayElement(1).AsInteger, 21);
  321. CheckEquals(value.GetArrayElement(2).AsInteger, 84);
  322. CheckEquals(value.GetArrayElement(3).AsInteger, 63);
  323. end;
  324. procedure TTestCase1.TestGetIsReadable;
  325. var
  326. c: TRttiContext;
  327. ARttiType: TRttiType;
  328. AProperty: TRttiProperty;
  329. begin
  330. c := TRttiContext.Create;
  331. try
  332. ARttiType := c.GetType(TTestValueClass);
  333. AProperty := ARttiType.GetProperty('aBoolean');
  334. CheckEquals(AProperty.IsReadable, true);
  335. AProperty := ARttiType.GetProperty('aGetBoolean');
  336. CheckEquals(AProperty.IsReadable, true);
  337. AProperty := ARttiType.GetProperty('aWriteOnly');
  338. CheckEquals(AProperty.IsReadable, False);
  339. finally
  340. c.Free;
  341. end;
  342. end;
  343. procedure TTestCase1.TestIsWritable;
  344. var
  345. c: TRttiContext;
  346. ARttiType: TRttiType;
  347. AProperty: TRttiProperty;
  348. begin
  349. c := TRttiContext.Create;
  350. try
  351. ARttiType := c.GetType(TTestValueClass);
  352. AProperty := ARttiType.GetProperty('aBoolean');
  353. CheckEquals(AProperty.IsWritable, true);
  354. AProperty := ARttiType.GetProperty('aGetBoolean');
  355. CheckEquals(AProperty.IsWritable, false);
  356. AProperty := ARttiType.GetProperty('aWriteOnly');
  357. CheckEquals(AProperty.IsWritable, True);
  358. finally
  359. c.Free;
  360. end;
  361. end;
  362. procedure TTestCase1.TestPropGetValueBoolean;
  363. var
  364. ATestClass : TTestValueClass;
  365. c: TRttiContext;
  366. ARttiType: TRttiType;
  367. AProperty: TRttiProperty;
  368. AValue: TValue;
  369. begin
  370. c := TRttiContext.Create;
  371. try
  372. ATestClass := TTestValueClass.Create;
  373. ATestClass.ABoolean := true;
  374. try
  375. ARttiType := c.GetType(ATestClass.ClassInfo);
  376. Check(assigned(ARttiType));
  377. AProperty := ARttiType.GetProperty('aBoolean');
  378. AValue := AProperty.GetValue(ATestClass);
  379. CheckEquals(true,AValue.AsBoolean);
  380. ATestClass.ABoolean := false;
  381. CheckEquals(true, AValue.AsBoolean);
  382. CheckEquals('True', AValue.ToString);
  383. CheckEquals(True, AValue.IsOrdinal);
  384. CheckEquals(1, AValue.AsOrdinal);
  385. finally
  386. AtestClass.Free;
  387. end;
  388. CheckEquals(True,AValue.AsBoolean);
  389. finally
  390. c.Free;
  391. end;
  392. end;
  393. procedure TTestCase1.TestPropGetValueShortString;
  394. var
  395. ATestClass : TTestValueClass;
  396. c: TRttiContext;
  397. ARttiType: TRttiType;
  398. AProperty: TRttiProperty;
  399. AValue: TValue;
  400. begin
  401. c := TRttiContext.Create;
  402. try
  403. ATestClass := TTestValueClass.Create;
  404. ATestClass.AShortString := 'Hello World';
  405. try
  406. ARttiType := c.GetType(ATestClass.ClassInfo);
  407. Check(assigned(ARttiType));
  408. AProperty := ARttiType.GetProperty('aShortString');
  409. AValue := AProperty.GetValue(ATestClass);
  410. CheckEquals('Hello World',AValue.AsString);
  411. ATestClass.AShortString := 'Foobar';
  412. CheckEquals('Hello World', AValue.AsString);
  413. CheckEquals(False, AValue.IsOrdinal);
  414. CheckEquals(False, AValue.IsObject);
  415. CheckEquals(False, AValue.IsArray);
  416. CheckEquals(False, AValue.IsClass);
  417. finally
  418. AtestClass.Free;
  419. end;
  420. CheckEquals('Hello World',AValue.AsString);
  421. finally
  422. c.Free;
  423. end;
  424. end;
  425. procedure TTestCase1.TestPropGetValueInteger;
  426. var
  427. ATestClass : TTestValueClass;
  428. c: TRttiContext;
  429. ARttiType: TRttiType;
  430. AProperty: TRttiProperty;
  431. AValue: TValue;
  432. begin
  433. c := TRttiContext.Create;
  434. try
  435. ATestClass := TTestValueClass.Create;
  436. ATestClass.AInteger := 472349;
  437. try
  438. ARttiType := c.GetType(ATestClass.ClassInfo);
  439. Check(assigned(ARttiType));
  440. AProperty := ARttiType.GetProperty('ainteger');
  441. AValue := AProperty.GetValue(ATestClass);
  442. CheckEquals(472349,AValue.AsInteger);
  443. ATestClass.AInteger := 12;
  444. CheckEquals(472349, AValue.AsInteger);
  445. CheckEquals('472349', AValue.ToString);
  446. CheckEquals(True, AValue.IsOrdinal);
  447. finally
  448. AtestClass.Free;
  449. end;
  450. CheckEquals(472349,AValue.AsInteger);
  451. finally
  452. c.Free;
  453. end;
  454. end;
  455. procedure TTestCase1.TestPropGetValueString;
  456. var
  457. ATestClass : TTestValueClass;
  458. c: TRttiContext;
  459. ARttiType: TRttiType;
  460. AProperty: TRttiProperty;
  461. AValue: TValue;
  462. i: int64;
  463. begin
  464. c := TRttiContext.Create;
  465. try
  466. ATestClass := TTestValueClass.Create;
  467. ATestClass.AString := 'Hello World';
  468. try
  469. ARttiType := c.GetType(ATestClass.ClassInfo);
  470. Check(assigned(ARttiType));
  471. AProperty := ARttiType.GetProperty('astring');
  472. AValue := AProperty.GetValue(ATestClass);
  473. CheckEquals('Hello World',AValue.AsString);
  474. ATestClass.AString := 'Goodbye World';
  475. CheckEquals('Hello World',AValue.AsString);
  476. CheckEquals('Hello World',AValue.ToString);
  477. Check(TypeInfo(string)=AValue.TypeInfo);
  478. Check(AValue.TypeData=GetTypeData(AValue.TypeInfo));
  479. Check(AValue.IsEmpty=false);
  480. Check(AValue.IsObject=false);
  481. Check(AValue.IsClass=false);
  482. CheckEquals(AValue.IsOrdinal, false);
  483. CheckEquals(AValue.TryAsOrdinal(i), false);
  484. CheckEquals(AValue.IsType(TypeInfo(string)), true);
  485. CheckEquals(AValue.IsType(TypeInfo(integer)), false);
  486. CheckEquals(AValue.IsArray, false);
  487. finally
  488. AtestClass.Free;
  489. end;
  490. CheckEquals('Hello World',AValue.AsString);
  491. finally
  492. c.Free;
  493. end;
  494. end;
  495. procedure TTestCase1.TestPropGetValueProcBoolean;
  496. var
  497. ATestClass : TTestValueClass;
  498. c: TRttiContext;
  499. ARttiType: TRttiType;
  500. AProperty: TRttiProperty;
  501. AValue: TValue;
  502. begin
  503. c := TRttiContext.Create;
  504. try
  505. ATestClass := TTestValueClass.Create;
  506. ATestClass.ABoolean := true;
  507. try
  508. ARttiType := c.GetType(ATestClass.ClassInfo);
  509. Check(assigned(ARttiType));
  510. AProperty := ARttiType.GetProperty('aGetBoolean');
  511. AValue := AProperty.GetValue(ATestClass);
  512. CheckEquals(true,AValue.AsBoolean);
  513. finally
  514. AtestClass.Free;
  515. end;
  516. CheckEquals(True,AValue.AsBoolean);
  517. finally
  518. c.Free;
  519. end;
  520. end;
  521. procedure TTestCase1.TestPropGetValueProcShortString;
  522. var
  523. ATestClass : TTestValueClass;
  524. c: TRttiContext;
  525. ARttiType: TRttiType;
  526. AProperty: TRttiProperty;
  527. AValue: TValue;
  528. begin
  529. c := TRttiContext.Create;
  530. try
  531. ATestClass := TTestValueClass.Create;
  532. ATestClass.AShortString := 'Hello World';
  533. try
  534. ARttiType := c.GetType(ATestClass.ClassInfo);
  535. Check(assigned(ARttiType));
  536. AProperty := ARttiType.GetProperty('aGetShortString');
  537. AValue := AProperty.GetValue(ATestClass);
  538. CheckEquals('Hello World',AValue.AsString);
  539. finally
  540. AtestClass.Free;
  541. end;
  542. CheckEquals('Hello World',AValue.AsString);
  543. finally
  544. c.Free;
  545. end;
  546. end;
  547. procedure TTestCase1.TestPropSetValueString;
  548. var
  549. ATestClass : TTestValueClass;
  550. c: TRttiContext;
  551. ARttiType: TRttiType;
  552. AProperty: TRttiProperty;
  553. AValue: TValue;
  554. s: string;
  555. begin
  556. c := TRttiContext.Create;
  557. try
  558. ATestClass := TTestValueClass.Create;
  559. try
  560. ARttiType := c.GetType(ATestClass.ClassInfo);
  561. AProperty := ARttiType.GetProperty('astring');
  562. s := 'ipse lorem or something like that';
  563. TValue.Make(@s, TypeInfo(string), AValue);
  564. AProperty.SetValue(ATestClass, AValue);
  565. CheckEquals(ATestClass.AString, s);
  566. s := 'Another string';
  567. CheckEquals(ATestClass.AString, 'ipse lorem or something like that');
  568. finally
  569. AtestClass.Free;
  570. end;
  571. finally
  572. c.Free;
  573. end;
  574. end;
  575. procedure TTestCase1.TestPropSetValueInteger;
  576. var
  577. ATestClass : TTestValueClass;
  578. c: TRttiContext;
  579. ARttiType: TRttiType;
  580. AProperty: TRttiProperty;
  581. AValue: TValue;
  582. i: integer;
  583. begin
  584. c := TRttiContext.Create;
  585. try
  586. ATestClass := TTestValueClass.Create;
  587. try
  588. ARttiType := c.GetType(ATestClass.ClassInfo);
  589. AProperty := ARttiType.GetProperty('aInteger');
  590. i := -43573;
  591. TValue.Make(@i, TypeInfo(Integer), AValue);
  592. AProperty.SetValue(ATestClass, AValue);
  593. CheckEquals(ATestClass.AInteger, i);
  594. i := 1;
  595. CheckEquals(ATestClass.AInteger, -43573);
  596. finally
  597. AtestClass.Free;
  598. end;
  599. finally
  600. c.Free;
  601. end;
  602. end;
  603. procedure TTestCase1.TestPropSetValueBoolean;
  604. var
  605. ATestClass : TTestValueClass;
  606. c: TRttiContext;
  607. ARttiType: TRttiType;
  608. AProperty: TRttiProperty;
  609. AValue: TValue;
  610. b: boolean;
  611. begin
  612. c := TRttiContext.Create;
  613. try
  614. ATestClass := TTestValueClass.Create;
  615. try
  616. ARttiType := c.GetType(ATestClass.ClassInfo);
  617. AProperty := ARttiType.GetProperty('aboolean');
  618. b := true;
  619. TValue.Make(@b, TypeInfo(Boolean), AValue);
  620. AProperty.SetValue(ATestClass, AValue);
  621. CheckEquals(ATestClass.ABoolean, b);
  622. b := false;
  623. CheckEquals(ATestClass.ABoolean, true);
  624. TValue.Make(@b, TypeInfo(Boolean), AValue);
  625. AProperty.SetValue(ATestClass, AValue);
  626. CheckEquals(ATestClass.ABoolean, false);
  627. finally
  628. AtestClass.Free;
  629. end;
  630. finally
  631. c.Free;
  632. end;
  633. end;
  634. procedure TTestCase1.TestPropSetValueShortString;
  635. var
  636. ATestClass : TTestValueClass;
  637. c: TRttiContext;
  638. ARttiType: TRttiType;
  639. AProperty: TRttiProperty;
  640. AValue: TValue;
  641. s: string;
  642. ss: ShortString;
  643. begin
  644. c := TRttiContext.Create;
  645. try
  646. ATestClass := TTestValueClass.Create;
  647. try
  648. ARttiType := c.GetType(ATestClass.ClassInfo);
  649. AProperty := ARttiType.GetProperty('aShortString');
  650. s := 'ipse lorem or something like that';
  651. TValue.Make(@s, TypeInfo(String), AValue);
  652. AProperty.SetValue(ATestClass, AValue);
  653. CheckEquals(ATestClass.AShortString, s);
  654. s := 'Another string';
  655. CheckEquals(ATestClass.AShortString, 'ipse lorem or something like that');
  656. ss := 'Hello World';
  657. TValue.Make(@ss, TypeInfo(ShortString), AValue);
  658. AProperty.SetValue(ATestClass, AValue);
  659. CheckEquals(ATestClass.AShortString, ss);
  660. ss := 'Foobar';
  661. CheckEquals(ATestClass.AShortString, 'Hello World');
  662. finally
  663. AtestClass.Free;
  664. end;
  665. finally
  666. c.Free;
  667. end;
  668. end;
  669. procedure TTestCase1.TestPropGetValueProcInteger;
  670. var
  671. ATestClass : TTestValueClass;
  672. c: TRttiContext;
  673. ARttiType: TRttiType;
  674. AProperty: TRttiProperty;
  675. AValue: TValue;
  676. begin
  677. c := TRttiContext.Create;
  678. try
  679. ATestClass := TTestValueClass.Create;
  680. ATestClass.AInteger := 472349;
  681. try
  682. ARttiType := c.GetType(ATestClass.ClassInfo);
  683. Check(assigned(ARttiType));
  684. AProperty := ARttiType.GetProperty('agetinteger');
  685. AValue := AProperty.GetValue(ATestClass);
  686. CheckEquals(472349,AValue.AsInteger);
  687. finally
  688. AtestClass.Free;
  689. end;
  690. CheckEquals(472349,AValue.AsInteger);
  691. finally
  692. c.Free;
  693. end;
  694. end;
  695. procedure TTestCase1.TestPropGetValueProcString;
  696. var
  697. ATestClass : TTestValueClass;
  698. c: TRttiContext;
  699. ARttiType: TRttiType;
  700. AProperty: TRttiProperty;
  701. AValue: TValue;
  702. begin
  703. c := TRttiContext.Create;
  704. try
  705. ATestClass := TTestValueClass.Create;
  706. ATestClass.AString := 'Hello World';
  707. try
  708. ARttiType := c.GetType(ATestClass.ClassInfo);
  709. Check(assigned(ARttiType));
  710. AProperty := ARttiType.GetProperty('agetstring');
  711. AValue := AProperty.GetValue(ATestClass);
  712. CheckEquals('Hello World',AValue.AsString);
  713. finally
  714. AtestClass.Free;
  715. end;
  716. CheckEquals('Hello World',AValue.AsString);
  717. finally
  718. c.Free;
  719. end;
  720. end;
  721. procedure TTestCase1.TestTRttiTypeProperties;
  722. var
  723. c: TRttiContext;
  724. ARttiType: TRttiType;
  725. begin
  726. c := TRttiContext.Create;
  727. try
  728. ARttiType := c.GetType(TTestValueClass);
  729. Check(assigned(ARttiType));
  730. CheckEquals(ARttiType.Name,'TTestValueClass');
  731. Check(ARttiType.TypeKind=tkClass);
  732. // CheckEquals(ARttiType.IsPublicType,false);
  733. CheckEquals(ARttiType.TypeSize,SizeOf(TObject));
  734. CheckEquals(ARttiType.IsManaged,false);
  735. CheckEquals(ARttiType.BaseType.classname,'TRttiInstanceType');
  736. CheckEquals(ARttiType.IsInstance,True);
  737. CheckEquals(ARttiType.AsInstance.DeclaringUnitName,'tests.rtti');
  738. Check(ARttiType.BaseType.Name='TObject');
  739. Check(ARttiType.AsInstance.BaseType.Name='TObject');
  740. CheckEquals(ARttiType.IsOrdinal,False);
  741. CheckEquals(ARttiType.IsRecord,False);
  742. CheckEquals(ARttiType.IsSet,False);
  743. finally
  744. c.Free;
  745. end;
  746. end;
  747. procedure TTestCase1.GetTypeInteger;
  748. var
  749. LContext: TRttiContext;
  750. LType: TRttiType;
  751. begin
  752. LContext := TRttiContext.Create;
  753. LType := LContext.GetType(TypeInfo(integer));
  754. {$ifdef fpc}
  755. CheckEquals(LType.Name, 'LongInt');
  756. {$else}
  757. CheckEquals(LType.Name, 'Integer');
  758. {$endif}
  759. LContext.Free;
  760. end;
  761. procedure TTestCase1.GetTypePointer;
  762. var
  763. context: TRttiContext;
  764. t: TRttiType;
  765. p: TRttiPointerType absolute t;
  766. begin
  767. context := TRttiContext.Create;
  768. try
  769. t := context.GetType(TypeInfo(Pointer));
  770. Assert(t is TRttiPointerType, 'Type of Pointer is not a TRttiPointerType');
  771. Assert(not Assigned(p.ReferredType), 'ReferredType of Pointer is not Nil');
  772. t := context.GetType(TypeInfo(PLongInt));
  773. Assert(t is TRttiPointerType, 'Type of Pointer is not a TRttiPointerType');
  774. Assert(Assigned(p.ReferredType), 'ReferredType of PLongInt is Nil');
  775. Assert(p.ReferredType = context.GetType(TypeInfo(LongInt)), 'ReferredType of PLongInt is not a LongInt');
  776. t := context.GetType(TypeInfo(PWideChar));
  777. Assert(t is TRttiPointerType, 'Type of Pointer is not a TRttiPointerType');
  778. Assert(Assigned(p.ReferredType), 'ReferredType of PWideChar is Nil');
  779. Assert(p.ReferredType = context.GetType(TypeInfo(WideChar)), 'ReferredType of PWideChar is not a WideChar');
  780. finally
  781. context.Free;
  782. end;
  783. end;
  784. procedure TTestCase1.GetClassProperties;
  785. var
  786. LContext: TRttiContext;
  787. LType: TRttiType;
  788. PropList: {$ifdef fpc}specialize{$endif} TArray<TRttiProperty>;
  789. begin
  790. LContext := TRttiContext.Create;
  791. LType := LContext.GetType(TypeInfo(TGetClassProperties));
  792. PropList := LType.GetProperties;
  793. CheckEquals(4, length(PropList));
  794. CheckEquals('PubPropRO', PropList[0].Name);
  795. CheckEquals('PubPropRW', PropList[1].Name);
  796. CheckEquals('PubPropSetRO', PropList[2].Name);
  797. CheckEquals('PubPropSetRW', PropList[3].Name);
  798. LContext.Free;
  799. end;
  800. procedure TTestCase1.GetClassPropertiesValue;
  801. var
  802. AGetClassProperties: TGetClassProperties;
  803. LContext: TRttiContext;
  804. LType: TRttiType;
  805. AValue: TValue;
  806. begin
  807. LContext := TRttiContext.Create;
  808. LType := LContext.GetType(TGetClassProperties);
  809. AGetClassProperties := TGetClassProperties.Create;
  810. try
  811. AGetClassProperties.PubPropRW:=12345;
  812. AValue := LType.GetProperty('PubPropRW').GetValue(AGetClassProperties);
  813. CheckEquals(12345, AValue.AsInteger);
  814. finally
  815. AGetClassProperties.Free;
  816. end;
  817. LContext.Free;
  818. end;
  819. procedure TTestCase1.TestReferenceRawData;
  820. var
  821. value: TValue;
  822. str: String;
  823. intf: IInterface;
  824. i: LongInt;
  825. test: TTestRecord;
  826. arrdyn: TArrayOfLongintDyn;
  827. arrstat: TArrayOfLongintStatic;
  828. begin
  829. str := 'Hello World';
  830. UniqueString(str);
  831. TValue.Make(@str, TypeInfo(String), value);
  832. Check(PPointer(value.GetReferenceToRawData)^ = Pointer(str), 'Reference to string data differs');
  833. intf := TInterfacedObject.Create;
  834. TValue.Make(@intf, TypeInfo(IInterface), value);
  835. Check(PPointer(value.GetReferenceToRawData)^ = Pointer(intf), 'Reference to interface data differs');
  836. i := 42;
  837. TValue.Make(@i, TypeInfo(LongInt), value);
  838. Check(value.GetReferenceToRawData <> @i, 'Reference to longint is equal');
  839. Check(PLongInt(value.GetReferenceToRawData)^ = PLongInt(@i)^, 'Reference to longint data differs');
  840. test.value1 := 42;
  841. test.value2 := 'Hello World';
  842. TValue.Make(@test, TypeInfo(TTestRecord), value);
  843. Check(value.GetReferenceToRawData <> @test, 'Reference to record is equal');
  844. Check(PTestRecord(value.GetReferenceToRawData)^.value1 = PTestRecord(@test)^.value1, 'Reference to record data value1 differs');
  845. Check(PTestRecord(value.GetReferenceToRawData)^.value2 = PTestRecord(@test)^.value2, 'Reference to record data value2 differs');
  846. SetLength(arrdyn, 3);
  847. arrdyn[0] := 42;
  848. arrdyn[1] := 23;
  849. arrdyn[2] := 49;
  850. TValue.Make(@arrdyn, TypeInfo(TArrayOfLongintDyn), value);
  851. Check(PPointer(value.GetReferenceToRawData)^ = Pointer(arrdyn), 'Reference to dynamic array data differs');
  852. arrstat[0] := 42;
  853. arrstat[1] := 23;
  854. arrstat[2] := 49;
  855. arrstat[3] := 59;
  856. TValue.Make(@arrstat, TypeInfo(TArrayOfLongintStatic), value);
  857. Check(value.GetReferenceToRawData <> @arrstat, 'Reference to static array is equal');
  858. Check(PLongInt(value.GetReferenceToRawData)^ = PLongInt(@arrstat)^, 'Reference to static array data differs');
  859. end;
  860. procedure TTestCase1.TestReferenceRawDataEmpty;
  861. var
  862. value: TValue;
  863. begin
  864. TValue.Make(Nil, TypeInfo(String), value);
  865. Check(Assigned(value.GetReferenceToRawData()), 'Reference to empty String is not assigned');
  866. Check(not Assigned(PPointer(value.GetReferenceToRawData)^), 'Empty String data is assigned');
  867. TValue.Make(Nil, TypeInfo(IInterface), value);
  868. Check(Assigned(value.GetReferenceToRawData()), 'Reference to empty interface is not assigned');
  869. Check(not Assigned(PPointer(value.GetReferenceToRawData)^), 'Empty interface data is assigned');
  870. TValue.Make(Nil, TypeInfo(LongInt), value);
  871. Check(Assigned(value.GetReferenceToRawData()), 'Reference to empty LongInt is not assigned');
  872. Check(PLongInt(value.GetReferenceToRawData)^ = 0, 'Empty longint data is not 0');
  873. TValue.Make(Nil, TypeInfo(TTestRecord), value);
  874. Check(Assigned(value.GetReferenceToRawData()), 'Reference to empty record is not assigned');
  875. Check(PTestRecord(value.GetReferenceToRawData)^.value1 = 0, 'Empty record data value1 is not 0');
  876. Check(PTestRecord(value.GetReferenceToRawData)^.value2 = '', 'Empty record data value2 is not empty');
  877. TValue.Make(Nil, TypeInfo(TArrayOfLongintDyn), value);
  878. Check(Assigned(value.GetReferenceToRawData()), 'Reference to empty dynamic array is not assigned');
  879. Check(not Assigned(PPointer(value.GetReferenceToRawData)^), 'Empty dynamic array data is assigned');
  880. TValue.Make(Nil, TypeInfo(TArrayOfLongintStatic), value);
  881. Check(Assigned(value.GetReferenceToRawData()), 'Reference to empty static array is not assigned');
  882. Check(PLongInt(value.GetReferenceToRawData)^ = 0, 'Empty static array data is not 0');
  883. end;
  884. procedure TTestCase1.TestDataSize;
  885. var
  886. u8: UInt8;
  887. u16: UInt16;
  888. u32: UInt32;
  889. u64: UInt64;
  890. s8: Int8;
  891. s16: Int16;
  892. s32: Int32;
  893. s64: Int64;
  894. f32: Single;
  895. f64: Double;
  896. {$ifdef FPC_HAS_TYPE_EXTENDED}
  897. f80: Extended;
  898. {$endif}
  899. fco: Comp;
  900. fcu: Currency;
  901. ss: ShortString;
  902. sa: AnsiString;
  903. su: UnicodeString;
  904. sw: WideString;
  905. o: TObject;
  906. c: TClass;
  907. i: IInterface;
  908. ad: TArrayOfLongintDyn;
  909. _as: TArrayOfLongintStatic;
  910. b8: Boolean;
  911. {$ifdef fpc}
  912. b16: Boolean16;
  913. b32: Boolean32;
  914. b64: Boolean64;
  915. {$endif}
  916. bl8: ByteBool;
  917. bl16: WordBool;
  918. bl32: LongBool;
  919. {$ifdef fpc}
  920. bl64: QWordBool;
  921. {$endif}
  922. e: TTestEnum;
  923. s: TTestSet;
  924. t: TTestRecord;
  925. p: Pointer;
  926. proc: TTestProc;
  927. method: TTestMethod;
  928. value: TValue;
  929. begin
  930. TValue.Make(@u8, TypeInfo(UInt8), value);
  931. CheckEquals(1, value.DataSize, 'Size of UInt8 differs');
  932. TValue.Make(@u16, TypeInfo(UInt16), value);
  933. CheckEquals(2, value.DataSize, 'Size of UInt16 differs');
  934. TValue.Make(@u32, TypeInfo(UInt32), value);
  935. CheckEquals(4, value.DataSize, 'Size of UInt32 differs');
  936. TValue.Make(@u64, TypeInfo(UInt64), value);
  937. CheckEquals(8, value.DataSize, 'Size of UInt64 differs');
  938. TValue.Make(@s8, TypeInfo(Int8), value);
  939. CheckEquals(1, value.DataSize, 'Size of Int8 differs');
  940. TValue.Make(@s16, TypeInfo(Int16), value);
  941. CheckEquals(2, value.DataSize, 'Size of Int16 differs');
  942. TValue.Make(@s32, TypeInfo(Int32), value);
  943. CheckEquals(4, value.DataSize, 'Size of Int32 differs');
  944. TValue.Make(@s64, TypeInfo(Int64), value);
  945. CheckEquals(8, value.DataSize, 'Size of Int64 differs');
  946. TValue.Make(@b8, TypeInfo(Boolean), value);
  947. CheckEquals(1, value.DataSize, 'Size of Boolean differs');
  948. {$ifdef fpc}
  949. TValue.Make(@b16, TypeInfo(Boolean16), value);
  950. CheckEquals(2, value.DataSize, 'Size of Boolean16 differs');
  951. TValue.Make(@b32, TypeInfo(Boolean32), value);
  952. CheckEquals(4, value.DataSize, 'Size of Boolean32 differs');
  953. TValue.Make(@b64, TypeInfo(Boolean64), value);
  954. CheckEquals(8, value.DataSize, 'Size of Boolean64 differs');
  955. {$endif}
  956. TValue.Make(@bl8, TypeInfo(ByteBool), value);
  957. CheckEquals(1, value.DataSize, 'Size of ByteBool differs');
  958. TValue.Make(@bl16, TypeInfo(WordBool), value);
  959. CheckEquals(2, value.DataSize, 'Size of WordBool differs');
  960. TValue.Make(@bl32, TypeInfo(LongBool), value);
  961. CheckEquals(4, value.DataSize, 'Size of LongBool differs');
  962. {$ifdef fpc}
  963. TValue.Make(@bl64, TypeInfo(QWordBool), value);
  964. CheckEquals(8, value.DataSize, 'Size of QWordBool differs');
  965. {$endif}
  966. TValue.Make(@f32, TypeInfo(Single), value);
  967. CheckEquals(4, value.DataSize, 'Size of Single differs');
  968. TValue.Make(@f64, TypeInfo(Double), value);
  969. CheckEquals(8, value.DataSize, 'Size of Double differs');
  970. {$ifdef FPC_HAS_TYPE_EXTENDED}
  971. TValue.Make(@f80, TypeInfo(Extended), value);
  972. CheckEquals(10, value.DataSize, 'Size of Extended differs');
  973. {$endif}
  974. TValue.Make(@fcu, TypeInfo(Currency), value);
  975. CheckEquals(SizeOf(Currency), value.DataSize, 'Size of Currency differs');
  976. TValue.Make(@fco, TypeInfo(Comp), value);
  977. CheckEquals(SizeOf(Comp), value.DataSize, 'Size of Comp differs');
  978. ss := '';
  979. TValue.Make(@ss, TypeInfo(ShortString), value);
  980. CheckEquals(254, value.DataSize, 'Size ofShortString differs');
  981. TValue.Make(@sa, TypeInfo(AnsiString), value);
  982. CheckEquals(SizeOf(Pointer), value.DataSize, 'Size of AnsiString differs');
  983. TValue.Make(@sw, TypeInfo(WideString), value);
  984. CheckEquals(SizeOf(Pointer), value.DataSize, 'Size of WideString differs');
  985. TValue.Make(@su, TypeInfo(UnicodeString), value);
  986. CheckEquals(SizeOf(Pointer), value.DataSize, 'Size of UnicodeString differs');
  987. o := TTestValueClass.Create;
  988. TValue.Make(@o, TypeInfo(TObject), value);
  989. CheckEquals(SizeOf(Pointer), value.DataSize, 'Size of TObject differs');
  990. o.Free;
  991. c := TObject;
  992. TValue.Make(@c, TypeInfo(TClass), value);
  993. CheckEquals(SizeOf(Pointer), value.DataSize, 'Size of TClass differs');
  994. TValue.Make(@i, TypeInfo(IInterface), value);
  995. CheckEquals(SizeOf(Pointer), value.DataSize, 'Size of IInterface differs');
  996. TValue.Make(@t, TypeInfo(TTestRecord), value);
  997. CheckEquals(SizeOf(TTestRecord), value.DataSize, 'Size of TTestRecord differs');
  998. proc := Nil;
  999. TValue.Make(@proc, TypeInfo(TTestProc), value);
  1000. CheckEquals(SizeOf(TTestProc), value.DataSize, 'Size of TTestProc differs');
  1001. method := Nil;
  1002. TValue.Make(@method, TypeInfo(TTestMethod), value);
  1003. CheckEquals(SizeOf(TTestMethod), value.DataSize, 'Size of TTestMethod differs');
  1004. TValue.Make(@_as, TypeInfo(TArrayOfLongintStatic), value);
  1005. CheckEquals(SizeOf(TArrayOfLongintStatic), value.DataSize, 'Size of TArrayOfLongintStatic differs');
  1006. TValue.Make(@ad, TypeInfo(TArrayOfLongintDyn), value);
  1007. CheckEquals(SizeOf(TArrayOfLongintDyn), value.DataSize, 'Size of TArrayOfLongintDyn differs');
  1008. TValue.Make(@e, TypeInfo(TTestEnum), value);
  1009. CheckEquals(SizeOf(TTestEnum), value.DataSize, 'Size of TTestEnum differs');
  1010. TValue.Make(@s, TypeInfo(TTestSet), value);
  1011. CheckEquals(SizeOf(TTestSet), value.DataSize, 'Size of TTestSet differs');
  1012. p := Nil;
  1013. TValue.Make(@p, TypeInfo(Pointer), value);
  1014. CheckEquals(SizeOf(Pointer), value.DataSize, 'Size of Pointer differs');
  1015. end;
  1016. procedure TTestCase1.TestDataSizeEmpty;
  1017. var
  1018. value: TValue;
  1019. begin
  1020. TValue.Make(Nil, TypeInfo(UInt8), value);
  1021. CheckEquals(1, value.DataSize, 'Size of UInt8 differs');
  1022. TValue.Make(Nil, TypeInfo(UInt16), value);
  1023. CheckEquals(2, value.DataSize, 'Size of UInt16 differs');
  1024. TValue.Make(Nil, TypeInfo(UInt32), value);
  1025. CheckEquals(4, value.DataSize, 'Size of UInt32 differs');
  1026. TValue.Make(Nil, TypeInfo(UInt64), value);
  1027. CheckEquals(8, value.DataSize, 'Size of UInt64 differs');
  1028. TValue.Make(Nil, TypeInfo(Int8), value);
  1029. CheckEquals(1, value.DataSize, 'Size of Int8 differs');
  1030. TValue.Make(Nil, TypeInfo(Int16), value);
  1031. CheckEquals(2, value.DataSize, 'Size of Int16 differs');
  1032. TValue.Make(Nil, TypeInfo(Int32), value);
  1033. CheckEquals(4, value.DataSize, 'Size of Int32 differs');
  1034. TValue.Make(Nil, TypeInfo(Int64), value);
  1035. CheckEquals(8, value.DataSize, 'Size of Int64 differs');
  1036. TValue.Make(Nil, TypeInfo(Boolean), value);
  1037. CheckEquals(1, value.DataSize, 'Size of Boolean differs');
  1038. {$ifdef fpc}
  1039. TValue.Make(Nil, TypeInfo(Boolean16), value);
  1040. CheckEquals(2, value.DataSize, 'Size of Boolean16 differs');
  1041. TValue.Make(Nil, TypeInfo(Boolean32), value);
  1042. CheckEquals(4, value.DataSize, 'Size of Boolean32 differs');
  1043. TValue.Make(Nil, TypeInfo(Boolean64), value);
  1044. CheckEquals(8, value.DataSize, 'Size of Boolean64 differs');
  1045. {$endif}
  1046. TValue.Make(Nil, TypeInfo(ByteBool), value);
  1047. CheckEquals(1, value.DataSize, 'Size of ByteBool differs');
  1048. TValue.Make(Nil, TypeInfo(WordBool), value);
  1049. CheckEquals(2, value.DataSize, 'Size of WordBool differs');
  1050. TValue.Make(Nil, TypeInfo(LongBool), value);
  1051. CheckEquals(4, value.DataSize, 'Size of LongBool differs');
  1052. {$ifdef fpc}
  1053. TValue.Make(Nil, TypeInfo(QWordBool), value);
  1054. CheckEquals(8, value.DataSize, 'Size of QWordBool differs');
  1055. {$endif}
  1056. TValue.Make(Nil, TypeInfo(Single), value);
  1057. CheckEquals(4, value.DataSize, 'Size of Single differs');
  1058. TValue.Make(Nil, TypeInfo(Double), value);
  1059. CheckEquals(8, value.DataSize, 'Size of Double differs');
  1060. {$ifdef FPC_HAS_TYPE_EXTENDED}
  1061. TValue.Make(Nil, TypeInfo(Extended), value);
  1062. CheckEquals(10, value.DataSize, 'Size of Extended differs');
  1063. {$endif}
  1064. TValue.Make(Nil, TypeInfo(Currency), value);
  1065. CheckEquals(SizeOf(Currency), value.DataSize, 'Size of Currency differs');
  1066. TValue.Make(Nil, TypeInfo(Comp), value);
  1067. CheckEquals(SizeOf(Comp), value.DataSize, 'Size of Comp differs');
  1068. TValue.Make(Nil, TypeInfo(ShortString), value);
  1069. CheckEquals(254, value.DataSize, 'Size of ShortString differs');
  1070. TValue.Make(Nil, TypeInfo(AnsiString), value);
  1071. CheckEquals(SizeOf(Pointer), value.DataSize, 'Size of Pointer differs');
  1072. TValue.Make(Nil, TypeInfo(WideString), value);
  1073. CheckEquals(SizeOf(Pointer), value.DataSize, 'Size of WideString differs');
  1074. TValue.Make(Nil, TypeInfo(UnicodeString), value);
  1075. CheckEquals(SizeOf(Pointer), value.DataSize, 'Size of UnicodeString differs');
  1076. TValue.Make(Nil, TypeInfo(TObject), value);
  1077. CheckEquals(SizeOf(Pointer), value.DataSize, 'Size of TObject differs');
  1078. TValue.Make(Nil, TypeInfo(TClass), value);
  1079. CheckEquals(SizeOf(Pointer), value.DataSize, 'Size of TClass differs');
  1080. TValue.Make(Nil, TypeInfo(IInterface), value);
  1081. CheckEquals(SizeOf(Pointer), value.DataSize, 'Size of IInterface differs');
  1082. TValue.Make(Nil, TypeInfo(TTestRecord), value);
  1083. CheckEquals(SizeOf(TTestRecord), value.DataSize, 'Size of TTestRecord differs');
  1084. TValue.Make(Nil, TypeInfo(TTestProc), value);
  1085. CheckEquals(SizeOf(TTestProc), value.DataSize, 'Size of TTestProc differs');
  1086. TValue.Make(Nil, TypeInfo(TTestMethod), value);
  1087. CheckEquals(SizeOf(TTestMethod), value.DataSize, 'Size of TTestMethod differs');
  1088. TValue.Make(Nil, TypeInfo(TArrayOfLongintStatic), value);
  1089. CheckEquals(SizeOf(TArrayOfLongintStatic), value.DataSize, 'Size of TArrayOfLongintStatic differs');
  1090. TValue.Make(Nil, TypeInfo(TArrayOfLongintDyn), value);
  1091. CheckEquals(SizeOf(TArrayOfLongintDyn), value.DataSize, 'Size of TArrayOfLongintDyn differs');
  1092. TValue.Make(Nil, TypeInfo(TTestEnum), value);
  1093. CheckEquals(SizeOf(TTestEnum), value.DataSize, 'Size of TTestEnum differs');
  1094. TValue.Make(Nil, TypeInfo(TTestSet), value);
  1095. CheckEquals(SizeOf(TTestSet), value.DataSize, 'Size of TTestSet differs');
  1096. TValue.Make(Nil, TypeInfo(Pointer), value);
  1097. CheckEquals(SizeOf(Pointer), value.DataSize, 'Size of Pointer differs');
  1098. end;
  1099. procedure TTestCase1.TestIsManaged;
  1100. begin
  1101. CheckEquals(true, IsManaged(TypeInfo(ansistring)), 'IsManaged for tkAString');
  1102. CheckEquals(true, IsManaged(TypeInfo(widestring)), 'IsManaged for tkWString');
  1103. CheckEquals(true, IsManaged(TypeInfo(Variant)), 'IsManaged for tkVariant');
  1104. CheckEquals(true, IsManaged(TypeInfo(TArrayOfManagedRec)),
  1105. 'IsManaged for tkArray (with managed ElType)');
  1106. CheckEquals(true, IsManaged(TypeInfo(TArrayOfString)),
  1107. 'IsManaged for tkArray (with managed ElType)');
  1108. CheckEquals(true, IsManaged(TypeInfo(TManagedRec)), 'IsManaged for tkRecord');
  1109. {$ifdef fpc}
  1110. CheckEquals(true, IsManaged(TypeInfo(TManagedRecOp)), 'IsManaged for tkRecord');
  1111. {$endif}
  1112. CheckEquals(true, IsManaged(TypeInfo(IInterface)), 'IsManaged for tkInterface');
  1113. CheckEquals(true, IsManaged(TypeInfo(TManagedObj)), 'IsManaged for tkObject');
  1114. {$ifdef fpc}
  1115. CheckEquals(true, IsManaged(TypeInfo(specialize TArray<byte>)), 'IsManaged for tkDynArray');
  1116. {$else}
  1117. CheckEquals(true, IsManaged(TypeInfo(TArray<byte>)), 'IsManaged for tkDynArray');
  1118. {$endif}
  1119. CheckEquals(true, IsManaged(TypeInfo(unicodestring)), 'IsManaged for tkUString');
  1120. CheckEquals(false, IsManaged(TypeInfo(shortstring)), 'IsManaged for tkSString');
  1121. CheckEquals(false, IsManaged(TypeInfo(Byte)), 'IsManaged for tkInteger');
  1122. CheckEquals(false, IsManaged(TypeInfo(Char)), 'IsManaged for tkChar');
  1123. CheckEquals(false, IsManaged(TypeInfo(TTestEnum)), 'IsManaged for tkEnumeration');
  1124. CheckEquals(false, IsManaged(TypeInfo(Single)), 'IsManaged for tkFloat');
  1125. CheckEquals(false, IsManaged(TypeInfo(TTestSet)), 'IsManaged for tkSet');
  1126. {$ifdef fpc}
  1127. CheckEquals(false, IsManaged(TypeInfo(TTestMethod)), 'IsManaged for tkMethod');
  1128. {$else}
  1129. { Delphi bug (or sabotage). For some reason Delphi considers method pointers to be managed (only in newer versions, probably since XE7) :/ }
  1130. CheckEquals({$if RTLVersion>=28}true{$else}false{$endif}, IsManaged(TypeInfo(TTestMethod)), 'IsManaged for tkMethod');
  1131. {$endif}
  1132. CheckEquals(false, IsManaged(TypeInfo(TArrayOfByte)),
  1133. 'IsManaged for tkArray (with non managed ElType)');
  1134. CheckEquals(false, IsManaged(TypeInfo(TArrayOfNonManagedRec)),
  1135. 'IsManaged for tkArray (with non managed ElType)');
  1136. CheckEquals(false, IsManaged(TypeInfo(TNonManagedRec)), 'IsManaged for tkRecord');
  1137. CheckEquals(false, IsManaged(TypeInfo(TObject)), 'IsManaged for tkClass');
  1138. CheckEquals(false, IsManaged(TypeInfo(TNonManagedObj)), 'IsManaged for tkObject');
  1139. CheckEquals(false, IsManaged(TypeInfo(WideChar)), 'IsManaged for tkWChar');
  1140. CheckEquals(false, IsManaged(TypeInfo(Boolean)), 'IsManaged for tkBool');
  1141. CheckEquals(false, IsManaged(TypeInfo(Int64)), 'IsManaged for tkInt64');
  1142. CheckEquals(false, IsManaged(TypeInfo(UInt64)), 'IsManaged for tkQWord');
  1143. {$ifdef fpc}
  1144. CheckEquals(false, IsManaged(TypeInfo(ICORBATest)), 'IsManaged for tkInterfaceRaw');
  1145. {$endif}
  1146. CheckEquals(false, IsManaged(TypeInfo(TTestProc)), 'IsManaged for tkProcVar');
  1147. CheckEquals(false, IsManaged(TypeInfo(TTestHelper)), 'IsManaged for tkHelper');
  1148. {$ifdef fpc}
  1149. CheckEquals(false, IsManaged(TypeInfo(file)), 'IsManaged for tkFile');
  1150. {$endif}
  1151. CheckEquals(false, IsManaged(TypeInfo(TClass)), 'IsManaged for tkClassRef');
  1152. CheckEquals(false, IsManaged(TypeInfo(Pointer)), 'IsManaged for tkPointer');
  1153. CheckEquals(false, IsManaged(nil), 'IsManaged for nil');
  1154. end;
  1155. initialization
  1156. {$ifdef fpc}
  1157. RegisterTest(TTestCase1);
  1158. {$else fpc}
  1159. RegisterTest(TTestCase1.Suite);
  1160. {$endif fpc}
  1161. end.