tests.rtti.pas 21 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791
  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 GetClassProperties;
  22. procedure GetClassPropertiesValue;
  23. procedure TestTRttiTypeProperties;
  24. procedure TestPropGetValueString;
  25. procedure TestPropGetValueInteger;
  26. procedure TestPropGetValueBoolean;
  27. procedure TestPropGetValueShortString;
  28. procedure TestPropGetValueProcString;
  29. procedure TestPropGetValueProcInteger;
  30. procedure TestPropGetValueProcBoolean;
  31. procedure TestPropGetValueProcShortString;
  32. procedure TestPropSetValueString;
  33. procedure TestPropSetValueInteger;
  34. procedure TestPropSetValueBoolean;
  35. procedure TestPropSetValueShortString;
  36. procedure TestGetValueStringCastError;
  37. procedure TestMakeObject;
  38. procedure TestGetIsReadable;
  39. procedure TestIsWritable;
  40. procedure TestIsManaged;
  41. end;
  42. implementation
  43. type
  44. TGetClassProperties = class
  45. private
  46. FPubPropRO: integer;
  47. FPubPropRW: integer;
  48. published
  49. property PubPropRO: integer read FPubPropRO;
  50. property PubPropRW: integer read FPubPropRW write FPubPropRW;
  51. property PubPropSetRO: integer read FPubPropRO;
  52. property PubPropSetRW: integer read FPubPropRW write FPubPropRW;
  53. end;
  54. { TTestValueClass }
  55. TTestValueClass = class
  56. private
  57. FAInteger: integer;
  58. FAString: string;
  59. FABoolean: boolean;
  60. FAShortString: ShortString;
  61. function GetAInteger: integer;
  62. function GetAString: string;
  63. function GetABoolean: boolean;
  64. function GetAShortString: ShortString;
  65. procedure SetWriteOnly(AValue: integer);
  66. published
  67. property AInteger: Integer read FAInteger write FAInteger;
  68. property AString: string read FAString write FAString;
  69. property ABoolean: boolean read FABoolean write FABoolean;
  70. property AShortString: ShortString read FAShortString write FAShortString;
  71. property AGetInteger: Integer read GetAInteger;
  72. property AGetString: string read GetAString;
  73. property AGetBoolean: boolean read GetABoolean;
  74. property AGetShortString: ShortString read GetAShortString;
  75. property AWriteOnly: integer write SetWriteOnly;
  76. end;
  77. TManagedRec = record
  78. s: string;
  79. end;
  80. TManagedRecOp = record
  81. class operator AddRef(var a: TManagedRecOp);
  82. end;
  83. TNonManagedRec = record
  84. i: Integer;
  85. end;
  86. TManagedObj = object
  87. i: IInterface;
  88. end;
  89. TNonManagedObj = object
  90. d: double;
  91. end;
  92. TTestEnum = (te1, te2, te3, te4, te5);
  93. TTestSet = set of TTestEnum;
  94. TTestProc = procedure;
  95. TTestMethod = procedure of object;
  96. TTestHelper = class helper for TObject
  97. end;
  98. TArrayOfString = array[0..0] of string;
  99. TArrayOfManagedRec = array[0..0] of TManagedRec;
  100. TArrayOfNonManagedRec = array[0..0] of TNonManagedRec;
  101. TArrayOfByte = array[0..0] of byte;
  102. {$PUSH}
  103. {$INTERFACES CORBA}
  104. ICORBATest = interface
  105. end;
  106. {$POP}
  107. class operator TManagedRecOp.AddRef(var a: TManagedRecOp);
  108. begin
  109. end;
  110. { TTestValueClass }
  111. function TTestValueClass.GetAInteger: integer;
  112. begin
  113. result := FAInteger;
  114. end;
  115. function TTestValueClass.GetAString: string;
  116. begin
  117. result := FAString;
  118. end;
  119. function TTestValueClass.GetABoolean: boolean;
  120. begin
  121. result := FABoolean;
  122. end;
  123. function TTestValueClass.GetAShortString: ShortString;
  124. begin
  125. Result := FAShortString;
  126. end;
  127. procedure TTestValueClass.SetWriteOnly(AValue: integer);
  128. begin
  129. // Do nothing
  130. end;
  131. { Note: GetTypes currently only returns those types that had been acquired using
  132. GetType, so GetTypes itself can't be really tested currently }
  133. (*procedure TTestCase1.GetTypes;
  134. var
  135. LContext: TRttiContext;
  136. LType: TRttiType;
  137. IsTestCaseClassFound: boolean;
  138. begin
  139. LContext := TRttiContext.Create;
  140. { Enumerate all types declared in the application }
  141. for LType in LContext.GetTypes() do
  142. begin
  143. if LType.Name='TTestCase1' then
  144. IsTestCaseClassFound:=true;
  145. end;
  146. LContext.Free;
  147. CheckTrue(IsTestCaseClassFound, 'RTTI information does not contain class of testcase.');
  148. end;*)
  149. procedure TTestCase1.TestGetValueStringCastError;
  150. var
  151. ATestClass : TTestValueClass;
  152. c: TRttiContext;
  153. ARttiType: TRttiType;
  154. AValue: TValue;
  155. i: integer;
  156. HadException: boolean;
  157. begin
  158. c := TRttiContext.Create;
  159. try
  160. ATestClass := TTestValueClass.Create;
  161. ATestClass.AString := '12';
  162. try
  163. ARttiType := c.GetType(ATestClass.ClassInfo);
  164. AValue := ARttiType.GetProperty('astring').GetValue(ATestClass);
  165. HadException := false;
  166. try
  167. i := AValue.AsInteger;
  168. except
  169. on E: Exception do
  170. if E.ClassType=EInvalidCast then
  171. HadException := true;
  172. end;
  173. Check(HadException, 'No or invalid exception on invalid cast');
  174. finally
  175. AtestClass.Free;
  176. end;
  177. finally
  178. c.Free;
  179. end;
  180. end;
  181. procedure TTestCase1.TestMakeObject;
  182. var
  183. AValue: TValue;
  184. ATestClass: TTestValueClass;
  185. begin
  186. ATestClass := TTestValueClass.Create;
  187. ATestClass.AInteger := 54329;
  188. TValue.Make(@ATestClass, TypeInfo(TTestValueClass),AValue);
  189. CheckEquals(AValue.IsClass, False);
  190. CheckEquals(AValue.IsObject, True);
  191. Check(AValue.AsObject=ATestClass);
  192. CheckEquals(TTestValueClass(AValue.AsObject).AInteger, 54329);
  193. ATestClass.Free;
  194. end;
  195. procedure TTestCase1.TestGetIsReadable;
  196. var
  197. c: TRttiContext;
  198. ARttiType: TRttiType;
  199. AProperty: TRttiProperty;
  200. begin
  201. c := TRttiContext.Create;
  202. try
  203. ARttiType := c.GetType(TTestValueClass);
  204. AProperty := ARttiType.GetProperty('aBoolean');
  205. CheckEquals(AProperty.IsReadable, true);
  206. AProperty := ARttiType.GetProperty('aGetBoolean');
  207. CheckEquals(AProperty.IsReadable, true);
  208. AProperty := ARttiType.GetProperty('aWriteOnly');
  209. CheckEquals(AProperty.IsReadable, False);
  210. finally
  211. c.Free;
  212. end;
  213. end;
  214. procedure TTestCase1.TestIsWritable;
  215. var
  216. c: TRttiContext;
  217. ARttiType: TRttiType;
  218. AProperty: TRttiProperty;
  219. begin
  220. c := TRttiContext.Create;
  221. try
  222. ARttiType := c.GetType(TTestValueClass);
  223. AProperty := ARttiType.GetProperty('aBoolean');
  224. CheckEquals(AProperty.IsWritable, true);
  225. AProperty := ARttiType.GetProperty('aGetBoolean');
  226. CheckEquals(AProperty.IsWritable, false);
  227. AProperty := ARttiType.GetProperty('aWriteOnly');
  228. CheckEquals(AProperty.IsWritable, True);
  229. finally
  230. c.Free;
  231. end;
  232. end;
  233. procedure TTestCase1.TestPropGetValueBoolean;
  234. var
  235. ATestClass : TTestValueClass;
  236. c: TRttiContext;
  237. ARttiType: TRttiType;
  238. AProperty: TRttiProperty;
  239. AValue: TValue;
  240. begin
  241. c := TRttiContext.Create;
  242. try
  243. ATestClass := TTestValueClass.Create;
  244. ATestClass.ABoolean := true;
  245. try
  246. ARttiType := c.GetType(ATestClass.ClassInfo);
  247. Check(assigned(ARttiType));
  248. AProperty := ARttiType.GetProperty('aBoolean');
  249. AValue := AProperty.GetValue(ATestClass);
  250. CheckEquals(true,AValue.AsBoolean);
  251. ATestClass.ABoolean := false;
  252. CheckEquals(true, AValue.AsBoolean);
  253. CheckEquals('True', AValue.ToString);
  254. CheckEquals(True, AValue.IsOrdinal);
  255. CheckEquals(1, AValue.AsOrdinal);
  256. finally
  257. AtestClass.Free;
  258. end;
  259. CheckEquals(True,AValue.AsBoolean);
  260. finally
  261. c.Free;
  262. end;
  263. end;
  264. procedure TTestCase1.TestPropGetValueShortString;
  265. var
  266. ATestClass : TTestValueClass;
  267. c: TRttiContext;
  268. ARttiType: TRttiType;
  269. AProperty: TRttiProperty;
  270. AValue: TValue;
  271. begin
  272. c := TRttiContext.Create;
  273. try
  274. ATestClass := TTestValueClass.Create;
  275. ATestClass.AShortString := 'Hello World';
  276. try
  277. ARttiType := c.GetType(ATestClass.ClassInfo);
  278. Check(assigned(ARttiType));
  279. AProperty := ARttiType.GetProperty('aShortString');
  280. AValue := AProperty.GetValue(ATestClass);
  281. CheckEquals('Hello World',AValue.AsString);
  282. ATestClass.AShortString := 'Foobar';
  283. CheckEquals('Hello World', AValue.AsString);
  284. CheckEquals(False, AValue.IsOrdinal);
  285. CheckEquals(False, AValue.IsObject);
  286. CheckEquals(False, AValue.IsArray);
  287. CheckEquals(False, AValue.IsClass);
  288. finally
  289. AtestClass.Free;
  290. end;
  291. CheckEquals('Hello World',AValue.AsString);
  292. finally
  293. c.Free;
  294. end;
  295. end;
  296. procedure TTestCase1.TestPropGetValueInteger;
  297. var
  298. ATestClass : TTestValueClass;
  299. c: TRttiContext;
  300. ARttiType: TRttiType;
  301. AProperty: TRttiProperty;
  302. AValue: TValue;
  303. begin
  304. c := TRttiContext.Create;
  305. try
  306. ATestClass := TTestValueClass.Create;
  307. ATestClass.AInteger := 472349;
  308. try
  309. ARttiType := c.GetType(ATestClass.ClassInfo);
  310. Check(assigned(ARttiType));
  311. AProperty := ARttiType.GetProperty('ainteger');
  312. AValue := AProperty.GetValue(ATestClass);
  313. CheckEquals(472349,AValue.AsInteger);
  314. ATestClass.AInteger := 12;
  315. CheckEquals(472349, AValue.AsInteger);
  316. CheckEquals('472349', AValue.ToString);
  317. CheckEquals(True, AValue.IsOrdinal);
  318. finally
  319. AtestClass.Free;
  320. end;
  321. CheckEquals(472349,AValue.AsInteger);
  322. finally
  323. c.Free;
  324. end;
  325. end;
  326. procedure TTestCase1.TestPropGetValueString;
  327. var
  328. ATestClass : TTestValueClass;
  329. c: TRttiContext;
  330. ARttiType: TRttiType;
  331. AProperty: TRttiProperty;
  332. AValue: TValue;
  333. i: int64;
  334. begin
  335. c := TRttiContext.Create;
  336. try
  337. ATestClass := TTestValueClass.Create;
  338. ATestClass.AString := 'Hello World';
  339. try
  340. ARttiType := c.GetType(ATestClass.ClassInfo);
  341. Check(assigned(ARttiType));
  342. AProperty := ARttiType.GetProperty('astring');
  343. AValue := AProperty.GetValue(ATestClass);
  344. CheckEquals('Hello World',AValue.AsString);
  345. ATestClass.AString := 'Goodbye World';
  346. CheckEquals('Hello World',AValue.AsString);
  347. CheckEquals('Hello World',AValue.ToString);
  348. Check(TypeInfo(string)=AValue.TypeInfo);
  349. Check(AValue.TypeData=GetTypeData(AValue.TypeInfo));
  350. Check(AValue.IsEmpty=false);
  351. Check(AValue.IsObject=false);
  352. Check(AValue.IsClass=false);
  353. CheckEquals(AValue.IsOrdinal, false);
  354. CheckEquals(AValue.TryAsOrdinal(i), false);
  355. CheckEquals(AValue.IsType(TypeInfo(string)), true);
  356. CheckEquals(AValue.IsType(TypeInfo(integer)), false);
  357. CheckEquals(AValue.IsArray, false);
  358. finally
  359. AtestClass.Free;
  360. end;
  361. CheckEquals('Hello World',AValue.AsString);
  362. finally
  363. c.Free;
  364. end;
  365. end;
  366. procedure TTestCase1.TestPropGetValueProcBoolean;
  367. var
  368. ATestClass : TTestValueClass;
  369. c: TRttiContext;
  370. ARttiType: TRttiType;
  371. AProperty: TRttiProperty;
  372. AValue: TValue;
  373. begin
  374. c := TRttiContext.Create;
  375. try
  376. ATestClass := TTestValueClass.Create;
  377. ATestClass.ABoolean := true;
  378. try
  379. ARttiType := c.GetType(ATestClass.ClassInfo);
  380. Check(assigned(ARttiType));
  381. AProperty := ARttiType.GetProperty('aGetBoolean');
  382. AValue := AProperty.GetValue(ATestClass);
  383. CheckEquals(true,AValue.AsBoolean);
  384. finally
  385. AtestClass.Free;
  386. end;
  387. CheckEquals(True,AValue.AsBoolean);
  388. finally
  389. c.Free;
  390. end;
  391. end;
  392. procedure TTestCase1.TestPropGetValueProcShortString;
  393. var
  394. ATestClass : TTestValueClass;
  395. c: TRttiContext;
  396. ARttiType: TRttiType;
  397. AProperty: TRttiProperty;
  398. AValue: TValue;
  399. begin
  400. c := TRttiContext.Create;
  401. try
  402. ATestClass := TTestValueClass.Create;
  403. ATestClass.AShortString := 'Hello World';
  404. try
  405. ARttiType := c.GetType(ATestClass.ClassInfo);
  406. Check(assigned(ARttiType));
  407. AProperty := ARttiType.GetProperty('aGetShortString');
  408. AValue := AProperty.GetValue(ATestClass);
  409. CheckEquals('Hello World',AValue.AsString);
  410. finally
  411. AtestClass.Free;
  412. end;
  413. CheckEquals('Hello World',AValue.AsString);
  414. finally
  415. c.Free;
  416. end;
  417. end;
  418. procedure TTestCase1.TestPropSetValueString;
  419. var
  420. ATestClass : TTestValueClass;
  421. c: TRttiContext;
  422. ARttiType: TRttiType;
  423. AProperty: TRttiProperty;
  424. AValue: TValue;
  425. s: string;
  426. begin
  427. c := TRttiContext.Create;
  428. try
  429. ATestClass := TTestValueClass.Create;
  430. try
  431. ARttiType := c.GetType(ATestClass.ClassInfo);
  432. AProperty := ARttiType.GetProperty('astring');
  433. s := 'ipse lorem or something like that';
  434. TValue.Make(@s, TypeInfo(s), AValue);
  435. AProperty.SetValue(ATestClass, AValue);
  436. CheckEquals(ATestClass.AString, s);
  437. s := 'Another string';
  438. CheckEquals(ATestClass.AString, 'ipse lorem or something like that');
  439. finally
  440. AtestClass.Free;
  441. end;
  442. finally
  443. c.Free;
  444. end;
  445. end;
  446. procedure TTestCase1.TestPropSetValueInteger;
  447. var
  448. ATestClass : TTestValueClass;
  449. c: TRttiContext;
  450. ARttiType: TRttiType;
  451. AProperty: TRttiProperty;
  452. AValue: TValue;
  453. i: integer;
  454. begin
  455. c := TRttiContext.Create;
  456. try
  457. ATestClass := TTestValueClass.Create;
  458. try
  459. ARttiType := c.GetType(ATestClass.ClassInfo);
  460. AProperty := ARttiType.GetProperty('aInteger');
  461. i := -43573;
  462. TValue.Make(@i, TypeInfo(i), AValue);
  463. AProperty.SetValue(ATestClass, AValue);
  464. CheckEquals(ATestClass.AInteger, i);
  465. i := 1;
  466. CheckEquals(ATestClass.AInteger, -43573);
  467. finally
  468. AtestClass.Free;
  469. end;
  470. finally
  471. c.Free;
  472. end;
  473. end;
  474. procedure TTestCase1.TestPropSetValueBoolean;
  475. var
  476. ATestClass : TTestValueClass;
  477. c: TRttiContext;
  478. ARttiType: TRttiType;
  479. AProperty: TRttiProperty;
  480. AValue: TValue;
  481. b: boolean;
  482. begin
  483. c := TRttiContext.Create;
  484. try
  485. ATestClass := TTestValueClass.Create;
  486. try
  487. ARttiType := c.GetType(ATestClass.ClassInfo);
  488. AProperty := ARttiType.GetProperty('aboolean');
  489. b := true;
  490. TValue.Make(@b, TypeInfo(b), AValue);
  491. AProperty.SetValue(ATestClass, AValue);
  492. CheckEquals(ATestClass.ABoolean, b);
  493. b := false;
  494. CheckEquals(ATestClass.ABoolean, true);
  495. TValue.Make(@b, TypeInfo(b), AValue);
  496. AProperty.SetValue(ATestClass, AValue);
  497. CheckEquals(ATestClass.ABoolean, false);
  498. finally
  499. AtestClass.Free;
  500. end;
  501. finally
  502. c.Free;
  503. end;
  504. end;
  505. procedure TTestCase1.TestPropSetValueShortString;
  506. var
  507. ATestClass : TTestValueClass;
  508. c: TRttiContext;
  509. ARttiType: TRttiType;
  510. AProperty: TRttiProperty;
  511. AValue: TValue;
  512. s: string;
  513. ss: ShortString;
  514. begin
  515. c := TRttiContext.Create;
  516. try
  517. ATestClass := TTestValueClass.Create;
  518. try
  519. ARttiType := c.GetType(ATestClass.ClassInfo);
  520. AProperty := ARttiType.GetProperty('aShortString');
  521. s := 'ipse lorem or something like that';
  522. TValue.Make(@s, TypeInfo(s), AValue);
  523. AProperty.SetValue(ATestClass, AValue);
  524. CheckEquals(ATestClass.AShortString, s);
  525. s := 'Another string';
  526. CheckEquals(ATestClass.AShortString, 'ipse lorem or something like that');
  527. ss := 'Hello World';
  528. TValue.Make(@ss, TypeInfo(ss), AValue);
  529. AProperty.SetValue(ATestClass, AValue);
  530. CheckEquals(ATestClass.AShortString, ss);
  531. ss := 'Foobar';
  532. CheckEquals(ATestClass.AShortString, 'Hello World');
  533. finally
  534. AtestClass.Free;
  535. end;
  536. finally
  537. c.Free;
  538. end;
  539. end;
  540. procedure TTestCase1.TestPropGetValueProcInteger;
  541. var
  542. ATestClass : TTestValueClass;
  543. c: TRttiContext;
  544. ARttiType: TRttiType;
  545. AProperty: TRttiProperty;
  546. AValue: TValue;
  547. begin
  548. c := TRttiContext.Create;
  549. try
  550. ATestClass := TTestValueClass.Create;
  551. ATestClass.AInteger := 472349;
  552. try
  553. ARttiType := c.GetType(ATestClass.ClassInfo);
  554. Check(assigned(ARttiType));
  555. AProperty := ARttiType.GetProperty('agetinteger');
  556. AValue := AProperty.GetValue(ATestClass);
  557. CheckEquals(472349,AValue.AsInteger);
  558. finally
  559. AtestClass.Free;
  560. end;
  561. CheckEquals(472349,AValue.AsInteger);
  562. finally
  563. c.Free;
  564. end;
  565. end;
  566. procedure TTestCase1.TestPropGetValueProcString;
  567. var
  568. ATestClass : TTestValueClass;
  569. c: TRttiContext;
  570. ARttiType: TRttiType;
  571. AProperty: TRttiProperty;
  572. AValue: TValue;
  573. begin
  574. c := TRttiContext.Create;
  575. try
  576. ATestClass := TTestValueClass.Create;
  577. ATestClass.AString := 'Hello World';
  578. try
  579. ARttiType := c.GetType(ATestClass.ClassInfo);
  580. Check(assigned(ARttiType));
  581. AProperty := ARttiType.GetProperty('agetstring');
  582. AValue := AProperty.GetValue(ATestClass);
  583. CheckEquals('Hello World',AValue.AsString);
  584. finally
  585. AtestClass.Free;
  586. end;
  587. CheckEquals('Hello World',AValue.AsString);
  588. finally
  589. c.Free;
  590. end;
  591. end;
  592. procedure TTestCase1.TestTRttiTypeProperties;
  593. var
  594. c: TRttiContext;
  595. ARttiType: TRttiType;
  596. begin
  597. c := TRttiContext.Create;
  598. try
  599. ARttiType := c.GetType(TTestValueClass);
  600. Check(assigned(ARttiType));
  601. CheckEquals(ARttiType.Name,'TTestValueClass');
  602. Check(ARttiType.TypeKind=tkClass);
  603. // CheckEquals(ARttiType.IsPublicType,false);
  604. CheckEquals(ARttiType.TypeSize,SizeOf(TObject));
  605. CheckEquals(ARttiType.IsManaged,false);
  606. CheckEquals(ARttiType.BaseType.classname,'TRttiInstanceType');
  607. CheckEquals(ARttiType.IsInstance,True);
  608. CheckEquals(ARttiType.AsInstance.DeclaringUnitName,'tests.rtti');
  609. Check(ARttiType.BaseType.Name='TObject');
  610. Check(ARttiType.AsInstance.BaseType.Name='TObject');
  611. CheckEquals(ARttiType.IsOrdinal,False);
  612. CheckEquals(ARttiType.IsRecord,False);
  613. CheckEquals(ARttiType.IsSet,False);
  614. finally
  615. c.Free;
  616. end;
  617. end;
  618. procedure TTestCase1.GetTypeInteger;
  619. var
  620. LContext: TRttiContext;
  621. LType: TRttiType;
  622. begin
  623. LContext := TRttiContext.Create;
  624. LType := LContext.GetType(TypeInfo(integer));
  625. CheckEquals(LType.Name, 'LongInt');
  626. LContext.Free;
  627. end;
  628. procedure TTestCase1.GetClassProperties;
  629. var
  630. LContext: TRttiContext;
  631. LType: TRttiType;
  632. PropList: {$ifdef fpc}specialize{$endif} TArray<TRttiProperty>;
  633. begin
  634. LContext := TRttiContext.Create;
  635. LType := LContext.GetType(TypeInfo(TGetClassProperties));
  636. PropList := LType.GetProperties;
  637. CheckEquals(4, length(PropList));
  638. CheckEquals('PubPropRO', PropList[0].Name);
  639. CheckEquals('PubPropRW', PropList[1].Name);
  640. CheckEquals('PubPropSetRO', PropList[2].Name);
  641. CheckEquals('PubPropSetRW', PropList[3].Name);
  642. LContext.Free;
  643. end;
  644. procedure TTestCase1.GetClassPropertiesValue;
  645. var
  646. AGetClassProperties: TGetClassProperties;
  647. LContext: TRttiContext;
  648. LType: TRttiType;
  649. AValue: TValue;
  650. begin
  651. LContext := TRttiContext.Create;
  652. LType := LContext.GetType(TGetClassProperties);
  653. AGetClassProperties := TGetClassProperties.Create;
  654. try
  655. AGetClassProperties.PubPropRW:=12345;
  656. AValue := LType.GetProperty('PubPropRW').GetValue(AGetClassProperties);
  657. CheckEquals(12345, AValue.AsInteger);
  658. finally
  659. AGetClassProperties.Free;
  660. end;
  661. LContext.Free;
  662. end;
  663. procedure TTestCase1.TestIsManaged;
  664. begin
  665. CheckEquals(true, IsManaged(TypeInfo(ansistring)), 'IsManaged for tkAString');
  666. CheckEquals(true, IsManaged(TypeInfo(widestring)), 'IsManaged for tkWString');
  667. CheckEquals(true, IsManaged(TypeInfo(Variant)), 'IsManaged for tkVariant');
  668. CheckEquals(true, IsManaged(TypeInfo(TArrayOfManagedRec)),
  669. 'IsManaged for tkArray (with managed ElType)');
  670. CheckEquals(true, IsManaged(TypeInfo(TArrayOfString)),
  671. 'IsManaged for tkArray (with managed ElType)');
  672. CheckEquals(true, IsManaged(TypeInfo(TManagedRec)), 'IsManaged for tkRecord');
  673. CheckEquals(true, IsManaged(TypeInfo(TManagedRecOp)), 'IsManaged for tkRecord');
  674. CheckEquals(true, IsManaged(TypeInfo(IInterface)), 'IsManaged for tkInterface');
  675. CheckEquals(true, IsManaged(TypeInfo(TManagedObj)), 'IsManaged for tkObject');
  676. {$ifdef fpc}
  677. CheckEquals(true, IsManaged(TypeInfo(specialize TArray<byte>)), 'IsManaged for tkDynArray');
  678. {$else}
  679. CheckEquals(true, IsManaged(TypeInfo(TArray<byte>)), 'IsManaged for tkDynArray');
  680. {$endif}
  681. CheckEquals(true, IsManaged(TypeInfo(unicodestring)), 'IsManaged for tkUString');
  682. CheckEquals(false, IsManaged(TypeInfo(shortstring)), 'IsManaged for tkSString');
  683. CheckEquals(false, IsManaged(TypeInfo(Byte)), 'IsManaged for tkInteger');
  684. CheckEquals(false, IsManaged(TypeInfo(Char)), 'IsManaged for tkChar');
  685. CheckEquals(false, IsManaged(TypeInfo(TTestEnum)), 'IsManaged for tkEnumeration');
  686. CheckEquals(false, IsManaged(TypeInfo(Single)), 'IsManaged for tkFloat');
  687. CheckEquals(false, IsManaged(TypeInfo(TTestSet)), 'IsManaged for tkSet');
  688. CheckEquals(false, IsManaged(TypeInfo(TTestMethod)), 'IsManaged for tkMethod');
  689. CheckEquals(false, IsManaged(TypeInfo(TArrayOfByte)),
  690. 'IsManaged for tkArray (with non managed ElType)');
  691. CheckEquals(false, IsManaged(TypeInfo(TArrayOfNonManagedRec)),
  692. 'IsManaged for tkArray (with non managed ElType)');
  693. CheckEquals(false, IsManaged(TypeInfo(TNonManagedRec)), 'IsManaged for tkRecord');
  694. CheckEquals(false, IsManaged(TypeInfo(TObject)), 'IsManaged for tkClass');
  695. CheckEquals(false, IsManaged(TypeInfo(TNonManagedObj)), 'IsManaged for tkObject');
  696. CheckEquals(false, IsManaged(TypeInfo(WideChar)), 'IsManaged for tkWChar');
  697. CheckEquals(false, IsManaged(TypeInfo(Boolean)), 'IsManaged for tkBool');
  698. CheckEquals(false, IsManaged(TypeInfo(Int64)), 'IsManaged for tkInt64');
  699. CheckEquals(false, IsManaged(TypeInfo(UInt64)), 'IsManaged for tkQWord');
  700. CheckEquals(false, IsManaged(TypeInfo(ICORBATest)), 'IsManaged for tkInterfaceRaw');
  701. CheckEquals(false, IsManaged(TypeInfo(TTestProc)), 'IsManaged for tkProcVar');
  702. CheckEquals(false, IsManaged(TypeInfo(TTestHelper)), 'IsManaged for tkHelper');
  703. CheckEquals(false, IsManaged(TypeInfo(file)), 'IsManaged for tkFile');
  704. CheckEquals(false, IsManaged(TypeInfo(TClass)), 'IsManaged for tkClassRef');
  705. CheckEquals(false, IsManaged(TypeInfo(Pointer)), 'IsManaged for tkPointer');
  706. CheckEquals(false, IsManaged(nil), 'IsManaged for nil');
  707. end;
  708. initialization
  709. {$ifdef fpc}
  710. RegisterTest(TTestCase1);
  711. {$else fpc}
  712. RegisterTest(TTestCase1.Suite);
  713. {$endif fpc}
  714. end.