Skip to content

Commit ecd1d6d

Browse files
sglienkesglienke
committed
added benchmark tool
1 parent 9c3164a commit ecd1d6d

File tree

3 files changed

+360
-0
lines changed

3 files changed

+360
-0
lines changed

‎Tests/MeasureEventInvoke.dpr‎

Lines changed: 148 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,148 @@
1+
program MeasureEventInvoke;
2+
3+
{$APPTYPE CONSOLE}
4+
5+
uses
6+
Classes,
7+
Diagnostics,
8+
SysUtils,
9+
Spring;
10+
11+
type
12+
TTestEvent1 = procedure (Sender: TObject) of object;
13+
TTestEvent2 = procedure (Sender: TObject; a: Double; b, c, d, e: Integer) of object;
14+
TEventHandler = class
15+
procedure HandleEvent1(Sender: TObject);
16+
procedure HandleEvent2(Sender: TObject; a: Double; b, c, d, e: Integer);
17+
end;
18+
19+
var
20+
HandlerCount: Integer = 8;
21+
{$IFDEF POSIX}
22+
ThreadCount: Integer = 4;
23+
EventCallCount: Int64 = 10000000;
24+
{$ELSE}
25+
ThreadCount: Integer = 16;
26+
EventCallCount: Int64 = 10000000;
27+
{$ENDIF}
28+
29+
function MakeThreadProc(const workload: TProc<Integer>; index: Integer): TProc;
30+
begin
31+
Result := procedure begin workload(index) end;
32+
end;
33+
34+
function Measure(const workload: TProc<Integer>): Int64;
35+
var
36+
threads: array of TThread;
37+
i: Integer;
38+
sw: TStopwatch;
39+
begin
40+
SetLength(threads, ThreadCount);
41+
for i := 0 to ThreadCount-1 do
42+
threads[i] := TThread.CreateAnonymousThread(MakeThreadProc(workload, i));
43+
sw := TStopwatch.StartNew;
44+
for i := 0 to ThreadCount-1 do
45+
begin
46+
threads[i].FreeOnTerminate := False;
47+
threads[i].Start;
48+
end;
49+
50+
for i := 0 to ThreadCount-1 do
51+
begin
52+
while not threads[i].Started do Sleep(0);
53+
threads[i].Free;
54+
end;
55+
Result := sw.ElapsedMilliseconds;
56+
end;
57+
58+
threadvar
59+
CallCount: Int64;
60+
61+
procedure TEventHandler.HandleEvent1(Sender: TObject);
62+
begin
63+
Inc(CallCount);
64+
end;
65+
66+
procedure TEventHandler.HandleEvent2(Sender: TObject; a: Double; b, c, d, e: Integer);
67+
begin
68+
Inc(CallCount);
69+
end;
70+
71+
procedure Main;
72+
var
73+
e1: Event<TTestEvent1>;
74+
e2: Event<TTestEvent2>;
75+
i: Integer;
76+
t: TEventHandler;
77+
TotalCallCount: Int64;
78+
TotalDuration: Int64;
79+
params: TStrings;
80+
begin
81+
if FindCmdLineSwitch('?') then
82+
begin
83+
Writeln('Event invokation benchmark');
84+
Writeln;
85+
Writeln(' -t=n Number of threads - default: ', ThreadCount);
86+
Writeln(' -h=n Number of handlers - default: ', HandlerCount);
87+
Writeln(' -c=n Invokes per thread - default: ', EventCallCount);
88+
Exit;
89+
end;
90+
91+
params := TStringList.Create;
92+
try
93+
for i := 1 to ParamCount do
94+
params.Add(ParamStr(i));
95+
ThreadCount := StrToIntDef(params.Values['-t'], ThreadCount);
96+
HandlerCount := StrToIntDef(params.Values['-h'], HandlerCount);
97+
EventCallCount := StrToIntDef(params.Values['-c'], EventCallCount);
98+
finally
99+
params.Free;
100+
end;
101+
102+
Writeln('Number of threads: ', ThreadCount);
103+
Writeln('Handlers per event: ', HandlerCount);
104+
Writeln('Calls per thread: ', EventCallCount);
105+
Writeln;
106+
107+
t := TEventHandler.Create;
108+
for i := 1 to HandlerCount do
109+
begin
110+
e1.Add(t.HandleEvent1);
111+
e2.Add(t.HandleEvent2);
112+
end;
113+
114+
TotalCallCount := 0;
115+
Writeln('Benchmark running...');
116+
TotalDuration := Measure(
117+
procedure(index: Integer)
118+
var
119+
i: Integer;
120+
begin
121+
for i := 1 to EventCallCount do
122+
begin
123+
// if i mod (EventCallCount div 20) = 0 then
124+
// e1.Add(t.HandleEvent1);
125+
// if i mod ((EventCallCount div 20)+5) = 0 then
126+
// e1.Remove(t.HandleEvent1);
127+
e1.Invoke(t);
128+
// e2.Invoke(t, 111, 222, 333, 444, 555);
129+
end;
130+
131+
AtomicIncrement(TotalCallCount, CallCount);
132+
end);
133+
134+
Writeln('Event invokes/ms: ', EventCallCount * ThreadCount div TotalDuration);
135+
Writeln('Handler calls/ms: ', TotalCallCount div TotalDuration);
136+
Writeln('Handler calls/ms/thread: ', TotalCallCount div TotalDuration div ThreadCount);
137+
Writeln('Total duration in ms: ', TotalDuration);
138+
Writeln('Total handler calls: ', TotalCallCount);
139+
e1.Clear;
140+
e2.Clear;
141+
t.Free;
142+
end;
143+
144+
begin
145+
Main;
146+
Writeln;
147+
ReportMemoryLeaksOnShutdown := True;
148+
end.

