]>
Commit | Line | Data |
---|---|---|
f67539c2 TL |
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.Test, | |
25 | Thrift.Protocol, | |
26 | Thrift.Protocol.JSON, | |
27 | Thrift.Protocol.Compact, | |
28 | Thrift.Transport, | |
29 | Thrift.Stream, | |
30 | ConsoleHelper, | |
31 | TestConstants, | |
32 | DataFactory; | |
33 | ||
34 | type | |
35 | TPerformanceTests = class | |
36 | strict private | |
37 | Testdata : ICrazyNesting; | |
38 | MemBuffer : TMemoryStream; | |
39 | Transport : ITransport; | |
40 | ||
41 | procedure ProtocolPeformanceTest; | |
42 | procedure RunTest( const ptyp : TKnownProtocol; const layered : TLayeredTransport); | |
43 | function GenericProtocolFactory(const ptyp : TKnownProtocol; const layered : TLayeredTransport; const forWrite : Boolean) : IProtocol; | |
44 | function GetProtocolTransportName(const ptyp : TKnownProtocol; const layered : TLayeredTransport) : string; | |
45 | public | |
46 | class function Execute : Integer; | |
47 | end; | |
48 | ||
49 | ||
50 | implementation | |
51 | ||
52 | ||
53 | // not available in all versions, so make sure we have this one imported | |
54 | function IsDebuggerPresent: BOOL; stdcall; external KERNEL32 name 'IsDebuggerPresent'; | |
55 | ||
56 | ||
57 | class function TPerformanceTests.Execute : Integer; | |
58 | var instance : TPerformanceTests; | |
59 | begin | |
60 | instance := TPerformanceTests.Create; | |
61 | instance.ProtocolPeformanceTest; | |
62 | ||
63 | // debug only | |
64 | if IsDebuggerPresent then begin | |
65 | Console.Write('Hit ENTER ...'); | |
66 | ReadLn; | |
67 | end; | |
68 | ||
69 | result := 0; | |
70 | end; | |
71 | ||
72 | ||
73 | procedure TPerformanceTests.ProtocolPeformanceTest; | |
74 | var layered : TLayeredTransport; | |
75 | begin | |
76 | Console.WriteLine('Setting up for ProtocolPeformanceTest ...'); | |
77 | Testdata := TestDataFactory.CreateCrazyNesting(); | |
78 | ||
79 | for layered := Low(TLayeredTransport) to High(TLayeredTransport) do begin | |
80 | RunTest( TKnownProtocol.prot_Binary, layered); | |
81 | RunTest( TKnownProtocol.prot_Compact, layered); | |
82 | RunTest( TKnownProtocol.prot_JSON, layered); | |
83 | end; | |
84 | end; | |
85 | ||
86 | ||
87 | procedure TPerformanceTests.RunTest( const ptyp : TKnownProtocol; const layered : TLayeredTransport); | |
88 | var freq, start, stop : Int64; | |
89 | proto : IProtocol; | |
90 | restored : ICrazyNesting; | |
91 | begin | |
92 | QueryPerformanceFrequency( freq); | |
93 | ||
94 | proto := GenericProtocolFactory( ptyp, layered, TRUE); | |
95 | QueryPerformanceCounter( start); | |
96 | Testdata.Write(proto); | |
97 | Transport.Flush; | |
98 | QueryPerformanceCounter( stop); | |
99 | Console.WriteLine( Format('RunTest(%s): write = %d msec', [ | |
100 | GetProtocolTransportName(ptyp,layered), | |
101 | Round(1000.0*(stop-start)/freq) | |
102 | ])); | |
103 | ||
104 | restored := TCrazyNestingImpl.Create; | |
105 | proto := GenericProtocolFactory( ptyp, layered, FALSE); | |
106 | QueryPerformanceCounter( start); | |
107 | restored.Read(proto); | |
108 | QueryPerformanceCounter( stop); | |
109 | Console.WriteLine( Format('RunTest(%s): read = %d msec', [ | |
110 | GetProtocolTransportName(ptyp,layered), | |
111 | Round(1000.0*(stop-start)/freq) | |
112 | ])); | |
113 | end; | |
114 | ||
115 | ||
116 | function TPerformanceTests.GenericProtocolFactory(const ptyp : TKnownProtocol; const layered : TLayeredTransport; const forWrite : Boolean) : IProtocol; | |
117 | var newBuf : TMemoryStream; | |
118 | stream : IThriftStream; | |
119 | trans : IStreamTransport; | |
120 | const COPY_ENTIRE_STREAM = 0; | |
121 | begin | |
122 | // read happens after write here, so let's take over the written bytes | |
123 | newBuf := TMemoryStream.Create; | |
124 | if not forWrite then newBuf.CopyFrom( MemBuffer, COPY_ENTIRE_STREAM); | |
125 | MemBuffer := newBuf; | |
126 | MemBuffer.Position := 0; | |
127 | ||
128 | // layered transports anyone? | |
129 | stream := TThriftStreamAdapterDelphi.Create( newBuf, TRUE); | |
130 | if forWrite | |
131 | then trans := TStreamTransportImpl.Create( nil, stream) | |
132 | else trans := TStreamTransportImpl.Create( stream, nil); | |
133 | case layered of | |
134 | trns_Framed : Transport := TFramedTransportImpl.Create( trans); | |
135 | trns_Buffered : Transport := TBufferedTransportImpl.Create( trans); | |
136 | else | |
137 | Transport := trans; | |
138 | end; | |
139 | ||
140 | if not Transport.IsOpen | |
141 | then Transport.Open; | |
142 | ||
143 | case ptyp of | |
144 | prot_Binary : result := TBinaryProtocolImpl.Create(trans); | |
145 | prot_Compact : result := TCompactProtocolImpl.Create(trans); | |
146 | prot_JSON : result := TJSONProtocolImpl.Create(trans); | |
147 | else | |
148 | ASSERT(FALSE); | |
149 | end; | |
150 | end; | |
151 | ||
152 | ||
153 | function TPerformanceTests.GetProtocolTransportName(const ptyp : TKnownProtocol; const layered : TLayeredTransport) : string; | |
154 | begin | |
155 | case layered of | |
156 | trns_Framed : result := ' + framed'; | |
157 | trns_Buffered : result := ' + buffered'; | |
158 | else | |
159 | result := ''; | |
160 | end; | |
161 | ||
162 | case ptyp of | |
163 | prot_Binary : result := 'binary' + result; | |
164 | prot_Compact : result := 'compact' + result; | |
165 | prot_JSON : result := 'JSON' + result; | |
166 | else | |
167 | ASSERT(FALSE); | |
168 | end; | |
169 | end; | |
170 | ||
171 | ||
172 | end. | |
173 |