1 // Licensed to the Apache Software Foundation(ASF) under one
2 // or more contributor license agreements.See the NOTICE file
3 // distributed with this work for additional information
4 // regarding copyright ownership.The ASF licenses this file
5 // to you under the Apache License, Version 2.0 (the
6 // "License"); you may not use this file except in compliance
7 // with the License. You may obtain a copy of the License at
8 //
9 // http://www.apache.org/licenses/LICENSE-2.0
10 //
11 // Unless required by applicable law or agreed to in writing,
12 // software distributed under the License is distributed on an
13 // "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
14 // KIND, either express or implied. See the License for the
15 // specific language governing permissions and limitations
16 // under the License.
17 unit PerfTests;
18
19 interface
20
21 uses
22 Windows, Classes, SysUtils,
23 Thrift.Collections,
24 Thrift.Configuration,
25 Thrift.Test,
26 Thrift.Protocol,
27 Thrift.Protocol.JSON,
28 Thrift.Protocol.Compact,
29 Thrift.Transport,
30 Thrift.Stream,
31 ConsoleHelper,
32 TestConstants,
33 DataFactory;
34
35 type
36 TPerformanceTests = class
37 strict private
38 FTestdata : ICrazyNesting;
39 FMemBuffer : TMemoryStream;
40 FTransport : ITransport;
41 FConfig : IThriftConfiguration;
42
43 procedure ProtocolPeformanceTest;
44 procedure RunTest( const ptyp : TKnownProtocol; const layered : TLayeredTransport);
GenericProtocolFactorynull45 function GenericProtocolFactory(const ptyp : TKnownProtocol; const layered : TLayeredTransport; const forWrite : Boolean) : IProtocol;
GetProtocolTransportNamenull46 function GetProtocolTransportName(const ptyp : TKnownProtocol; const layered : TLayeredTransport) : string;
47 public
Executenull48 class function Execute : Integer;
49 end;
50
51
52 implementation
53
54
55 // not available in all versions, so make sure we have this one imported
IsDebuggerPresentnull56 function IsDebuggerPresent: BOOL; stdcall; external KERNEL32 name 'IsDebuggerPresent';
57
58
TPerformanceTests.Executenull59 class function TPerformanceTests.Execute : Integer;
60 var instance : TPerformanceTests;
61 begin
62 instance := TPerformanceTests.Create;
63 instance.ProtocolPeformanceTest;
64
65 // debug only
66 if IsDebuggerPresent then begin
67 Console.Write('Hit ENTER ...');
68 ReadLn;
69 end;
70
71 result := 0;
72 end;
73
74
75 procedure TPerformanceTests.ProtocolPeformanceTest;
76 var layered : TLayeredTransport;
77 begin
78 Console.WriteLine('Setting up for ProtocolPeformanceTest ...');
79 FTestdata := TestDataFactory.CreateCrazyNesting();
80
81 for layered := Low(TLayeredTransport) to High(TLayeredTransport) do begin
82 RunTest( TKnownProtocol.prot_Binary, layered);
83 RunTest( TKnownProtocol.prot_Compact, layered);
84 RunTest( TKnownProtocol.prot_JSON, layered);
85 end;
86 end;
87
88
89 procedure TPerformanceTests.RunTest( const ptyp : TKnownProtocol; const layered : TLayeredTransport);
90 var freq, start, stop : Int64;
91 proto : IProtocol;
92 restored : ICrazyNesting;
93 begin
94 QueryPerformanceFrequency( freq);
95
96 FConfig := TThriftConfigurationImpl.Create;
97
98 proto := GenericProtocolFactory( ptyp, layered, TRUE);
99 QueryPerformanceCounter( start);
100 FTestdata.Write(proto);
101 FTransport.Flush;
102 QueryPerformanceCounter( stop);
103 Console.WriteLine( Format('RunTest(%s): write = %d msec', [
104 GetProtocolTransportName(ptyp,layered),
105 Round(1000.0*(stop-start)/freq)
106 ]));
107
108 restored := TCrazyNestingImpl.Create;
109 proto := GenericProtocolFactory( ptyp, layered, FALSE);
110 QueryPerformanceCounter( start);
111 restored.Read(proto);
112 QueryPerformanceCounter( stop);
113 Console.WriteLine( Format('RunTest(%s): read = %d msec', [
114 GetProtocolTransportName(ptyp,layered),
115 Round(1000.0*(stop-start)/freq)
116 ]));
117 end;
118
119
TPerformanceTests.GenericProtocolFactorynull120 function TPerformanceTests.GenericProtocolFactory(const ptyp : TKnownProtocol; const layered : TLayeredTransport; const forWrite : Boolean) : IProtocol;
121 var newBuf : TMemoryStream;
122 stream : IThriftStream;
123 trans : IStreamTransport;
124 const COPY_ENTIRE_STREAM = 0;
125 begin
126 // read happens after write here, so let's take over the written bytes
127 newBuf := TMemoryStream.Create;
128 if not forWrite then newBuf.CopyFrom( FMemBuffer, COPY_ENTIRE_STREAM);
129 FMemBuffer := newBuf;
130 FMemBuffer.Position := 0;
131
132 // layered transports anyone?
133 stream := TThriftStreamAdapterDelphi.Create( newBuf, TRUE);
134 if forWrite
135 then trans := TStreamTransportImpl.Create( nil, stream, FConfig)
136 else trans := TStreamTransportImpl.Create( stream, nil, FConfig);
137 case layered of
138 trns_Framed : FTransport := TFramedTransportImpl.Create( trans);
139 trns_Buffered : FTransport := TBufferedTransportImpl.Create( trans);
140 else
141 FTransport := trans;
142 end;
143
144 if not FTransport.IsOpen
145 then FTransport.Open;
146
147 case ptyp of
148 prot_Binary : result := TBinaryProtocolImpl.Create(trans);
149 prot_Compact : result := TCompactProtocolImpl.Create(trans);
150 prot_JSON : result := TJSONProtocolImpl.Create(trans);
151 else
152 ASSERT(FALSE);
153 end;
154 end;
155
156
GetProtocolTransportNamenull157 function TPerformanceTests.GetProtocolTransportName(const ptyp : TKnownProtocol; const layered : TLayeredTransport) : string;
158 begin
159 case layered of
160 trns_Framed : result := ' + framed';
161 trns_Buffered : result := ' + buffered';
162 else
163 result := '';
164 end;
165
166 case ptyp of
167 prot_Binary : result := 'binary' + result;
168 prot_Compact : result := 'compact' + result;
169 prot_JSON : result := 'JSON' + result;
170 else
171 ASSERT(FALSE);
172 end;
173 end;
174
175
176 end.
177
178