2 files changed, 349 insertions, 0 deletions
diff --git a/src/jaegertracing/thrift/lib/delphi/test/Performance/DataFactory.pas b/src/jaegertracing/thrift/lib/delphi/test/Performance/DataFactory.pas
new file mode 100644
index 000000000..e131822a3
--- /dev/null
+++ b/src/jaegertracing/thrift/lib/delphi/test/Performance/DataFactory.pas
@@ -0,0 +1,176 @@
+// 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 DataFactory;
+
+interface
+
+uses
+  SysUtils,
+  Thrift.Collections,
+  Thrift.Test;
+
+type
+  TestDataFactory = class
+  strict protected
+    class function CreateSetField(const count : Integer) : IHashSet< IInsanity>;  static;
+    class function CreateInsanity(const count : Integer) : IInsanity; static;
+    class function CreateBytesArray(const count : Integer) : TBytes; static;
+    class function CreateXtructs(const count : Integer) : IThriftList< IXtruct>; static;
+    class function CreateXtruct(const count : Integer) : IXtruct; static;
+    class function CreateListField(const count : Integer) : IThriftList< IThriftDictionary< IHashSet< Integer>, IThriftDictionary< Integer, IHashSet< IThriftList< IThriftDictionary< IInsanity, string>>>>>>; static;
+    class function CreateUserMap(const count : Integer) : IThriftDictionary< TNumberz, Int64>; static;
+    class function CreateListFieldData(const count : Integer) : IThriftDictionary< IHashSet< Integer>, IThriftDictionary< Integer, IHashSet< IThriftList< IThriftDictionary< IInsanity, string>>>>>; static;
+    class function CreateIntHashSet(const count : Integer) : IHashSet< Integer>; static;
+    class function CreateListFieldDataDict(const count : Integer) : IThriftDictionary< Integer, IHashSet< IThriftList< IThriftDictionary< IInsanity, string>>>>; static;
+    class function CreateListFieldDataDictValue(const count : Integer) :  IHashSet< IThriftList< IThriftDictionary< IInsanity, string>>>; static;
+    class function CreateListFieldDataDictValueList(const count : Integer) : IThriftList< IThriftDictionary< IInsanity, string>>; static;
+    class function CreateListFieldDataDictValueListDict(const count : Integer) : IThriftDictionary< IInsanity, string>; static;
+  public
+    class function CreateCrazyNesting(const count : Integer = 10) : ICrazyNesting; static;
+  end;
+
+implementation
+
+
+class function TestDataFactory.CreateCrazyNesting(const count : Integer = 10) : ICrazyNesting;
+begin
+  if (count <= 0)
+  then Exit(nil);
+
+  result := TCrazyNestingImpl.Create;
+  result.Binary_field := CreateBytesArray(count);
+  result.List_field := CreateListField(count);
+  result.Set_field := CreateSetField(count);
+  result.String_field := Format('data level %d', [count]);
+end;
+
+class function TestDataFactory.CreateSetField(const count : Integer) : IHashSet< IInsanity>;
+var i : Integer;
+begin
+  result := THashSetImpl< IInsanity>.Create;
+  for i := 0 to count-1 do begin
+    result.Add(CreateInsanity(count));
+  end;
+end;
+
+class function TestDataFactory.CreateInsanity(const count : Integer) : IInsanity;
+begin
+  result := TInsanityImpl.Create;
+  result.UserMap := CreateUserMap(count);
+  result.Xtructs := CreateXtructs(count);
+end;
+
+class function TestDataFactory.CreateXtructs(const count : Integer) : IThriftList< IXtruct>;
+var i : Integer;
+begin
+  result := TThriftListImpl< IXtruct>.Create;
+  for i := 0 to count-1 do begin
+    result.Add(CreateXtruct(count));
+  end;
+end;
+
+class function TestDataFactory.CreateXtruct(const count : Integer) : IXtruct;
+begin
+  result := TXtructImpl.Create;
+  result.Byte_thing := SmallInt(count mod 128);
+  result.I32_thing := count;
+  result.I64_thing := count;
+  result.String_thing := Format('data level %d', [count]);
+end;
+
+class function TestDataFactory.CreateUserMap(const count : Integer) : IThriftDictionary< TNumberz, Int64>;
+begin
+  result := TThriftDictionaryImpl< TNumberz, Int64>.Create;
+  result.Add(TNumberz.ONE, count);
+  result.Add(TNumberz.TWO, count);
+  result.Add(TNumberz.THREE, count);
+  result.Add(TNumberz.FIVE, count);
+  result.Add(TNumberz.SIX, count);
+  result.Add(TNumberz.EIGHT, count);
+end;
+
+class function TestDataFactory.CreateListField(const count : Integer) : IThriftList< IThriftDictionary< IHashSet< Integer>, IThriftDictionary< Integer, IHashSet< IThriftList< IThriftDictionary< IInsanity, string>>>>>>;
+var i : Integer;
+begin
+  result := TThriftListImpl< IThriftDictionary< IHashSet< Integer>, IThriftDictionary< Integer, IHashSet< IThriftList< IThriftDictionary< IInsanity, string>>>>>>.Create;
+  for i := 0 to count-1 do begin
+    result.Add(CreateListFieldData(count));
+  end;
+end;
+
+class function TestDataFactory.CreateListFieldData(const count : Integer) : IThriftDictionary< IHashSet< Integer>, IThriftDictionary< Integer, IHashSet< IThriftList< IThriftDictionary< IInsanity, string>>>>>;
+var i : Integer;
+begin
+  result := TThriftDictionaryImpl< IHashSet< Integer>, IThriftDictionary< Integer, IHashSet< IThriftList< IThriftDictionary< IInsanity, string>>>>>.Create;
+  for i := 0 to count-1 do begin
+    result.Add( CreateIntHashSet(count), CreateListFieldDataDict(count));
+  end;
+end;
+
+class function TestDataFactory.CreateIntHashSet(const count : Integer) : IHashSet< Integer>;
+var i : Integer;
+begin
+  result := THashSetImpl< Integer>.Create;
+  for i := 0 to count-1 do begin
+    result.Add(i);
+  end;
+end;
+
+class function TestDataFactory.CreateListFieldDataDict(const count : Integer) : IThriftDictionary< Integer, IHashSet< IThriftList< IThriftDictionary< IInsanity, string>>>>;
+var i : Integer;
+begin
+  result := TThriftDictionaryImpl< Integer, IHashSet< IThriftList< IThriftDictionary< IInsanity, string>>>>.Create;
+  for i := 0 to count-1 do begin
+    result.Add(i, CreateListFieldDataDictValue(count));
+  end;
+end;
+
+class function TestDataFactory.CreateListFieldDataDictValue(const count : Integer) :  IHashSet< IThriftList< IThriftDictionary< IInsanity, string>>>;
+var i : Integer;
+begin
+  result := THashSetImpl< IThriftList< IThriftDictionary< IInsanity, string>>>.Create;
+  for i := 0 to count-1 do begin
+    result.Add( CreateListFieldDataDictValueList(count));
+  end;
+end;
+
+class function TestDataFactory.CreateListFieldDataDictValueList(const count : Integer) : IThriftList< IThriftDictionary< IInsanity, string>>;
+var i : Integer;
+begin
+  result := TThriftListImpl< IThriftDictionary< IInsanity, string>>.Create;
+  for i := 0 to count-1 do begin
+    result.Add(CreateListFieldDataDictValueListDict(count));
+  end;
+end;
+
+class function TestDataFactory.CreateListFieldDataDictValueListDict(const count : Integer) : IThriftDictionary< IInsanity, string>;
+begin
+  result := TThriftDictionaryImpl< IInsanity, string>.Create;
+  result.Add(CreateInsanity(count), Format('data level %d', [count]));
+end;
+
+class function TestDataFactory.CreateBytesArray(const count : Integer) : TBytes;
+var i : Integer;
+begin
+  SetLength( result, count);
+  for i := 0 to count-1 do begin
+    result[i] := i mod $FF;
+  end;
+end;
+
+end.
+
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.
+