tests.generics.stdcollections.pas 21 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919
  1. {
  2. This file is part of the Free Pascal run time library.
  3. Copyright (c) 2018 by Maciej Izak (hnb),
  4. member of the Free Pascal development team
  5. It contains tests for the Free Pascal generics library
  6. See the file COPYING.FPC, included in this distribution,
  7. for details about the copyright.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  11. Acknowledgment
  12. Thanks to Sphere 10 Software (http://sphere10.com) for sponsoring
  13. many new types, tests and major refactoring of entire library
  14. Thanks to Castle Game Engine (https://castle-engine.sourceforge.io)
  15. Part of tests for this module was copied from Castle Game Engine tests
  16. **********************************************************************}
  17. unit tests.generics.stdcollections;
  18. {$mode delphi}
  19. interface
  20. uses
  21. fpcunit, testutils, testregistry, tests.generics.utils,
  22. Classes, SysUtils, Generics.Collections, Generics.Defaults;
  23. type
  24. TTestStdCollections = class(TTestCollections)
  25. private
  26. procedure Test_TList_Notification(AList: TList<string>); overload;
  27. published
  28. // Tests from Castle Game Engine
  29. procedure Test_List;
  30. procedure Test_FreeingManually;
  31. procedure Test_AddingLists;
  32. procedure Test_Sort;
  33. procedure Test_Pack;
  34. procedure Test_RecordsList;
  35. procedure Test_VectorsList;
  36. procedure Test_MethodsList;
  37. // My (c) tests
  38. procedure Test_SortedList;
  39. procedure Test_Queue;
  40. procedure Test_GenericListBox;
  41. procedure Test_TList_Notification; overload;
  42. procedure Test_TSortedList_Notification;
  43. procedure Test_TQueue_Notification;
  44. procedure Test_TStack_Notification;
  45. procedure Test_TObjectList_Notification;
  46. procedure Test_TObjectQueue_Notification;
  47. procedure Test_TObjectStack_Notification;
  48. procedure Test_TrimExcess;
  49. end;
  50. TGenericListBox<T> = class
  51. private class var
  52. F : TList<TComponentClass>;
  53. class procedure Test(ATest: TTestCase);
  54. end;
  55. implementation
  56. class procedure TGenericListBox<T>.Test(ATest: TTestCase);
  57. begin
  58. F := TList<TComponentClass>.Create;
  59. F.Add(TDataModule);
  60. F.Add(nil);
  61. with TList<TComponentClass>.Create(F) do
  62. begin
  63. ATest.AssertTrue(Count = 2);
  64. ATest.AssertTrue(F[0] = Items[0]);
  65. ATest.AssertTrue(F[1] = Items[1]);
  66. ATest.AssertTrue(F[0] = TDataModule);
  67. ATest.AssertTrue(F[1] = nil);
  68. Free;
  69. end;
  70. F.Free;
  71. end;
  72. type
  73. TApple = class
  74. Name: string;
  75. end;
  76. type
  77. TAppleList = class(TObjectList<TApple>)
  78. procedure Pack;
  79. end;
  80. procedure TAppleList.Pack;
  81. begin
  82. while Remove(nil) <> -1 do ;
  83. end;
  84. procedure TTestStdCollections.Test_List;
  85. var
  86. A: TApple;
  87. Apples: TAppleList;
  88. begin
  89. Apples := TAppleList.Create(true);
  90. try
  91. A := TApple.Create;
  92. Apples.Add(A);
  93. Apples.Add(TApple.Create);
  94. A := TApple.Create;
  95. Apples.Add(A);
  96. AssertEquals(3, Apples.Count);
  97. AssertEquals(2, Apples.IndexOf(A));
  98. Apples.Delete(0);
  99. AssertEquals(2, Apples.Count);
  100. AssertEquals(1, Apples.IndexOf(A));
  101. Apples.Remove(A);
  102. AssertEquals(1, Apples.Count);
  103. Apples.Delete(0);
  104. AssertEquals(0, Apples.Count);
  105. finally FreeAndNil(Apples) end;
  106. end;
  107. procedure TTestStdCollections.Test_FreeingManually;
  108. var
  109. A: TApple;
  110. Apples: TAppleList;
  111. begin
  112. Apples := TAppleList.Create(false);
  113. try
  114. A := TApple.Create;
  115. Apples.Add(A);
  116. Apples.Add(A);
  117. Apples.Add(TApple.Create);
  118. { This freeing would be invalid on a list that owns children,
  119. as we free something twice, and we leave some invalid references
  120. (to already freed items) in the list at various stages.
  121. But it should be OK with list that has OwnsChildren = false. }
  122. Apples[0].Free;
  123. Apples[0] := nil;
  124. Apples[1] := nil;
  125. Apples[2].Free;
  126. finally FreeAndNil(Apples) end;
  127. end;
  128. procedure TTestStdCollections.Test_AddingLists;
  129. var
  130. A: TApple;
  131. Apples, Apples2: TAppleList;
  132. begin
  133. Apples := TAppleList.Create(true);
  134. try
  135. A := TApple.Create;
  136. A.Name := 'One';
  137. Apples.Add(A);
  138. A := TApple.Create;
  139. A.Name := 'Two';
  140. Apples.Add(A);
  141. Apples2 := TAppleList.Create(false);
  142. try
  143. Apples2.AddRange(Apples);
  144. Apples2.AddRange(Apples);
  145. Apples2.AddRange(Apples);
  146. AssertEquals(6, Apples2.Count);
  147. AssertEquals('One', Apples2[0].Name);
  148. AssertEquals('Two', Apples2[1].Name);
  149. AssertEquals('One', Apples2[2].Name);
  150. AssertEquals('Two', Apples2[3].Name);
  151. AssertEquals('One', Apples2[4].Name);
  152. AssertEquals('Two', Apples2[5].Name);
  153. finally FreeAndNil(Apples2) end;
  154. finally FreeAndNil(Apples) end;
  155. end;
  156. function CompareApples(constref Left, Right: TApple): Integer;
  157. begin
  158. Result := AnsiCompareStr(Left.Name, Right.Name);
  159. end;
  160. procedure TTestStdCollections.Test_Sort;
  161. type
  162. TAppleComparer = TComparer<TApple>;
  163. var
  164. A: TApple;
  165. L: TAppleList;
  166. begin
  167. L := TAppleList.Create(true);
  168. try
  169. A := TApple.Create;
  170. A.Name := '11';
  171. L.Add(A);
  172. A := TApple.Create;
  173. A.Name := '33';
  174. L.Add(A);
  175. A := TApple.Create;
  176. A.Name := '22';
  177. L.Add(A);
  178. L.Sort(TAppleComparer.Construct(@CompareApples));
  179. AssertEquals(3, L.Count);
  180. AssertEquals('11', L[0].Name);
  181. AssertEquals('22', L[1].Name);
  182. AssertEquals('33', L[2].Name);
  183. finally FreeAndNil(L) end;
  184. end;
  185. procedure TTestStdCollections.Test_Pack;
  186. var
  187. A: TApple;
  188. L: TAppleList;
  189. begin
  190. L := TAppleList.Create(true);
  191. try
  192. L.Add(nil);
  193. A := TApple.Create;
  194. A.Name := '11';
  195. L.Add(A);
  196. L.Add(nil);
  197. A := TApple.Create;
  198. A.Name := '33';
  199. L.Add(A);
  200. A := TApple.Create;
  201. A.Name := '22';
  202. L.Add(A);
  203. L.Add(nil);
  204. L.Add(nil);
  205. L.Pack;
  206. AssertEquals(3, L.Count);
  207. AssertEquals('11', L[0].Name);
  208. AssertEquals('33', L[1].Name);
  209. AssertEquals('22', L[2].Name);
  210. finally FreeAndNil(L) end;
  211. end;
  212. procedure TTestStdCollections.Test_RecordsList;
  213. type
  214. TMyRecord = packed record
  215. A, B: Integer;
  216. end;
  217. TMyRecordList = TList<TMyRecord>;
  218. var
  219. List: TMyRecordList;
  220. R1, R2, R: TMyRecord;
  221. begin
  222. List := TMyRecordList.Create;
  223. try
  224. R1.A := 11;
  225. R1.B := 22;
  226. List.Add(R1);
  227. R2.A := 33;
  228. R2.B := 44;
  229. List.Add(R2);
  230. R2.A := 33;
  231. R2.B := 44;
  232. List.Add(R2);
  233. AssertEquals(3, List.Count);
  234. AssertEquals(11, List[0].A);
  235. AssertEquals(22, List[0].B);
  236. AssertEquals(33, List[1].A);
  237. AssertEquals(44, List[1].B);
  238. AssertEquals(33, List[2].A);
  239. AssertEquals(44, List[2].B);
  240. List.Delete(2);
  241. AssertEquals(2, List.Count);
  242. AssertEquals(11, List[0].A);
  243. AssertEquals(22, List[0].B);
  244. AssertEquals(33, List[1].A);
  245. AssertEquals(44, List[1].B);
  246. AssertEquals(0, List.IndexOf(R1));
  247. AssertEquals(1, List.IndexOf(R2));
  248. // change R1 and R2, to make sure it doesn't matter for tests
  249. R1.A := 111111;
  250. R1.B := 222222;
  251. R2.A := 333333;
  252. R2.B := 444444;
  253. AssertEquals(-1, List.IndexOf(R1));
  254. AssertEquals(-1, List.IndexOf(R2));
  255. R.A := 11;
  256. R.B := 22;
  257. AssertEquals(0, List.IndexOf(R));
  258. R.A := 33;
  259. R.B := 44;
  260. AssertEquals(1, List.IndexOf(R));
  261. R.A := 11;
  262. R.B := 22;
  263. List.Remove(R);
  264. AssertEquals(1, List.Count);
  265. AssertEquals(33, List[0].A);
  266. AssertEquals(44, List[0].B);
  267. R.A := 666;
  268. R.B := 22;
  269. List.Remove(R); // does nothing, no such record
  270. AssertEquals(1, List.Count);
  271. AssertEquals(33, List[0].A);
  272. AssertEquals(44, List[0].B);
  273. finally FreeAndNil(List) end;
  274. end;
  275. procedure TTestStdCollections.Test_VectorsList;
  276. type
  277. TMyVector = packed array [0..1] of Single;
  278. TMyVectorList = TList<TMyVector>;
  279. var
  280. List: TMyVectorList;
  281. R1, R2, R: TMyVector;
  282. begin
  283. List := TMyVectorList.Create;
  284. try
  285. R1[0] := 11;
  286. R1[1] := 22;
  287. List.Add(R1);
  288. R2[0] := 33;
  289. R2[1] := 44;
  290. List.Add(R2);
  291. R2[0] := 33;
  292. R2[1] := 44;
  293. List.Add(R2);
  294. AssertEquals(3, List.Count);
  295. AssertEquals(11, List[0][0]);
  296. AssertEquals(22, List[0][1]);
  297. AssertEquals(33, List[1][0]);
  298. AssertEquals(44, List[1][1]);
  299. AssertEquals(33, List[2][0]);
  300. AssertEquals(44, List[2][1]);
  301. List.Delete(2);
  302. AssertEquals(2, List.Count);
  303. AssertEquals(11, List[0][0]);
  304. AssertEquals(22, List[0][1]);
  305. AssertEquals(33, List[1][0]);
  306. AssertEquals(44, List[1][1]);
  307. AssertEquals(0, List.IndexOf(R1));
  308. AssertEquals(1, List.IndexOf(R2));
  309. // change R1 and R2, to make sure it doesn't matter for tests
  310. R1[0] := 111111;
  311. R1[1] := 222222;
  312. R2[0] := 333333;
  313. R2[1] := 444444;
  314. AssertEquals(-1, List.IndexOf(R1));
  315. AssertEquals(-1, List.IndexOf(R2));
  316. R[0] := 11;
  317. R[1] := 22;
  318. AssertEquals(0, List.IndexOf(R));
  319. R[0] := 33;
  320. R[1] := 44;
  321. AssertEquals(1, List.IndexOf(R));
  322. R[0] := 11;
  323. R[1] := 22;
  324. List.Remove(R);
  325. AssertEquals(1, List.Count);
  326. AssertEquals(33, List[0][0]);
  327. AssertEquals(44, List[0][1]);
  328. R[0] := 666;
  329. R[1] := 22;
  330. List.Remove(R); // does nothing, no such item
  331. AssertEquals(1, List.Count);
  332. AssertEquals(33, List[0][0]);
  333. AssertEquals(44, List[0][1]);
  334. finally FreeAndNil(List) end;
  335. end;
  336. type
  337. TSomeClass = class
  338. procedure Foo(A: Integer);
  339. end;
  340. procedure TSomeClass.Foo(A: Integer);
  341. begin
  342. end;
  343. procedure TTestStdCollections.Test_MethodsList;
  344. type
  345. TMyMethod = procedure (A: Integer) of object;
  346. TMyMethodList = TList<TMyMethod>;
  347. procedure AssertMethodsEqual(const M1, M2: TMyMethod);
  348. begin
  349. AssertTrue(TMethod(M1).Code = TMethod(M2).Code);
  350. AssertTrue(TMethod(M1).Data = TMethod(M2).Data);
  351. end;
  352. var
  353. List: TMyMethodList;
  354. C1, C2, C3: TSomeClass;
  355. M: TMyMethod;
  356. begin
  357. C1 := TSomeClass.Create;
  358. C2 := TSomeClass.Create;
  359. C3 := TSomeClass.Create;
  360. List := TMyMethodList.Create;
  361. try
  362. List.Add(C1.Foo);
  363. List.Add(C2.Foo);
  364. List.Add(C2.Foo);
  365. AssertEquals(3, List.Count);
  366. M := C1.Foo;
  367. AssertMethodsEqual(List[0], M);
  368. M := C2.Foo;
  369. AssertMethodsEqual(List[1], M);
  370. AssertMethodsEqual(List[2], M);
  371. List.Delete(2);
  372. AssertEquals(2, List.Count);
  373. M := C1.Foo;
  374. AssertMethodsEqual(List[0], M);
  375. M := C2.Foo;
  376. AssertMethodsEqual(List[1], M);
  377. AssertEquals(0, List.IndexOf(C1.Foo));
  378. AssertEquals(1, List.IndexOf(C2.Foo));
  379. AssertEquals(-1, List.IndexOf(C3.Foo));
  380. List.Remove(C1.Foo);
  381. AssertEquals(1, List.Count);
  382. M := C2.Foo;
  383. AssertMethodsEqual(List[0], M);
  384. List.Remove(C3.Foo); // does nothing, no such item
  385. AssertEquals(1, List.Count);
  386. M := C2.Foo;
  387. AssertMethodsEqual(List[0], M);
  388. finally FreeAndNil(List) end;
  389. C1.Free;
  390. C2.Free;
  391. C3.Free;
  392. end;
  393. procedure TTestStdCollections.Test_SortedList;
  394. var
  395. LSortedList: TSortedList<Integer>;
  396. i: integer;
  397. LRandomOrder: TArray<Integer>;
  398. begin
  399. LRandomOrder := TArray<Integer>.Create(
  400. 10, 8, 17, 19, 2, 0, 13, 15, 5, 7, 12, 14, 4, 6, 11, 9, 16, 18, 3, 1);
  401. LSortedList := TSortedList<Integer>.Create;
  402. for i in LRandomOrder do
  403. LSortedList.Add(i);
  404. AssertEquals('Wrong Count value for TSortedList', Length(LRandomOrder), LSortedList.Count);
  405. for i := 0 to 19 do
  406. AssertEquals(Format('Wrong item (%d) index (%d) in TSortedList',[LSortedList[i], i]), i, LSortedList[i]);
  407. LSortedList.Free;
  408. end;
  409. procedure TTestStdCollections.Test_Queue;
  410. const
  411. NUMBERS: array[0..2] of Integer = (3,4,5);
  412. var
  413. LQueue: TQueue<Integer>;
  414. i: Integer;
  415. j: Integer;
  416. pi: Pinteger;
  417. begin
  418. LQueue := TQueue<Integer>.Create;
  419. for i := 1 to 5 do
  420. begin
  421. LQueue.Enqueue(i);
  422. AssertEquals(LQueue.Peek, 1);
  423. end;
  424. AssertEquals(LQueue.Dequeue, 1);
  425. AssertEquals(LQueue.Extract, 2);
  426. j := 0;
  427. for i in LQueue do
  428. begin
  429. AssertEquals(i, NUMBERS[j]);
  430. Inc(j);
  431. end;
  432. j := 0;
  433. for pi in LQueue.Ptr^ do
  434. begin
  435. AssertEquals(pi^, NUMBERS[j]);
  436. Inc(j);
  437. end;
  438. LQueue.Free;
  439. end;
  440. procedure TTestStdCollections.Test_TList_Notification(AList: TList<string>);
  441. var
  442. LStringsObj: TEnumerable<string>;
  443. LStringsIntf: IEnumerable<string>;
  444. begin
  445. try
  446. LStringsObj := EnumerableStringsObj(['Ddd', 'Eee']);
  447. LStringsIntf := EnumerableStringsIntf(['Fff', 'Ggg']);
  448. AList.OnNotify := NotifyTestStr;
  449. { Add + AddRange }
  450. NotificationAdd(AList, ['Aaa', 'Bbb', 'Ccc', 'Ddd', 'Eee', 'Fff', 'Ggg'], cnAdded);
  451. AList.Add('Aaa');
  452. AList.AddRange(['Bbb', 'Ccc']);
  453. AList.AddRange(LStringsObj);
  454. AList.AddRange(LStringsIntf);
  455. AssertNotificationsExecutedStr;
  456. { Clear }
  457. NotificationAdd(AList, ['Aaa', 'Bbb', 'Ccc', 'Ddd', 'Eee', 'Fff', 'Ggg'], cnRemoved);
  458. AList.Clear;
  459. AssertNotificationsExecutedStr;
  460. { Insert + InsertRange }
  461. NotificationAdd(AList, ['Aaa', 'Bbb', 'Ccc', 'Ddd', 'Eee', 'Fff', 'Ggg'], cnAdded);
  462. AList.Insert(0, 'Aaa');
  463. AList.InsertRange(1, ['Bbb', 'Ccc']);
  464. AList.InsertRange(3, LStringsObj);
  465. AList.InsertRange(5, LStringsIntf);
  466. AssertNotificationsExecutedStr;
  467. { Remove + Delete + DeleteRange }
  468. NotificationAdd(AList, ['Aaa', 'Bbb', 'Ccc', 'Ddd', 'Eee', 'Fff', 'Ggg'], cnRemoved);
  469. AList.Remove('Aaa');
  470. AList.Delete(0);
  471. AList.DeleteRange(0, 5);
  472. AssertEquals(AList.Count, 0);
  473. AssertNotificationsExecutedStr;
  474. { ExtractIndex, Extract }
  475. NotificationAdd(AList, ['Aaa', 'Bbb', 'Ccc'], cnAdded);
  476. AList.AddRange(['Aaa', 'Bbb', 'Ccc']);
  477. AssertNotificationsExecutedStr;
  478. NotificationAdd(AList, ['Aaa', 'Bbb'], cnExtracted);
  479. AssertEquals(AList.ExtractIndex(0), 'Aaa');
  480. AssertEquals(AList.Extract('Bbb'), 'Bbb');
  481. AssertNotificationsExecutedStr;
  482. { SetItem }
  483. NotificationAdd(AList, 'Ccc', cnRemoved);
  484. NotificationAdd(AList, 'FPC', cnAdded);
  485. AList[0] := 'FPC';
  486. AssertNotificationsExecutedStr;
  487. finally
  488. LStringsObj.Free;
  489. { Free }
  490. NotificationAdd(AList, 'FPC', cnRemoved);
  491. AList.Free;
  492. AssertNotificationsExecutedStr;
  493. end;
  494. end;
  495. procedure TTestStdCollections.Test_TList_Notification;
  496. begin
  497. Test_TList_Notification(TList<string>.Create);
  498. end;
  499. procedure TTestStdCollections.Test_TSortedList_Notification;
  500. var
  501. LList: TSortedList<string>;
  502. begin
  503. LList := TSortedList<string>.Create;
  504. LList.SortStyle := cssUser;
  505. Test_TList_Notification(LList);
  506. end;
  507. procedure TTestStdCollections.Test_TQueue_Notification;
  508. var
  509. LQueue: TQueue<string>;
  510. begin
  511. LQueue := TQueue<string>.Create();
  512. try
  513. LQueue.OnNotify := NotifyTestStr;
  514. { Enqueue }
  515. NotificationAdd(LQueue, ['Aaa', 'Bbb', 'Ccc', 'Ddd'], cnAdded);
  516. LQueue.Enqueue('Aaa');
  517. LQueue.Enqueue('Bbb');
  518. LQueue.Enqueue('Ccc');
  519. LQueue.Enqueue('Ddd');
  520. AssertNotificationsExecutedStr;
  521. { Dequeue }
  522. NotificationAdd(LQueue, 'Aaa', cnRemoved);
  523. AssertEquals(LQueue.Dequeue, 'Aaa');
  524. AssertNotificationsExecutedStr;
  525. { Extract }
  526. NotificationAdd(LQueue, 'Bbb', cnExtracted);
  527. AssertEquals(LQueue.Extract, 'Bbb');
  528. AssertNotificationsExecutedStr;
  529. { Clear }
  530. NotificationAdd(LQueue, ['Ccc', 'Ddd'], cnRemoved);
  531. LQueue.Clear;
  532. AssertNotificationsExecutedStr;
  533. { Enqueue }
  534. NotificationAdd(LQueue, ['FPC', 'Polandball'], cnAdded);
  535. LQueue.Enqueue('FPC');
  536. LQueue.Enqueue('Polandball');
  537. AssertNotificationsExecutedStr;
  538. finally
  539. NotificationAdd(LQueue, ['FPC', 'Polandball'], cnRemoved);
  540. LQueue.Free;
  541. AssertNotificationsExecutedStr;
  542. end;
  543. end;
  544. procedure TTestStdCollections.Test_TStack_Notification;
  545. var
  546. LStack: TStack<string>;
  547. begin
  548. LStack := TStack<string>.Create();
  549. try
  550. LStack.OnNotify := NotifyTestStr;
  551. { Push }
  552. NotificationAdd(LStack, ['Aaa', 'Bbb', 'Ccc', 'Ddd'], cnAdded);
  553. LStack.Push('Aaa');
  554. LStack.Push('Bbb');
  555. LStack.Push('Ccc');
  556. LStack.Push('Ddd');
  557. AssertNotificationsExecutedStr;
  558. { Pop }
  559. NotificationAdd(LStack, 'Ddd', cnRemoved);
  560. AssertEquals(LStack.Pop, 'Ddd');
  561. AssertNotificationsExecutedStr;
  562. { Extract }
  563. NotificationAdd(LStack, 'Ccc', cnExtracted);
  564. AssertEquals(LStack.Extract, 'Ccc');
  565. AssertNotificationsExecutedStr;
  566. { Clear }
  567. NotificationAdd(LStack, ['Bbb', 'Aaa'], cnRemoved);
  568. LStack.Clear;
  569. AssertNotificationsExecutedStr;
  570. { Push }
  571. NotificationAdd(LStack, ['FPC', 'Polandball'], cnAdded);
  572. LStack.Push('FPC');
  573. LStack.Push('Polandball');
  574. AssertNotificationsExecutedStr;
  575. finally
  576. NotificationAdd(LStack, ['Polandball', 'FPC'], cnRemoved);
  577. LStack.Free;
  578. AssertNotificationsExecutedStr;
  579. end;
  580. end;
  581. procedure TTestStdCollections.Test_TObjectList_Notification;
  582. var
  583. LObj: TEnumerable<TObject>;
  584. LIntf: IEnumerable<TObject>;
  585. O: TArray<TObject>;
  586. LList: TObjectList<TObject>;
  587. i: Integer;
  588. begin
  589. try
  590. CreateObjects(O, 8);
  591. LList := TObjectList<TObject>.Create(false);
  592. LList.OnNotify := NotifyTestObj;
  593. LObj := EnumerableObjectsObj([O[3], O[4]]);
  594. LIntf := EnumerableObjectsIntf([O[5], O[6]]);
  595. { Add + AddRange }
  596. NotificationAdd(LList, [O[0], O[1], O[2], O[3], O[4], O[5], O[6]], cnAdded);
  597. LList.Add(O[0]);
  598. LList.AddRange([O[1], O[2]]);
  599. LList.AddRange(LObj);
  600. LList.AddRange(LIntf);
  601. AssertNotificationsExecutedObj;
  602. { Clear }
  603. NotificationAdd(LList, [O[0], O[1], O[2], O[3], O[4], O[5], O[6]], cnRemoved);
  604. LList.Clear;
  605. AssertNotificationsExecutedObj;
  606. { Insert + InsertRange }
  607. NotificationAdd(LList, [O[0], O[1], O[2], O[3], O[4], O[5], O[6]], cnAdded);
  608. LList.Insert(0, O[0]);
  609. LList.InsertRange(1, [O[1], O[2]]);
  610. LList.InsertRange(3, LObj);
  611. LList.InsertRange(5, LIntf);
  612. AssertNotificationsExecutedObj;
  613. { Remove + Delete + DeleteRange }
  614. NotificationAdd(LList, [O[0], O[1], O[2], O[3], O[4], O[5], O[6]], cnRemoved);
  615. LList.Remove(O[0]);
  616. LList.Delete(0);
  617. LList.DeleteRange(0, 5);
  618. AssertEquals(LList.Count, 0);
  619. AssertNotificationsExecutedObj;
  620. { ExtractIndex, Extract }
  621. NotificationAdd(LList, [O[0], O[1], O[2]], cnAdded);
  622. LList.AddRange([O[0], O[1], O[2]]);
  623. AssertNotificationsExecutedObj;
  624. NotificationAdd(LList, [O[0], O[1]], cnExtracted);
  625. AssertTrue(LList.ExtractIndex(0) = O[0]);
  626. AssertTrue(LList.Extract(O[1]) = O[1]);
  627. AssertNotificationsExecutedObj;
  628. { SetItem }
  629. NotificationAdd(LList, O[2], cnRemoved);
  630. NotificationAdd(LList, O[7], cnAdded);
  631. LList[0] := O[7];
  632. AssertNotificationsExecutedObj;
  633. finally
  634. LObj.Free;
  635. { Free }
  636. NotificationAdd(LList, O[7], cnRemoved);
  637. FreeObjects(O);
  638. LList.Free;
  639. AssertNotificationsExecutedObj;
  640. end;
  641. end;
  642. procedure TTestStdCollections.Test_TObjectQueue_Notification;
  643. var
  644. LQueue: TObjectQueue<TObject>;
  645. O: TArray<TObject>;
  646. begin
  647. LQueue := TObjectQueue<TObject>.Create(false);
  648. try
  649. CreateObjects(O, 6);
  650. LQueue.OnNotify := NotifyTestObj;
  651. { Enqueue }
  652. NotificationAdd(LQueue, [O[0], O[1], O[2], O[3]], cnAdded);
  653. LQueue.Enqueue(O[0]);
  654. LQueue.Enqueue(O[1]);
  655. LQueue.Enqueue(O[2]);
  656. LQueue.Enqueue(O[3]);
  657. AssertNotificationsExecutedObj;
  658. { Dequeue }
  659. NotificationAdd(LQueue, O[0], cnRemoved);
  660. LQueue.Dequeue;
  661. AssertNotificationsExecutedObj;
  662. { Extract }
  663. NotificationAdd(LQueue, O[1], cnExtracted);
  664. AssertTrue(LQueue.Extract = O[1]);
  665. AssertNotificationsExecutedObj;
  666. { Clear }
  667. NotificationAdd(LQueue, [O[2], O[3]], cnRemoved);
  668. LQueue.Clear;
  669. AssertNotificationsExecutedObj;
  670. { Enqueue }
  671. NotificationAdd(LQueue, [O[4], O[5]], cnAdded);
  672. LQueue.Enqueue(O[4]);
  673. LQueue.Enqueue(O[5]);
  674. AssertNotificationsExecutedObj;
  675. finally
  676. NotificationAdd(LQueue, [O[4], O[5]], cnRemoved);
  677. FreeObjects(O);
  678. LQueue.Free;
  679. AssertNotificationsExecutedObj;
  680. end;
  681. end;
  682. procedure TTestStdCollections.Test_TObjectStack_Notification;
  683. var
  684. LStack: TStack<TObject>;
  685. O: TArray<TObject>;
  686. begin
  687. LStack := TObjectStack<TObject>.Create(false);
  688. try
  689. CreateObjects(O, 6);
  690. LStack.OnNotify := NotifyTestObj;
  691. { Push }
  692. NotificationAdd(LStack, [O[0], O[1], O[2], O[3]], cnAdded);
  693. LStack.Push(O[0]);
  694. LStack.Push(O[1]);
  695. LStack.Push(O[2]);
  696. LStack.Push(O[3]);
  697. AssertNotificationsExecutedObj;
  698. { Pop }
  699. NotificationAdd(LStack, O[3], cnRemoved);
  700. AssertTrue(LStack.Pop = O[3]);
  701. AssertNotificationsExecutedObj;
  702. { Extract }
  703. NotificationAdd(LStack, O[2], cnExtracted);
  704. AssertTrue(LStack.Extract = O[2]);
  705. AssertNotificationsExecutedObj;
  706. { Clear }
  707. NotificationAdd(LStack, [O[1], O[0]], cnRemoved);
  708. LStack.Clear;
  709. AssertNotificationsExecutedObj;
  710. { Pop }
  711. NotificationAdd(LStack, [O[4], O[5]], cnAdded);
  712. LStack.Push(O[4]);
  713. LStack.Push(O[5]);
  714. AssertNotificationsExecutedObj;
  715. finally
  716. NotificationAdd(LStack, [O[5], O[4]], cnRemoved);
  717. FreeObjects(O);
  718. LStack.Free;
  719. AssertNotificationsExecutedObj;
  720. end;
  721. end;
  722. procedure TTestStdCollections.Test_GenericListBox;
  723. begin
  724. TGenericListBox<Integer>.Test(Self);
  725. end;
  726. procedure TTestStdCollections.Test_TrimExcess;
  727. var
  728. LList: TList<Integer>;
  729. LQueue: TQueue<Integer>;
  730. LStack: TStack<Integer>;
  731. begin
  732. LList := TList<Integer>.Create;
  733. LQueue := TQueue<Integer>.Create;
  734. LStack := TStack<Integer>.Create;
  735. try
  736. LList.AddRange([1, 2, 3, 4, 5, 6]);
  737. LList.DeleteRange(2, 3);
  738. CheckNotEquals(LList.Capacity, LList.Count);
  739. LList.TrimExcess;
  740. AssertEquals(LList.Capacity, LList.Count);
  741. LQueue.Enqueue(1);
  742. LQueue.Enqueue(2);
  743. LQueue.Dequeue;
  744. CheckNotEquals(LQueue.Capacity, LQueue.Count);
  745. LQueue.TrimExcess;
  746. AssertEquals(LQueue.Capacity, LQueue.Count);
  747. LStack.Push(1);
  748. LStack.Push(2);
  749. LStack.Pop;
  750. CheckNotEquals(LStack.Capacity, LStack.Count);
  751. LStack.TrimExcess;
  752. AssertEquals(LStack.Capacity, LStack.Count);
  753. finally
  754. LStack.Free;
  755. LQueue.Free;
  756. LList.Free;
  757. end;
  758. end;
  759. begin
  760. RegisterTest(TTestStdCollections);
  761. end.