tests.rtti.pas 21 KB

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