tests.rtti.pas 40 KB

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