diff options
author | Daniel Baumann <daniel.baumann@progress-linux.org> | 2024-04-07 18:45:59 +0000 |
---|---|---|
committer | Daniel Baumann <daniel.baumann@progress-linux.org> | 2024-04-07 18:45:59 +0000 |
commit | 19fcec84d8d7d21e796c7624e521b60d28ee21ed (patch) | |
tree | 42d26aa27d1e3f7c0b8bd3fd14e7d7082f5008dc /src/jaegertracing/thrift/lib/delphi/test/Performance/PerfTests.pas | |
parent | Initial commit. (diff) | |
download | ceph-19fcec84d8d7d21e796c7624e521b60d28ee21ed.tar.xz ceph-19fcec84d8d7d21e796c7624e521b60d28ee21ed.zip |
Adding upstream version 16.2.11+ds.upstream/16.2.11+dsupstream
Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>
Diffstat (limited to 'src/jaegertracing/thrift/lib/delphi/test/Performance/PerfTests.pas')
-rw-r--r-- | src/jaegertracing/thrift/lib/delphi/test/Performance/PerfTests.pas | 173 |
1 files changed, 173 insertions, 0 deletions
diff --git a/src/jaegertracing/thrift/lib/delphi/test/Performance/PerfTests.pas b/src/jaegertracing/thrift/lib/delphi/test/Performance/PerfTests.pas new file mode 100644 index 000000000..2c820b1f3 --- /dev/null +++ b/src/jaegertracing/thrift/lib/delphi/test/Performance/PerfTests.pas @@ -0,0 +1,173 @@ +// Licensed to the Apache Software Foundation(ASF) under one +// or more contributor license agreements.See the NOTICE file +// distributed with this work for additional information +// regarding copyright ownership.The ASF licenses this file +// to you under the Apache License, Version 2.0 (the +// "License"); you may not use this file except in compliance +// with the License. You may obtain a copy of the License at +// +// http://www.apache.org/licenses/LICENSE-2.0 +// +// Unless required by applicable law or agreed to in writing, +// software distributed under the License is distributed on an +// "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY +// KIND, either express or implied. See the License for the +// specific language governing permissions and limitations +// under the License. +unit PerfTests; + +interface + +uses + Windows, Classes, SysUtils, + Thrift.Collections, + Thrift.Test, + Thrift.Protocol, + Thrift.Protocol.JSON, + Thrift.Protocol.Compact, + Thrift.Transport, + Thrift.Stream, + ConsoleHelper, + TestConstants, + DataFactory; + +type + TPerformanceTests = class + strict private + Testdata : ICrazyNesting; + MemBuffer : TMemoryStream; + Transport : ITransport; + + procedure ProtocolPeformanceTest; + procedure RunTest( const ptyp : TKnownProtocol; const layered : TLayeredTransport); + function GenericProtocolFactory(const ptyp : TKnownProtocol; const layered : TLayeredTransport; const forWrite : Boolean) : IProtocol; + function GetProtocolTransportName(const ptyp : TKnownProtocol; const layered : TLayeredTransport) : string; + public + class function Execute : Integer; + end; + + +implementation + + +// not available in all versions, so make sure we have this one imported +function IsDebuggerPresent: BOOL; stdcall; external KERNEL32 name 'IsDebuggerPresent'; + + +class function TPerformanceTests.Execute : Integer; +var instance : TPerformanceTests; +begin + instance := TPerformanceTests.Create; + instance.ProtocolPeformanceTest; + + // debug only + if IsDebuggerPresent then begin + Console.Write('Hit ENTER ...'); + ReadLn; + end; + + result := 0; +end; + + +procedure TPerformanceTests.ProtocolPeformanceTest; +var layered : TLayeredTransport; +begin + Console.WriteLine('Setting up for ProtocolPeformanceTest ...'); + Testdata := TestDataFactory.CreateCrazyNesting(); + + for layered := Low(TLayeredTransport) to High(TLayeredTransport) do begin + RunTest( TKnownProtocol.prot_Binary, layered); + RunTest( TKnownProtocol.prot_Compact, layered); + RunTest( TKnownProtocol.prot_JSON, layered); + end; +end; + + +procedure TPerformanceTests.RunTest( const ptyp : TKnownProtocol; const layered : TLayeredTransport); +var freq, start, stop : Int64; + proto : IProtocol; + restored : ICrazyNesting; +begin + QueryPerformanceFrequency( freq); + + proto := GenericProtocolFactory( ptyp, layered, TRUE); + QueryPerformanceCounter( start); + Testdata.Write(proto); + Transport.Flush; + QueryPerformanceCounter( stop); + Console.WriteLine( Format('RunTest(%s): write = %d msec', [ + GetProtocolTransportName(ptyp,layered), + Round(1000.0*(stop-start)/freq) + ])); + + restored := TCrazyNestingImpl.Create; + proto := GenericProtocolFactory( ptyp, layered, FALSE); + QueryPerformanceCounter( start); + restored.Read(proto); + QueryPerformanceCounter( stop); + Console.WriteLine( Format('RunTest(%s): read = %d msec', [ + GetProtocolTransportName(ptyp,layered), + Round(1000.0*(stop-start)/freq) + ])); +end; + + +function TPerformanceTests.GenericProtocolFactory(const ptyp : TKnownProtocol; const layered : TLayeredTransport; const forWrite : Boolean) : IProtocol; +var newBuf : TMemoryStream; + stream : IThriftStream; + trans : IStreamTransport; +const COPY_ENTIRE_STREAM = 0; +begin + // read happens after write here, so let's take over the written bytes + newBuf := TMemoryStream.Create; + if not forWrite then newBuf.CopyFrom( MemBuffer, COPY_ENTIRE_STREAM); + MemBuffer := newBuf; + MemBuffer.Position := 0; + + // layered transports anyone? + stream := TThriftStreamAdapterDelphi.Create( newBuf, TRUE); + if forWrite + then trans := TStreamTransportImpl.Create( nil, stream) + else trans := TStreamTransportImpl.Create( stream, nil); + case layered of + trns_Framed : Transport := TFramedTransportImpl.Create( trans); + trns_Buffered : Transport := TBufferedTransportImpl.Create( trans); + else + Transport := trans; + end; + + if not Transport.IsOpen + then Transport.Open; + + case ptyp of + prot_Binary : result := TBinaryProtocolImpl.Create(trans); + prot_Compact : result := TCompactProtocolImpl.Create(trans); + prot_JSON : result := TJSONProtocolImpl.Create(trans); + else + ASSERT(FALSE); + end; +end; + + +function TPerformanceTests.GetProtocolTransportName(const ptyp : TKnownProtocol; const layered : TLayeredTransport) : string; +begin + case layered of + trns_Framed : result := ' + framed'; + trns_Buffered : result := ' + buffered'; + else + result := ''; + end; + + case ptyp of + prot_Binary : result := 'binary' + result; + prot_Compact : result := 'compact' + result; + prot_JSON : result := 'JSON' + result; + else + ASSERT(FALSE); + end; +end; + + +end. + |