source: Generics/NativeGenerics/Demo/UMainForm.pas

Last change on this file was 496, checked in by chronos, 8 years ago
  • Modified: New native generics classes working under FPC 3.0 transformed from TemplateGenerics package.
File size: 25.3 KB
Line 
1unit UMainForm;
2
3{$mode delphi}{$H+}
4
5interface
6
7uses
8 Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
9 ComCtrls, DateUtils, GenericList, GenericMatrix, GenericQueue, fgl,
10 GenericDictionary, SpecializedStream, SpecializedList;
11
12type
13
14 { TMainForm }
15
16 TMainForm = class(TForm)
17 ButtonStreamByte: TButton;
18 ButtonBenchmarkDictionary: TButton;
19 ButtonBenchmarkListPointer: TButton;
20 ButtonListObject: TButton;
21 ButtonBenchmarkListString: TButton;
22 ButtonCharList: TButton;
23 ButtonMatrixInteger: TButton;
24 ButtonQueueInteger: TButton;
25 ButtonDictionaryString: TButton;
26 ButtonIntegerList: TButton;
27 ButtonStringList: TButton;
28 Label1: TLabel;
29 LabelTestName: TLabel;
30 ListViewOutput: TListView;
31 procedure ButtonBenchmarkDictionaryClick(Sender: TObject);
32 procedure ButtonBenchmarkListPointerClick(Sender: TObject);
33 procedure ButtonBenchmarkListStringClick(Sender: TObject);
34 procedure ButtonCharListClick(Sender: TObject);
35 procedure ButtonDictionaryStringClick(Sender: TObject);
36 procedure ButtonIntegerListClick(Sender: TObject);
37 procedure ButtonMatrixIntegerClick(Sender: TObject);
38 procedure ButtonListObjectClick(Sender: TObject);
39 procedure ButtonQueueIntegerClick(Sender: TObject);
40 procedure ButtonStringListClick(Sender: TObject);
41 procedure ButtonStreamByteClick(Sender: TObject);
42 procedure FormCreate(Sender: TObject);
43 procedure FormDestroy(Sender: TObject);
44 public
45 MeasureDuration: TDateTime;
46 Bitmap: TBitmap;
47 procedure UpdateButtonState(Enabled: Boolean);
48 procedure WriteOutput(Text1: string = ''; Text2: string = '');
49 end;
50
51var
52 MainForm: TMainForm;
53
54implementation
55
56{$R *.lfm}
57
58{ TMainForm }
59
60procedure TMainForm.FormCreate(Sender: TObject);
61begin
62 MeasureDuration := 100 * OneMillisecond;
63end;
64
65procedure TMainForm.ButtonIntegerListClick(Sender: TObject);
66var
67 List: TGList<Integer>;
68 List2: TGList<Integer>;
69 I: Integer;
70begin
71 ListViewOutput.Clear;
72 LabelTestName.Caption := 'TListInteger test';
73 List := TGList<Integer>.Create;
74 List2 := TGList<Integer>.Create;
75 with List do try
76 AddArray([10, 20, 30, 40]);
77 WriteOutput('AddArray([10, 20, 30, 40])', Implode(',', IntToStr));
78 Clear;
79 WriteOutput('Clear', Implode(',', IntToStr));
80 for I := 0 to 10 do Add(I);
81 WriteOutput('for I := 0 to 10 do Add(I)', Implode(',', IntToStr));
82 WriteOutput('Count', IntToStr(Count));
83 Reverse;
84 WriteOutput('Reverse', Implode(',', IntToStr));
85 WriteOutput('First', IntToStr(First));
86 WriteOutput('Last', IntToStr(Last));
87 WriteOutput('IndexOf(7)', IntToStr(IndexOf(7)));
88 MoveItems(3, 2, 3);
89 WriteOutput('MoveItems(3, 2, 3)', Implode(',', IntToStr));
90 Insert(5, 11);
91 WriteOutput('Insert(5, 11)', Implode(',', IntToStr));
92 DeleteItems(0, 10);
93 WriteOutput('Delete(0, 10)', Implode(',', IntToStr));
94 List2.SetArray([1, 0]);
95 WriteOutput('EqualTo([6, 11])', BoolToStr(EqualTo(List2)));
96 List2.SetArray([2, 0]);
97 WriteOutput('EqualTo([7, 11])', BoolToStr(EqualTo(List2)));
98 InsertCount(0, 3);
99 WriteOutput('InsertCount(0, 3)', Implode(',', IntToStr));
100 Fill(0, 3, 9);
101 WriteOutput('Fill(0, 3, 9)', Implode(',', IntToStr));
102 finally
103 Free;
104 List2.Free;
105 end;
106end;
107
108procedure TMainForm.ButtonMatrixIntegerClick(Sender: TObject);
109var
110 Matrix: TGMatrix<Integer>;
111 I: Integer;
112begin
113 ListViewOutput.Clear;
114 LabelTestName.Caption := 'TMatrixInteger test';
115 Matrix := TGMatrix<Integer>.Create;
116 with Matrix do try
117 Count := CreateIndex(2, 2);
118 WriteOutput('Count := CreateIndex(2, 2)', '[' + Implode('; ', ', ', IntToStr) + ']');
119 Fill(CreateIndex(0, 0), Count, 1);
120 WriteOutput('Fill(1)', '[' + Implode('; ', ', ', IntToStr) + ']');
121 Count := CreateIndex(3, 3);
122 WriteOutput('Count := CreateIndex(3, 3)', '[' + Implode('; ', ', ', IntToStr) + ']');
123 WriteOutput('Count [Y, X]', IntToStr(Count.Y) + ', ' + IntToStr(Count.X));
124 Clear;
125 WriteOutput('Clear', '[' + Implode('; ', ', ', IntToStr) + ']');
126 WriteOutput('Count [Y, X]', IntToStr(Count.Y) + ', ' + IntToStr(Count.X));
127 finally
128 Free;
129 end;
130end;
131
132procedure TMainForm.ButtonStreamByteClick(Sender: TObject);
133var
134 Stream: TMemoryStreamByte;
135 I: Integer;
136 ByteArray: array of Byte;
137 ByteArrayText: string;
138begin
139 ListViewOutput.Clear;
140 LabelTestName.Caption := 'TStreamByte test';
141 Stream := TMemoryStreamByte.Create;
142 with Stream do try
143 WriteOutput('Size := ', IntToStr(Stream.Size));
144 Write(1);
145 WriteOutput('Write(1)', '');
146 WriteOutput('Size, Position', IntToStr(Stream.Size) + ', ' + IntToStr(Stream.Position));
147 WriteArray([2, 3, 4]);
148 WriteOutput('WriteArray([2, 3, 4])', '');
149 WriteOutput('Size, Position', IntToStr(Stream.Size) + ', ' + IntToStr(Stream.Position));
150 Position := 1;
151 WriteOutput('Position := 1', '');
152 WriteOutput('Size, Position', IntToStr(Stream.Size) + ', ' + IntToStr(Stream.Position));
153 WriteOutput('Read', IntToStr(Read));
154 WriteOutput('Size, Position', IntToStr(Stream.Size) + ', ' + IntToStr(Stream.Position));
155 ByteArray := ReadArray(2);
156 ByteArrayText := '[';
157 for I := 0 to Length(ByteArray) - 1 do begin
158 ByteArrayText := ByteArrayText + IntToStr(ByteArray[I]);
159 if I < Length(ByteArray) - 1 then ByteArrayText := ByteArrayText + ', ';
160 end;
161 ByteArrayText := ByteArrayText + ']';
162 WriteOutput('ReadArray', ByteArrayText);
163 WriteOutput('Size, Position', IntToStr(Stream.Size) + ', ' + IntToStr(Stream.Position));
164 finally
165 Free;
166 end;
167end;
168
169function ObjectToStr(Obj: TObject): string;
170begin
171 Result := Obj.ClassName;
172end;
173
174procedure TMainForm.ButtonListObjectClick(Sender: TObject);
175var
176 List: TGListObject<TObject>;
177 I: Integer;
178begin
179 ListViewOutput.Clear;
180 LabelTestName.Caption := 'TListObject test';
181 List := TGListObject<TObject>.Create;
182 with List do try
183 AddArray([TObject.Create, TObject.Create, TObject.Create, TObject.Create]);
184 WriteOutput('AddArray([TObject.Create, TObject.Create, TObject.Create, TObject.Create])', Implode(',', ObjectToStr));
185 Clear;
186 WriteOutput('Clear', Implode(',', ObjectToStr));
187 for I := 0 to 10 do Add(TObject.Create);
188 WriteOutput('for I := 0 to 10 do Add(TObject.Create)', Implode(',', ObjectToStr));
189 WriteOutput('Count', IntToStr(Count));
190 Reverse;
191 WriteOutput('Reverse', Implode(',', ObjectToStr));
192 MoveItems(3, 2, 3);
193 WriteOutput('MoveItems(3, 2, 3)', Implode(',', ObjectToStr));
194 finally
195 Free;
196 end;
197end;
198
199procedure TMainForm.ButtonQueueIntegerClick(Sender: TObject);
200var
201 Queue: TGQueue<Integer>;
202 I: Integer;
203begin
204 ListViewOutput.Clear;
205 LabelTestName.Caption := 'TQueueInteger test';
206 Queue := TGQueue<Integer>.Create;
207 with Queue do try
208 Enqueue(1);
209 Enqueue(2);
210 Enqueue(3);
211 WriteOutput('Enqueue(1),Enqueue(2),Enqueue(3) ', List.Implode(',', IntToStr));
212 Enqueue(4);
213 WriteOutput('Enqueue(4)', List.Implode(',', IntToStr));
214 WriteOutput('Dequeued item', IntToStr(Dequeue));
215 WriteOutput('Dequeue', List.Implode(',', IntToStr));
216 finally
217 Free;
218 end;
219end;
220
221function StringPairToStr(Pair: TGPair<string,string>): string;
222begin
223 Result := Pair.Key + ':' + Pair.Value;
224end;
225
226procedure TMainForm.ButtonDictionaryStringClick(Sender: TObject);
227var
228 Dictionary: TGDictionary<string, string>;
229begin
230 ListViewOutput.Clear;
231 LabelTestName.Caption := 'TDictionaryString test';
232 Dictionary := TGDictionary<string, string>.Create;
233 with Dictionary do try
234 Add('Key1', 'Value1');
235 Add('Key2', 'Value2');
236 Add('Key3', 'Value3');
237 WriteOutput('Add(''Key1'', ''Value1''),Add(''Key1'', ''Value1''),Add(''Key1'', ''Value1'')', List.Implode(',', StringPairToStr));
238 WriteOutput('Values[Key2]', Values['Key2']);
239 WriteOutput('Values[Key2] = None');
240 Values['Key2'] := 'None';
241 WriteOutput('Values[Key2]', Values['Key2']);
242 WriteOutput('Values[Key0]', Values['Key0']);
243 WriteOutput('Keys[2]', Keys[2]);
244 finally
245 Free;
246 end;
247end;
248
249function CharToStr(Value: Char): string;
250begin
251 Result := Value;
252end;
253
254procedure TMainForm.ButtonCharListClick(Sender: TObject);
255var
256 List: TListChar;
257 List2: TListChar;
258begin
259 ListViewOutput.Clear;
260 LabelTestName.Caption := 'TListChar test';
261 List := TListChar.Create;
262 List2 := TListChar.Create;
263 with List do try
264 AddArray([' ', ' ', 'A', 'b', 'c', 'd', ' ']);
265 WriteOutput('AddArray(['' '', '' '', ''A'', ''b'', ''c'', ''d'', '' ''])',
266 '''' + Implode('', CharToStr) + '''');
267 Reverse;
268 WriteOutput('Reverse', '''' + Implode('', CharToStr) + '''');
269 TrimLeft;
270 WriteOutput('TrimLeft', '''' + Implode('', CharToStr) + '''');
271 TrimRight;
272 WriteOutput('TrimRight', '''' + Implode('', CharToStr) + '''');
273 UpperCase;
274 WriteOutput('UpperCase', '''' + Implode('', CharToStr) + '''');
275 LowerCase;
276 WriteOutput('LowerCase', '''' + Implode('', CharToStr) + '''');
277 WriteOutput('IndexOf(''c'')', IntToStr(IndexOf('c')));
278 List2.AddArray(['c', 'b']);
279 WriteOutput('IndexOfList(''cb'')', IntToStr(IndexOfList(List2)));
280 finally
281 List2.Free;
282 Free;
283 end;
284end;
285
286procedure TMainForm.ButtonBenchmarkListStringClick(Sender: TObject);
287var
288 List: TGList<string>;
289 List2: TStringList;
290 StartTime: TDateTime;
291 I: Integer;
292const
293 SampleText: string = 'text';
294 SampleCount: Integer = 100000;
295begin
296 LabelTestName.Caption := 'Generic specialized TListString vs. classic non-generic TStringList benchmark';
297 ListViewOutput.Clear;
298 try
299 UpdateButtonState(False);
300 List := TGList<string>.Create;
301 List2 := TStringList.Create;
302
303 StartTime := Now;
304 repeat
305 List.Add(SampleText);
306 until (Now - StartTime) > MeasureDuration;
307 WriteOutput('TGList<String>.Add', IntToStr(List.Count) + ' ops');
308 List.Clear;
309 Application.ProcessMessages;
310
311 StartTime := Now;
312 repeat
313 List2.Add(SampleText);
314 until (Now - StartTime) > MeasureDuration;
315 WriteOutput('TStringList.Add', IntToStr(List2.Count) + ' ops');
316 List2.Clear;
317 Application.ProcessMessages;
318
319 StartTime := Now;
320 repeat
321 List.Insert(0, SampleText);
322 until (Now - StartTime) > MeasureDuration;
323 WriteOutput('TGList<String>.Insert', IntToStr(List.Count) + ' ops');
324 List.Clear;
325 Application.ProcessMessages;
326
327 StartTime := Now;
328 repeat
329 List2.Insert(0, SampleText);
330 until (Now - StartTime) > MeasureDuration;
331 WriteOutput('TStringList.Insert', IntToStr(List2.Count) + ' ops');
332 List2.Clear;
333 Application.ProcessMessages;
334
335 for I := 0 to SampleCount - 1 do
336 List.Add(SampleText);
337 StartTime := Now;
338 I := 0;
339 repeat
340 List.Delete(0);
341 Inc(I);
342 until (Now - StartTime) > MeasureDuration;
343 WriteOutput('TGList<String>.Delete', IntToStr(I) + ' ops');
344 List.Clear;
345 Application.ProcessMessages;
346
347 for I := 0 to SampleCount - 1 do
348 List2.Add(SampleText);
349 StartTime := Now;
350 I := 0;
351 repeat
352 List2.Delete(0);
353 Inc(I);
354 until (Now - StartTime) > MeasureDuration;
355 WriteOutput('TStringList.Delete', IntToStr(I) + ' ops');
356 Application.ProcessMessages;
357
358 for I := 0 to SampleCount - 1 do
359 List.Add(SampleText);
360 StartTime := Now;
361 I := 0;
362 repeat
363 List.Move(Round(SampleCount * 0.3), Round(SampleCount * 0.7));
364 Inc(I);
365 until (Now - StartTime) > MeasureDuration;
366 WriteOutput('TGList<String>.Move', IntToStr(I) + ' ops');
367 List.Clear;
368 Application.ProcessMessages;
369
370 for I := 0 to SampleCount - 1 do
371 List2.Add(SampleText);
372 StartTime := Now;
373 I := 0;
374 repeat
375 List2.Move(Round(SampleCount * 0.3), Round(SampleCount * 0.7));
376 Inc(I);
377 until (Now - StartTime) > MeasureDuration;
378 WriteOutput('TStringList.Move', IntToStr(I) + ' ops');
379 Application.ProcessMessages;
380
381 for I := 0 to SampleCount - 1 do
382 List.Add(SampleText);
383 StartTime := Now;
384 I := 0;
385 repeat
386 List.Exchange(Round(SampleCount * 0.3), Round(SampleCount * 0.7));
387 Inc(I);
388 until (Now - StartTime) > MeasureDuration;
389 WriteOutput('TGList<String>.Exchange', IntToStr(I) + ' ops');
390 List.Clear;
391 Application.ProcessMessages;
392
393 for I := 0 to SampleCount - 1 do
394 List2.Add(SampleText);
395 StartTime := Now;
396 I := 0;
397 repeat
398 List2.Exchange(Round(SampleCount * 0.3), Round(SampleCount * 0.7));
399 Inc(I);
400 until (Now - StartTime) > MeasureDuration;
401 WriteOutput('TStringList.Exchange', IntToStr(I) + ' ops');
402 Application.ProcessMessages;
403
404 for I := 0 to SampleCount - 1 do
405 List.Add(SampleText + IntToStr(I));
406 StartTime := Now;
407 I := 0;
408 repeat
409 List.IndexOf(SampleText + IntToStr(I mod List.Count));
410 Inc(I);
411 until (Now - StartTime) > MeasureDuration;
412 WriteOutput('TGList<String>.IndexOf', IntToStr(I) + ' ops');
413 List.Clear;
414 Application.ProcessMessages;
415
416 for I := 0 to SampleCount - 1 do
417 List2.Add(SampleText + IntToStr(I));
418 StartTime := Now;
419 I := 0;
420 repeat
421 List2.IndexOf(SampleText + IntToStr(I mod List2.Count));
422 Inc(I);
423 until (Now - StartTime) > MeasureDuration;
424 WriteOutput('TStringList.IndexOf', IntToStr(I) + ' ops');
425 Application.ProcessMessages;
426
427 finally
428 UpdateButtonState(True);
429 List.Free;
430 List2.Free;
431 end;
432end;
433
434procedure TMainForm.ButtonBenchmarkDictionaryClick(Sender: TObject);
435var
436 Dictionary: TGDictionary<string,string>;
437 Dictionary2: TStringList;
438 StartTime: TDateTime;
439 I: Integer;
440 R: string;
441begin
442 LabelTestName.Caption := 'Generic specialized TDictionaryStringString vs. classic non-generic TStringList benchmark';
443 ListViewOutput.Clear;
444 try
445 UpdateButtonState(False);
446 Dictionary := TGDictionary<string,string>.Create;
447 Dictionary2 := TStringList.Create;
448 Dictionary2.NameValueSeparator := '|';
449
450 I := 0;
451 StartTime := Now;
452 repeat
453 Dictionary.Add(IntToStr(I), IntToStr(I));
454 I := I + 1;
455 until (Now - StartTime) > MeasureDuration;
456 WriteOutput('TGDictionary<string,string>.Add', IntToStr(Dictionary.Count) + ' ops');
457 Application.ProcessMessages;
458
459 I := 0;
460 StartTime := Now;
461 repeat
462 Dictionary2.Add(IntToStr(I) + Dictionary2.NameValueSeparator + IntToStr(I));
463 I := I + 1;
464 until (Now - StartTime) > MeasureDuration;
465 WriteOutput('TStringList.Add', IntToStr(Dictionary2.Count) + ' ops');
466 Application.ProcessMessages;
467
468 I := 0;
469 StartTime := Now;
470 repeat
471 R := Dictionary.Values[IntToStr(I mod Dictionary.Count)];
472 I := I + 1;
473 until (Now - StartTime) > MeasureDuration;
474 WriteOutput('TGDictionary<string,string>.Values', IntToStr(I) + ' ops');
475 Application.ProcessMessages;
476
477 I := 0;
478 StartTime := Now;
479 repeat
480 R := Dictionary2.Values[IntToStr(I mod Dictionary2.Count)];
481 I := I + 1;
482 until (Now - StartTime) > MeasureDuration;
483 WriteOutput('TStringList.Values', IntToStr(I) + ' ops');
484 Application.ProcessMessages;
485
486 I := 0;
487 StartTime := Now;
488 repeat
489 R := Dictionary.Keys[I mod Dictionary.Count];
490 I := I + 1;
491 until (Now - StartTime) > MeasureDuration;
492 WriteOutput('TGDictionary<string,string>.Keys', IntToStr(I) + ' ops');
493 Application.ProcessMessages;
494
495 I := 0;
496 StartTime := Now;
497 repeat
498 R := Dictionary2.Names[I mod Dictionary2.Count];
499 I := I + 1;
500 until (Now - StartTime) > MeasureDuration;
501 WriteOutput('TStringList.Keys(Names)', IntToStr(I) + ' ops');
502 Application.ProcessMessages;
503
504 I := 0;
505 StartTime := Now;
506 repeat
507 R := Dictionary.List.Items[I mod Dictionary.Count].Value;
508 I := I + 1;
509 until (Now - StartTime) > MeasureDuration;
510 WriteOutput('TGDictionary<string,string>.Items', IntToStr(I) + ' ops');
511 Application.ProcessMessages;
512
513 I := 0;
514 StartTime := Now;
515 repeat
516 R := Dictionary2.ValueFromIndex[I mod Dictionary2.Count];
517 I := I + 1;
518 until (Now - StartTime) > MeasureDuration;
519 WriteOutput('TStringList.Items(ValueFromIndex)', IntToStr(I) + ' ops');
520 Application.ProcessMessages;
521
522 finally
523 UpdateButtonState(True);
524 Dictionary.Free;
525 Dictionary2.Free;
526 end;
527end;
528
529procedure TMainForm.ButtonBenchmarkListPointerClick(Sender: TObject);
530var
531 List: TGList<Pointer>;
532 List2: TFPList;
533 List3: TFPGList<Pointer>;
534 S: TList;
535 StartTime: TDateTime;
536 I: Integer;
537 K: Integer;
538const
539 SampleCount: Integer = 100000;
540begin
541 LabelTestName.Caption := 'Generic specialized TListObject vs. classic non-generic TFPList benchmark';
542 ListViewOutput.Clear;
543 try
544 UpdateButtonState(False);
545 List := TGList<Pointer>.Create;
546 List2 := TFPList.Create;
547 List3 := TFPGList<Pointer>.Create;
548
549 WriteOutput('TGList<Pointer>.InstanceSize', IntToStr(TGList<Pointer>.InstanceSize) + ' bytes');
550 WriteOutput('TFPList.InstanceSize', IntToStr(TFPList.InstanceSize) + ' bytes');
551 WriteOutput('TFPGList<Pointer>.InstanceSize', IntToStr(TFPGList<Pointer>.InstanceSize) + ' bytes');
552
553 StartTime := Now;
554 repeat
555 List.Add(Pointer(1));
556 until (Now - StartTime) > MeasureDuration;
557 WriteOutput('TGList<Pointer>.Add', IntToStr(List.Count) + ' ops');
558 List.Clear;
559 Application.ProcessMessages;
560
561 StartTime := Now;
562 repeat
563 List2.Add(Pointer(1));
564 until (Now - StartTime) > MeasureDuration;
565 WriteOutput('TFPList.Add', IntToStr(List2.Count) + ' ops');
566 List2.Clear;
567 Application.ProcessMessages;
568
569 StartTime := Now;
570 repeat
571 List3.Add(Pointer(1));
572 until (Now - StartTime) > MeasureDuration;
573 WriteOutput('TFPGList<Pointer>.Add', IntToStr(List3.Count) + ' ops');
574 List3.Clear;
575 Application.ProcessMessages;
576
577 StartTime := Now;
578 repeat
579 List.Insert(0, Pointer(1));
580 until (Now - StartTime) > MeasureDuration;
581 WriteOutput('TGList<Pointer>.Insert', IntToStr(List.Count) + ' ops');
582 List.Clear;
583 Application.ProcessMessages;
584
585 StartTime := Now;
586 repeat
587 List2.Insert(0, Pointer(1));
588 until (Now - StartTime) > MeasureDuration;
589 WriteOutput('TFPList.Insert', IntToStr(List2.Count) + ' ops');
590 List2.Clear;
591 Application.ProcessMessages;
592
593 StartTime := Now;
594 repeat
595 List3.Insert(0, Pointer(1));
596 until (Now - StartTime) > MeasureDuration;
597 WriteOutput('TFPGList<Pointer>.Insert', IntToStr(List3.Count) + ' ops');
598 List3.Clear;
599 Application.ProcessMessages;
600
601 for I := 0 to SampleCount - 1 do
602 List.Add(Pointer(1));
603 StartTime := Now;
604 I := 0;
605 repeat
606 List.Delete(0);
607 Inc(I);
608 until (Now - StartTime) > MeasureDuration;
609 WriteOutput('TGList<Pointer>.Delete', IntToStr(I) + ' ops');
610 List.Clear;
611 Application.ProcessMessages;
612
613 for I := 0 to SampleCount - 1 do
614 List2.Add(Pointer(1));
615 StartTime := Now;
616 I := 0;
617 repeat
618 List2.Delete(0);
619 Inc(I);
620 until (Now - StartTime) > MeasureDuration;
621 WriteOutput('TFPList.Delete', IntToStr(I) + ' ops');
622 Application.ProcessMessages;
623
624 for I := 0 to SampleCount - 1 do
625 List3.Add(Pointer(1));
626 StartTime := Now;
627 I := 0;
628 repeat
629 List3.Delete(0);
630 Inc(I);
631 until (Now - StartTime) > MeasureDuration;
632 WriteOutput('TFPGList<Pointer>.Delete', IntToStr(I) + ' ops');
633 Application.ProcessMessages;
634
635 for I := 0 to SampleCount - 1 do
636 List.Add(Pointer(1));
637 StartTime := Now;
638 I := 0;
639 repeat
640 List.Move(Round(SampleCount * 0.3), Round(SampleCount * 0.7));
641 Inc(I);
642 until (Now - StartTime) > MeasureDuration;
643 WriteOutput('TGList<Pointer>.Move', IntToStr(I) + ' ops');
644 List.Clear;
645 Application.ProcessMessages;
646
647 for I := 0 to SampleCount - 1 do
648 List2.Add(Pointer(1));
649 StartTime := Now;
650 I := 0;
651 repeat
652 List2.Move(Round(SampleCount * 0.3), Round(SampleCount * 0.7));
653 Inc(I);
654 until (Now - StartTime) > MeasureDuration;
655 WriteOutput('TFPList.Move', IntToStr(I) + ' ops');
656 Application.ProcessMessages;
657
658 for I := 0 to SampleCount - 1 do
659 List3.Add(Pointer(1));
660 StartTime := Now;
661 I := 0;
662 repeat
663 List3.Move(Round(SampleCount * 0.3), Round(SampleCount * 0.7));
664 Inc(I);
665 until (Now - StartTime) > MeasureDuration;
666 WriteOutput('TFPGList<Pointer>.Move', IntToStr(I) + ' ops');
667 Application.ProcessMessages;
668
669 for I := 0 to SampleCount - 1 do
670 List.Add(Pointer(1));
671 StartTime := Now;
672 I := 0;
673 repeat
674 List.Exchange(Round(SampleCount * 0.3), Round(SampleCount * 0.7));
675 Inc(I);
676 until (Now - StartTime) > MeasureDuration;
677 WriteOutput('TGList<Pointer>.Exchange', IntToStr(I) + ' ops');
678 Application.ProcessMessages;
679
680 for I := 0 to SampleCount - 1 do
681 List2.Add(Pointer(1));
682 StartTime := Now;
683 I := 0;
684 repeat
685 List2.Exchange(Round(SampleCount * 0.3), Round(SampleCount * 0.7));
686 Inc(I);
687 until (Now - StartTime) > MeasureDuration;
688 WriteOutput('TFPList.Exchange', IntToStr(I) + ' ops');
689 Application.ProcessMessages;
690
691 for I := 0 to SampleCount - 1 do
692 List3.Add(Pointer(1));
693 StartTime := Now;
694 I := 0;
695 repeat
696 List3.Exchange(Round(SampleCount * 0.3), Round(SampleCount * 0.7));
697 Inc(I);
698 until (Now - StartTime) > MeasureDuration;
699 WriteOutput('TFPGList<Pointer>.Exchange', IntToStr(I) + ' ops');
700 Application.ProcessMessages;
701
702 for I := 0 to SampleCount - 1 do
703 List.Add(Pointer(I));
704 StartTime := Now;
705 I := 0;
706 repeat
707 K := List.IndexOf(Pointer(I mod List.Count));
708 Inc(I);
709 until (Now - StartTime) > MeasureDuration;
710 WriteOutput('TGList<Pointer>.IndexOf', IntToStr(I) + ' ops');
711 List.Clear;
712 Application.ProcessMessages;
713
714 for I := 0 to SampleCount - 1 do
715 List2.Add(Pointer(I));
716 StartTime := Now;
717 I := 0;
718 repeat
719 K := List2.IndexOf(Pointer(I mod List2.Count));
720 Inc(I);
721 until (Now - StartTime) > MeasureDuration;
722 WriteOutput('TFPList.IndexOf', IntToStr(I) + ' ops');
723 Application.ProcessMessages;
724
725 for I := 0 to SampleCount - 1 do
726 List3.Add(Pointer(I));
727 StartTime := Now;
728 I := 0;
729 repeat
730 K := List3.IndexOf(Pointer(I mod List3.Count));
731 Inc(I);
732 until (Now - StartTime) > MeasureDuration;
733 WriteOutput('TFPGList<Pointer>.IndexOf', IntToStr(I) + ' ops');
734 Application.ProcessMessages;
735
736 for I := 0 to SampleCount - 1 do
737 List.Add(Pointer(1));
738 StartTime := Now;
739 I := 0;
740 repeat
741 List[I mod List.Count] := Pointer(1);
742 Inc(I);
743 until (Now - StartTime) > MeasureDuration;
744 WriteOutput('TGList<Pointer>[I] write', IntToStr(I) + ' ops');
745 List.Clear;
746 Application.ProcessMessages;
747
748 for I := 0 to SampleCount - 1 do
749 List2.Add(Pointer(1));
750 StartTime := Now;
751 I := 0;
752 repeat
753 List2[I mod List2.Count] := Pointer(1);
754 Inc(I);
755 until (Now - StartTime) > MeasureDuration;
756 WriteOutput('TFPList[I] write', IntToStr(I) + ' ops');
757 Application.ProcessMessages;
758
759 for I := 0 to SampleCount - 1 do
760 List3.Add(Pointer(1));
761 StartTime := Now;
762 I := 0;
763 repeat
764 List3[I mod List3.Count] := Pointer(1);
765 Inc(I);
766 until (Now - StartTime) > MeasureDuration;
767 WriteOutput('TFPGList<Pointer>[I] write', IntToStr(I) + ' ops');
768 Application.ProcessMessages;
769
770 for I := 0 to SampleCount - 1 do
771 List.Add(Pointer(1));
772 StartTime := Now;
773 I := 0;
774 repeat
775 List[I mod List.Count];
776 Inc(I);
777 until (Now - StartTime) > MeasureDuration;
778 WriteOutput('TGList<Pointer>[I] read', IntToStr(I) + ' ops');
779 List.Clear;
780 Application.ProcessMessages;
781
782 for I := 0 to SampleCount - 1 do
783 List2.Add(Pointer(1));
784 StartTime := Now;
785 I := 0;
786 repeat
787 List2[I mod List2.Count];
788 Inc(I);
789 until (Now - StartTime) > MeasureDuration;
790 WriteOutput('TFPList[I] read', IntToStr(I) + ' ops');
791 Application.ProcessMessages;
792
793 for I := 0 to SampleCount - 1 do
794 List3.Add(Pointer(1));
795 StartTime := Now;
796 I := 0;
797 repeat
798 List3[I mod List3.Count];
799 Inc(I);
800 until (Now - StartTime) > MeasureDuration;
801 WriteOutput('TFPGList<Pointer>[I] read', IntToStr(I) + ' ops');
802 Application.ProcessMessages;
803
804 finally
805 UpdateButtonState(True);
806 List.Free;
807 List2.Free;
808 List3.Free;
809 end;
810end;
811
812function StrToStr(Value: string): string;
813begin
814 Result := Value;
815end;
816
817procedure TMainForm.ButtonStringListClick(Sender: TObject);
818var
819 List: TGList<string>;
820begin
821 ListViewOutput.Clear;
822 WriteOutput('TListString test');
823 List := TGList<string>.Create;
824 with List do try
825 AddArray(['One', 'Two', 'Three', 'Four', 'Five', 'Six', 'Seven']);
826 WriteOutput('Count', IntToStr(Count));
827 WriteOutput('Implode', Implode(',', StrToStr));
828 WriteOutput('Reverse');
829 Reverse;
830 WriteOutput('Implode', Implode(',', StrToStr));
831 WriteOutput('First', First);
832 WriteOutput('Last', Last);
833 MoveItems(2, 3, 3);
834 WriteOutput('Implode', Implode(',', StrToStr));
835 InsertCount(0, 3);
836 WriteOutput('InsertCount(0, 3)', Implode(',', StrToStr));
837 Fill(0, 3, 'Zero');
838 WriteOutput('Fill(0, 3, ''Zero'')', Implode(',', StrToStr));
839 finally
840 Free;
841 end;
842end;
843
844procedure TMainForm.FormDestroy(Sender: TObject);
845begin
846end;
847
848procedure TMainForm.UpdateButtonState(Enabled: Boolean);
849begin
850 ButtonBenchmarkDictionary.Enabled := Enabled;
851 ButtonBenchmarkListString.Enabled := Enabled;
852 ButtonCharList.Enabled := Enabled;
853 ButtonDictionaryString.Enabled := Enabled;
854 ButtonIntegerList.Enabled := Enabled;
855 ButtonListObject.Enabled := Enabled;
856 ButtonMatrixInteger.Enabled := Enabled;
857 ButtonQueueInteger.Enabled := Enabled;
858 ButtonStringList.Enabled := Enabled;
859end;
860
861procedure TMainForm.WriteOutput(Text1: string = ''; Text2: string = '');
862var
863 NewItem: TListItem;
864begin
865 NewItem := ListViewOutput.Items.Add;
866 NewItem.Caption := Text1;
867 NewItem.SubItems.Add(Text2);
868end;
869
870end.
871
Note: See TracBrowser for help on using the repository browser.