‎Tests/MeasureEventInvoke.dproj‎

Lines changed: 212 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,212 @@
1+
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
2+
<PropertyGroup>
3+
<ProjectGuid>{BAF0F1F1-4A5E-4771-BE8E-8E20DB5B2595}</ProjectGuid>
4+
<ProjectVersion>19.1</ProjectVersion>
5+
<FrameworkType>None</FrameworkType>
6+
<Base>True</Base>
7+
<Config Condition="'$(Config)'==''">Debug</Config>
8+
<Platform Condition="'$(Platform)'==''">Win32</Platform>
9+
<TargetedPlatforms>3</TargetedPlatforms>
10+
<AppType>Console</AppType>
11+
<MainSource>MeasureEventInvoke.dpr</MainSource>
12+
</PropertyGroup>
13+
<PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''">
14+
<Base>true</Base>
15+
</PropertyGroup>
16+
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Base)'=='true') or '$(Base_Win32)'!=''">
17+
<Base_Win32>true</Base_Win32>
18+
<CfgParent>Base</CfgParent>
19+
<Base>true</Base>
20+
</PropertyGroup>
21+
<PropertyGroup Condition="('$(Platform)'=='Win64' and '$(Base)'=='true') or '$(Base_Win64)'!=''">
22+
<Base_Win64>true</Base_Win64>
23+
<CfgParent>Base</CfgParent>
24+
<Base>true</Base>
25+
</PropertyGroup>
26+
<PropertyGroup Condition="'$(Config)'=='Debug' or '$(Cfg_1)'!=''">
27+
<Cfg_1>true</Cfg_1>
28+
<CfgParent>Base</CfgParent>
29+
<Base>true</Base>
30+
</PropertyGroup>
31+
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_1)'=='true') or '$(Cfg_1_Win32)'!=''">
32+
<Cfg_1_Win32>true</Cfg_1_Win32>
33+
<CfgParent>Cfg_1</CfgParent>
34+
<Cfg_1>true</Cfg_1>
35+
<Base>true</Base>
36+
</PropertyGroup>
37+
<PropertyGroup Condition="'$(Config)'=='Release' or '$(Cfg_2)'!=''">
38+
<Cfg_2>true</Cfg_2>
39+
<CfgParent>Base</CfgParent>
40+
<Base>true</Base>
41+
</PropertyGroup>
42+
<PropertyGroup Condition="'$(Base)'!=''">
43+
<DCC_DcuOutput>.\$(Platform)\$(Config)</DCC_DcuOutput>
44+
<DCC_ExeOutput>.\$(Platform)\$(Config)</DCC_ExeOutput>
45+
<DCC_E>false</DCC_E>
46+
<DCC_N>false</DCC_N>
47+
<DCC_S>false</DCC_S>
48+
<DCC_F>false</DCC_F>
49+
<DCC_K>false</DCC_K>
50+
<DCC_Namespace>System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace)</DCC_Namespace>
51+
<SanitizedProjectName>MeasureEventInvoke</SanitizedProjectName>
52+
<DCC_UnitSearchPath>..\Source;..\Source\Base;$(DCC_UnitSearchPath)</DCC_UnitSearchPath>
53+
<VerInfo_Locale>1031</VerInfo_Locale>
54+
<VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
55+
</PropertyGroup>
56+
<PropertyGroup Condition="'$(Base_Win32)'!=''">
57+
<DCC_UsePackage>DBXSqliteDriver;RESTComponents;fmxase;DBXDb2Driver;DBXInterBaseDriver;vclactnband;vclFireDAC;bindcompvclsmp;emsclientfiredac;tethering;svnui;DataSnapFireDAC;FireDACADSDriver;DBXMSSQLDriver;DatasnapConnectorsFreePascal;FireDACMSSQLDriver;vcltouch;vcldb;bindcompfmx;svn;DBXOracleDriver;inetdb;VirtualTreesDR;emsedge;fmx;FireDACIBDriver;fmxdae;vcledge;FireDACDBXDriver;dbexpress;IndyCore;vclx;dsnap;emsclient;DataSnapCommon;FireDACCommon;RESTBackendComponents;DataSnapConnectors;VCLRESTComponents;soapserver;vclie;bindengine;DBXMySQLDriver;CloudService;FireDACOracleDriver;FireDACMySQLDriver;DBXFirebirdDriver;FireDACCommonODBC;FireDACCommonDriver;DataSnapClient;inet;IndyIPCommon;bindcompdbx;vcl;IndyIPServer;DBXSybaseASEDriver;IndySystem;FireDACDb2Driver;dsnapcon;FireDACMSAccDriver;fmxFireDAC;FireDACInfxDriver;vclimg;FireDAC;emshosting;FireDACSqliteDriver;FireDACPgDriver;FireDACASADriver;DBXOdbcDriver;FireDACTDataDriver;soaprtl;DbxCommonDriver;DataSnapServer;xmlrtl;soapmidas;DataSnapNativeClient;fmxobj;vclwinx;FireDACDSDriver;rtl;emsserverresource;DbxClientDriver;DBXSybaseASADriver;CustomIPTransport;vcldsnap;bindcomp;appanalytics;DBXInformixDriver;IndyIPClient;bindcompvcl;dbxcds;VclSmp;adortl;FireDACODBCDriver;DataSnapIndy10ServerTransport;dsnapxml;DataSnapProviderClient;dbrtl;IndyProtocols;inetdbxpress;FireDACMongoDBDriver;DataSnapServerMidas;$(DCC_UsePackage)</DCC_UsePackage>
58+
<DCC_Namespace>Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)</DCC_Namespace>
59+
<BT_BuildType>Debug</BT_BuildType>
60+
<VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
61+
<VerInfo_Locale>1033</VerInfo_Locale>
62+
<DCC_ConsoleTarget>true</DCC_ConsoleTarget>
63+
<UWP_DelphiLogo44>$(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png</UWP_DelphiLogo44>
64+
<UWP_DelphiLogo150>$(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png</UWP_DelphiLogo150>
65+
</PropertyGroup>
66+
<PropertyGroup Condition="'$(Base_Win64)'!=''">
67+
<DCC_UsePackage>DBXSqliteDriver;RESTComponents;fmxase;DBXDb2Driver;DBXInterBaseDriver;vclactnband;vclFireDAC;bindcompvclsmp;emsclientfiredac;tethering;DataSnapFireDAC;FireDACADSDriver;DBXMSSQLDriver;DatasnapConnectorsFreePascal;FireDACMSSQLDriver;vcltouch;vcldb;bindcompfmx;DBXOracleDriver;inetdb;VirtualTreesDR;emsedge;fmx;FireDACIBDriver;fmxdae;vcledge;FireDACDBXDriver;dbexpress;IndyCore;vclx;dsnap;emsclient;DataSnapCommon;FireDACCommon;RESTBackendComponents;DataSnapConnectors;VCLRESTComponents;soapserver;vclie;bindengine;DBXMySQLDriver;CloudService;FireDACOracleDriver;FireDACMySQLDriver;DBXFirebirdDriver;FireDACCommonODBC;FireDACCommonDriver;DataSnapClient;inet;IndyIPCommon;bindcompdbx;vcl;IndyIPServer;DBXSybaseASEDriver;IndySystem;FireDACDb2Driver;dsnapcon;FireDACMSAccDriver;fmxFireDAC;FireDACInfxDriver;vclimg;FireDAC;emshosting;FireDACSqliteDriver;FireDACPgDriver;FireDACASADriver;DBXOdbcDriver;FireDACTDataDriver;soaprtl;DbxCommonDriver;DataSnapServer;xmlrtl;soapmidas;DataSnapNativeClient;fmxobj;vclwinx;FireDACDSDriver;rtl;emsserverresource;DbxClientDriver;DBXSybaseASADriver;CustomIPTransport;vcldsnap;bindcomp;appanalytics;DBXInformixDriver;IndyIPClient;bindcompvcl;dbxcds;VclSmp;adortl;FireDACODBCDriver;DataSnapIndy10ServerTransport;dsnapxml;DataSnapProviderClient;dbrtl;IndyProtocols;inetdbxpress;FireDACMongoDBDriver;DataSnapServerMidas;$(DCC_UsePackage)</DCC_UsePackage>
68+
<DCC_ConsoleTarget>true</DCC_ConsoleTarget>
69+
<UWP_DelphiLogo44>$(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png</UWP_DelphiLogo44>
70+
<UWP_DelphiLogo150>$(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png</UWP_DelphiLogo150>
71+
<DCC_Namespace>Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace)</DCC_Namespace>
72+
<BT_BuildType>Debug</BT_BuildType>
73+
<VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
74+
<VerInfo_Locale>1033</VerInfo_Locale>
75+
</PropertyGroup>
76+
<PropertyGroup Condition="'$(Cfg_1)'!=''">
77+
<DCC_Define>DEBUG;$(DCC_Define)</DCC_Define>
78+
<DCC_DebugDCUs>true</DCC_DebugDCUs>
79+
<DCC_Optimize>false</DCC_Optimize>
80+
<DCC_GenerateStackFrames>true</DCC_GenerateStackFrames>
81+
<DCC_DebugInfoInExe>true</DCC_DebugInfoInExe>
82+
<DCC_RemoteDebug>true</DCC_RemoteDebug>
83+
</PropertyGroup>
84+
<PropertyGroup Condition="'$(Cfg_1_Win32)'!=''">
85+
<DCC_RemoteDebug>false</DCC_RemoteDebug>
86+
<DCC_Optimize>true</DCC_Optimize>
87+
<DCC_GenerateStackFrames>false</DCC_GenerateStackFrames>
88+
<VerInfo_Locale>1033</VerInfo_Locale>
89+
<Manifest_File>(None)</Manifest_File>
90+
<DCC_DebugInfoInExe>false</DCC_DebugInfoInExe>
91+
</PropertyGroup>
92+
<PropertyGroup Condition="'$(Cfg_2)'!=''">
93+
<DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
94+
<DCC_Define>RELEASE;$(DCC_Define)</DCC_Define>
95+
<DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
96+
<DCC_DebugInformation>0</DCC_DebugInformation>
97+
</PropertyGroup>
98+
<ItemGroup>
99+
<DelphiCompile Include="$(MainSource)">
100+
<MainSource>MainSource</MainSource>
101+
</DelphiCompile>
102+
<BuildConfiguration Include="Release">
103+
<Key>Cfg_2</Key>
104+
<CfgParent>Base</CfgParent>
105+
</BuildConfiguration>
106+
<BuildConfiguration Include="Base">
107+
<Key>Base</Key>
108+
</BuildConfiguration>
109+
<BuildConfiguration Include="Debug">
110+
<Key>Cfg_1</Key>
111+
<CfgParent>Base</CfgParent>
112+
</BuildConfiguration>
113+
</ItemGroup>
114+
<ProjectExtensions>
115+
<Borland.Personality>Delphi.Personality.12</Borland.Personality>
116+
<Borland.ProjectType>Application</Borland.ProjectType>
117+
<BorlandProject>
118+
<Delphi.Personality>
119+
<Source>
120+
<Source Name="MainSource">MeasureEventInvoke.dpr</Source>
121+
</Source>
122+
<Excluded_Packages>
123+
<Excluded_Packages Name="$(BDSBIN)\dcloffice2k270.bpl">Microsoft Office 2000 Sample Automation Server Wrapper Components</Excluded_Packages>
124+
<Excluded_Packages Name="$(BDSBIN)\dclofficexp270.bpl">Microsoft Office XP Sample Automation Server Wrapper Components</Excluded_Packages>
125+
</Excluded_Packages>
126+
</Delphi.Personality>
127+
<Platforms>
128+
<Platform value="Win32">True</Platform>
129+
<Platform value="Win64">True</Platform>
130+
</Platforms>
131+
<Deployment Version="3">
132+
<DeployFile LocalName="Win32\Debug\MeasureEventInvoke.exe" Configuration="Debug" Class="ProjectOutput">
133+
<Platform Name="Win32">
134+
<RemoteName>MeasureEventInvoke.exe</RemoteName>
135+
<Overwrite>true</Overwrite>
136+
</Platform>
137+
</DeployFile>
138+
<DeployClass Name="AdditionalDebugSymbols">
139+
<Platform Name="Win32">
140+
<Operation>0</Operation>
141+
</Platform>
142+
</DeployClass>
143+
<DeployClass Name="DebugSymbols">
144+
<Platform Name="Win32">
145+
<Operation>0</Operation>
146+
</Platform>
147+
</DeployClass>
148+
<DeployClass Name="DependencyFramework">
149+
<Platform Name="Win32">
150+
<Operation>0</Operation>
151+
</Platform>
152+
</DeployClass>
153+
<DeployClass Name="DependencyModule">
154+
<Platform Name="Win32">
155+
<Operation>0</Operation>
156+
<Extensions>.dll;.bpl</Extensions>
157+
</Platform>
158+
</DeployClass>
159+
<DeployClass Required="true" Name="DependencyPackage">
160+
<Platform Name="Win32">
161+
<Operation>0</Operation>
162+
<Extensions>.bpl</Extensions>
163+
</Platform>
164+
</DeployClass>
165+
<DeployClass Name="File">
166+
<Platform Name="Win32">
167+
<Operation>0</Operation>
168+
</Platform>
169+
</DeployClass>
170+
<DeployClass Required="true" Name="ProjectOutput">
171+
<Platform Name="Win32">
172+
<Operation>0</Operation>
173+
</Platform>
174+
</DeployClass>
175+
<DeployClass Name="ProjectUWPManifest">
176+
<Platform Name="Win32">
177+
<Operation>1</Operation>
178+
</Platform>
179+
<Platform Name="Win64">
180+
<Operation>1</Operation>
181+
</Platform>
182+
</DeployClass>
183+
<DeployClass Name="UWP_DelphiLogo150">
184+
<Platform Name="Win32">
185+
<RemoteDir>Assets</RemoteDir>
186+
<Operation>1</Operation>
187+
</Platform>
188+
<Platform Name="Win64">
189+
<RemoteDir>Assets</RemoteDir>
190+
<Operation>1</Operation>
191+
</Platform>
192+
</DeployClass>
193+
<DeployClass Name="UWP_DelphiLogo44">
194+
<Platform Name="Win32">
195+
<RemoteDir>Assets</RemoteDir>
196+
<Operation>1</Operation>
197+
</Platform>
198+
<Platform Name="Win64">
199+
<RemoteDir>Assets</RemoteDir>
200+
<Operation>1</Operation>
201+
</Platform>
202+
</DeployClass>
203+
<ProjectRoot Platform="Win64" Name="$(PROJECTNAME)"/>
204+
<ProjectRoot Platform="Win32" Name="$(PROJECTNAME)"/>
205+
</Deployment>
206+
</BorlandProject>
207+
<ProjectFileVersion>12</ProjectFileVersion>
208+
</ProjectExtensions>
209+
<Import Project="$(BDS)\Bin\CodeGear.Delphi.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Delphi.Targets')"/>
210+
<Import Project="$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj" Condition="Exists('$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj')"/>
211+
<Import Project="$(MSBuildProjectName).deployproj" Condition="Exists('$(MSBuildProjectName).deployproj')"/>
212+
</Project>

‎Tests/MeasureEventInvoke.res‎

96 Bytes
Binary file not shown.

0 commit comments

Comments
 (0)