Moving from govendor to dep, updated dependencies (#48)

* Moving from govendor to dep.

* Making the pull request template more friendly.

* Fixing akward space in PR template.

* goimports run on whole project using ` goimports -w $(find . -type f -name '*.go' -not -path "./vendor/*" -not -path "./gen-go/*")`

source of command: https://gist.github.com/bgentry/fd1ffef7dbde01857f66

vendor/git.apache.org/thrift.git/lib/delphi/README.md

@@ -0,0 +1,30 @@
+Thrift Delphi Software Library
+
+License
+=======
+
+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.
+
+Using Thrift with Delphi
+====================
+
+The Thrift Delphi Library requires at least Delphi 2010.
+
+Because the Library heavily relies on generics, using it
+with earlier versions (such as Delphi 7) will *not* work.
+

vendor/git.apache.org/thrift.git/lib/delphi/coding_standards.md

@@ -0,0 +1 @@
+Please follow [General Coding Standards](/doc/coding_standards.md)

vendor/git.apache.org/thrift.git/lib/delphi/src/Thrift.Collections.pas

@@ -0,0 +1,619 @@
+(*
+ * 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 Thrift.Collections;
+
+interface
+
+uses
+  Generics.Collections, Generics.Defaults, Thrift.Utils;
+
+type
+
+{$IF CompilerVersion < 21.0}
+  TArray<T> = array of T;
+{$IFEND}
+
+  IThriftContainer = interface
+    ['{93DEF5A0-D162-461A-AB22-5B4EE0734050}']
+    function ToString: string;
+  end;
+
+  IThriftDictionary<TKey,TValue> = interface(IThriftContainer)
+    ['{25EDD506-F9D1-4008-A40F-5940364B7E46}']
+    function GetEnumerator: TEnumerator<TPair<TKey,TValue>>;
+
+    function GetKeys: TDictionary<TKey,TValue>.TKeyCollection;
+    function GetValues: TDictionary<TKey,TValue>.TValueCollection;
+    function GetItem(const Key: TKey): TValue;
+    procedure SetItem(const Key: TKey; const Value: TValue);
+    function GetCount: Integer;
+
+    procedure Add(const Key: TKey; const Value: TValue);
+    procedure Remove(const Key: TKey);
+{$IF CompilerVersion >= 21.0}
+    function ExtractPair(const Key: TKey): TPair<TKey,TValue>;
+{$IFEND}
+    procedure Clear;
+    procedure TrimExcess;
+    function TryGetValue(const Key: TKey; out Value: TValue): Boolean;
+    procedure AddOrSetValue(const Key: TKey; const Value: TValue);
+    function ContainsKey(const Key: TKey): Boolean;
+    function ContainsValue(const Value: TValue): Boolean;
+    function ToArray: TArray<TPair<TKey,TValue>>;
+
+    property Items[const Key: TKey]: TValue read GetItem write SetItem; default;
+    property Count: Integer read GetCount;
+    property Keys: TDictionary<TKey,TValue>.TKeyCollection read GetKeys;
+    property Values: TDictionary<TKey,TValue>.TValueCollection read GetValues;
+  end;
+
+  TThriftDictionaryImpl<TKey,TValue> = class( TInterfacedObject, IThriftDictionary<TKey,TValue>)
+  private
+    FDictionaly : TDictionary<TKey,TValue>;
+  protected
+    function GetEnumerator: TEnumerator<TPair<TKey,TValue>>;
+
+    function GetKeys: TDictionary<TKey,TValue>.TKeyCollection;
+    function GetValues: TDictionary<TKey,TValue>.TValueCollection;
+    function GetItem(const Key: TKey): TValue;
+    procedure SetItem(const Key: TKey; const Value: TValue);
+    function GetCount: Integer;
+
+    procedure Add(const Key: TKey; const Value: TValue);
+    procedure Remove(const Key: TKey);
+{$IF CompilerVersion >= 21.0}
+    function ExtractPair(const Key: TKey): TPair<TKey,TValue>;
+{$IFEND}
+    procedure Clear;
+    procedure TrimExcess;
+    function TryGetValue(const Key: TKey; out Value: TValue): Boolean;
+    procedure AddOrSetValue(const Key: TKey; const Value: TValue);
+    function ContainsKey(const Key: TKey): Boolean;
+    function ContainsValue(const Value: TValue): Boolean;
+    function ToArray: TArray<TPair<TKey,TValue>>;
+    property Items[const Key: TKey]: TValue read GetItem write SetItem; default;
+    property Count: Integer read GetCount;
+    property Keys: TDictionary<TKey,TValue>.TKeyCollection read GetKeys;
+    property Values: TDictionary<TKey,TValue>.TValueCollection read GetValues;
+  public
+    constructor Create(ACapacity: Integer = 0);
+    destructor Destroy; override;
+  end;
+
+  IThriftList<T> = interface(IThriftContainer)
+    ['{29BEEE31-9CB4-401B-AA04-5148A75F473B}']
+    function GetEnumerator: TEnumerator<T>;
+    function GetCapacity: Integer;
+    procedure SetCapacity(Value: Integer);
+    function GetCount: Integer;
+    procedure SetCount(Value: Integer);
+    function GetItem(Index: Integer): T;
+    procedure SetItem(Index: Integer; const Value: T);
+    function Add(const Value: T): Integer;
+    procedure AddRange(const Values: array of T); overload;
+    procedure AddRange(const Collection: IEnumerable<T>); overload;
+    procedure AddRange(Collection: TEnumerable<T>); overload;
+    procedure Insert(Index: Integer; const Value: T);
+    procedure InsertRange(Index: Integer; const Values: array of T); overload;
+    procedure InsertRange(Index: Integer; const Collection: IEnumerable<T>); overload;
+    procedure InsertRange(Index: Integer; const Collection: TEnumerable<T>); overload;
+    function Remove(const Value: T): Integer;
+    procedure Delete(Index: Integer);
+    procedure DeleteRange(AIndex, ACount: Integer);
+    function Extract(const Value: T): T;
+{$IF CompilerVersion >= 21.0}
+    procedure Exchange(Index1, Index2: Integer);
+    procedure Move(CurIndex, NewIndex: Integer);
+    function First: T;
+    function Last: T;
+{$IFEND}
+    procedure Clear;
+    function Contains(const Value: T): Boolean;
+    function IndexOf(const Value: T): Integer;
+    function LastIndexOf(const Value: T): Integer;
+    procedure Reverse;
+    procedure Sort; overload;
+    procedure Sort(const AComparer: IComparer<T>); overload;
+    function BinarySearch(const Item: T; out Index: Integer): Boolean; overload;
+    function BinarySearch(const Item: T; out Index: Integer; const AComparer: IComparer<T>): Boolean; overload;
+    procedure TrimExcess;
+    function ToArray: TArray<T>;
+    property Capacity: Integer read GetCapacity write SetCapacity;
+    property Count: Integer read GetCount write SetCount;
+    property Items[Index: Integer]: T read GetItem write SetItem; default;
+  end;
+
+  TThriftListImpl<T> = class( TInterfacedObject, IThriftList<T>)
+  private
+    FList : TList<T>;
+  protected
+    function GetEnumerator: TEnumerator<T>;
+    function GetCapacity: Integer;
+    procedure SetCapacity(Value: Integer);
+    function GetCount: Integer;
+    procedure SetCount(Value: Integer);
+    function GetItem(Index: Integer): T;
+    procedure SetItem(Index: Integer; const Value: T);
+    function Add(const Value: T): Integer;
+    procedure AddRange(const Values: array of T); overload;
+    procedure AddRange(const Collection: IEnumerable<T>); overload;
+    procedure AddRange(Collection: TEnumerable<T>); overload;
+    procedure Insert(Index: Integer; const Value: T);
+    procedure InsertRange(Index: Integer; const Values: array of T); overload;
+    procedure InsertRange(Index: Integer; const Collection: IEnumerable<T>); overload;
+    procedure InsertRange(Index: Integer; const Collection: TEnumerable<T>); overload;
+    function Remove(const Value: T): Integer;
+    procedure Delete(Index: Integer);
+    procedure DeleteRange(AIndex, ACount: Integer);
+    function Extract(const Value: T): T;
+{$IF CompilerVersion >= 21.0}
+    procedure Exchange(Index1, Index2: Integer);
+    procedure Move(CurIndex, NewIndex: Integer);
+    function First: T;
+    function Last: T;
+{$IFEND}
+    procedure Clear;
+    function Contains(const Value: T): Boolean;
+    function IndexOf(const Value: T): Integer;
+    function LastIndexOf(const Value: T): Integer;
+    procedure Reverse;
+    procedure Sort; overload;
+    procedure Sort(const AComparer: IComparer<T>); overload;
+    function BinarySearch(const Item: T; out Index: Integer): Boolean; overload;
+    function BinarySearch(const Item: T; out Index: Integer; const AComparer: IComparer<T>): Boolean; overload;
+    procedure TrimExcess;
+    function ToArray: TArray<T>;
+    property Capacity: Integer read GetCapacity write SetCapacity;
+    property Count: Integer read GetCount write SetCount;
+    property Items[Index: Integer]: T read GetItem write SetItem; default;
+  public
+    constructor Create;
+    destructor Destroy; override;
+  end;
+
+  IHashSet<TValue> = interface(IThriftContainer)
+    ['{0923A3B5-D4D4-48A8-91AD-40238E2EAD66}']
+    function GetEnumerator: TEnumerator<TValue>;
+    function GetIsReadOnly: Boolean;
+    function GetCount: Integer;
+    property Count: Integer read GetCount;
+    property IsReadOnly: Boolean read GetIsReadOnly;
+    procedure Add( const item: TValue);
+    procedure Clear;
+    function Contains( const item: TValue): Boolean;
+    procedure CopyTo(var A: TArray<TValue>; arrayIndex: Integer);
+    function Remove( const item: TValue ): Boolean;
+  end;
+
+  THashSetImpl<TValue> = class( TInterfacedObject, IHashSet<TValue>)
+  private
+    FDictionary : IThriftDictionary<TValue,Integer>;
+    FIsReadOnly: Boolean;
+  protected
+    function GetEnumerator: TEnumerator<TValue>;
+    function GetIsReadOnly: Boolean;
+    function GetCount: Integer;
+    property Count: Integer read GetCount;
+    property IsReadOnly: Boolean read FIsReadOnly;
+    procedure Add( const item: TValue);
+    procedure Clear;
+    function Contains( const item: TValue): Boolean;
+    procedure CopyTo(var A: TArray<TValue>; arrayIndex: Integer);
+    function Remove( const item: TValue ): Boolean;
+  public
+    constructor Create;
+  end;
+
+implementation
+
+{ THashSetImpl<TValue> }
+
+procedure THashSetImpl<TValue>.Add( const item: TValue);
+begin
+  if not FDictionary.ContainsKey(item) then
+  begin
+    FDictionary.Add( item, 0);
+  end;
+end;
+
+procedure THashSetImpl<TValue>.Clear;
+begin
+  FDictionary.Clear;
+end;
+
+function THashSetImpl<TValue>.Contains( const item: TValue): Boolean;
+begin
+  Result := FDictionary.ContainsKey(item);
+end;
+
+procedure THashSetImpl<TValue>.CopyTo(var A: TArray<TValue>; arrayIndex: Integer);
+var
+  i : Integer;
+  Enumlator : TEnumerator<TValue>;
+begin
+  Enumlator := GetEnumerator;
+  while Enumlator.MoveNext do
+  begin
+    A[arrayIndex] := Enumlator.Current;
+    Inc(arrayIndex);
+  end;
+end;
+
+constructor THashSetImpl<TValue>.Create;
+begin
+  inherited;
+  FDictionary := TThriftDictionaryImpl<TValue,Integer>.Create;
+end;
+
+function THashSetImpl<TValue>.GetCount: Integer;
+begin
+  Result := FDictionary.Count;
+end;
+
+function THashSetImpl<TValue>.GetEnumerator: TEnumerator<TValue>;
+begin
+  Result := FDictionary.Keys.GetEnumerator;
+end;
+
+function THashSetImpl<TValue>.GetIsReadOnly: Boolean;
+begin
+  Result := FIsReadOnly;
+end;
+
+function THashSetImpl<TValue>.Remove( const item: TValue): Boolean;
+begin
+  Result := False;
+  if FDictionary.ContainsKey( item ) then
+  begin
+    FDictionary.Remove( item );
+    Result := not FDictionary.ContainsKey( item );
+  end;
+end;
+
+{ TThriftDictionaryImpl<TKey, TValue> }
+
+procedure TThriftDictionaryImpl<TKey, TValue>.Add(const Key: TKey;
+  const Value: TValue);
+begin
+  FDictionaly.Add( Key, Value);
+end;
+
+procedure TThriftDictionaryImpl<TKey, TValue>.AddOrSetValue(const Key: TKey;
+  const Value: TValue);
+begin
+  FDictionaly.AddOrSetValue( Key, Value);
+end;
+
+procedure TThriftDictionaryImpl<TKey, TValue>.Clear;
+begin
+  FDictionaly.Clear;
+end;
+
+function TThriftDictionaryImpl<TKey, TValue>.ContainsKey(
+  const Key: TKey): Boolean;
+begin
+  Result := FDictionaly.ContainsKey( Key );
+end;
+
+function TThriftDictionaryImpl<TKey, TValue>.ContainsValue(
+  const Value: TValue): Boolean;
+begin
+  Result := FDictionaly.ContainsValue( Value );
+end;
+
+constructor TThriftDictionaryImpl<TKey, TValue>.Create(ACapacity: Integer);
+begin
+  inherited Create;
+  FDictionaly := TDictionary<TKey,TValue>.Create( ACapacity );
+end;
+
+destructor TThriftDictionaryImpl<TKey, TValue>.Destroy;
+begin
+  FDictionaly.Free;
+  inherited;
+end;
+
+{$IF CompilerVersion >= 21.0}
+function TThriftDictionaryImpl<TKey, TValue>.ExtractPair( const Key: TKey): TPair<TKey, TValue>;
+begin
+  Result := FDictionaly.ExtractPair( Key);
+end;
+{$IFEND}
+
+function TThriftDictionaryImpl<TKey, TValue>.GetCount: Integer;
+begin
+  Result := FDictionaly.Count;
+end;
+
+function TThriftDictionaryImpl<TKey, TValue>.GetEnumerator: TEnumerator<TPair<TKey, TValue>>;
+begin
+  Result := FDictionaly.GetEnumerator;
+end;
+
+function TThriftDictionaryImpl<TKey, TValue>.GetItem(const Key: TKey): TValue;
+begin
+  Result := FDictionaly.Items[Key];
+end;
+
+function TThriftDictionaryImpl<TKey, TValue>.GetKeys: TDictionary<TKey, TValue>.TKeyCollection;
+begin
+  Result := FDictionaly.Keys;
+end;
+
+function TThriftDictionaryImpl<TKey, TValue>.GetValues: TDictionary<TKey, TValue>.TValueCollection;
+begin
+  Result := FDictionaly.Values;
+end;
+
+procedure TThriftDictionaryImpl<TKey, TValue>.Remove(const Key: TKey);
+begin
+  FDictionaly.Remove( Key );
+end;
+
+procedure TThriftDictionaryImpl<TKey, TValue>.SetItem(const Key: TKey;
+  const Value: TValue);
+begin
+  FDictionaly.AddOrSetValue( Key, Value);
+end;
+
+function TThriftDictionaryImpl<TKey, TValue>.ToArray: TArray<TPair<TKey, TValue>>;
+{$IF CompilerVersion < 22.0}
+var
+  x : TPair<TKey, TValue>;
+  i : Integer;
+{$IFEND}
+begin
+{$IF CompilerVersion < 22.0}
+  SetLength(Result, Count);
+  i := 0;
+  for x in FDictionaly do
+  begin
+    Result[i] := x;
+    Inc( i );
+  end;
+{$ELSE}
+  Result := FDictionaly.ToArray;
+{$IFEND}
+end;
+
+procedure TThriftDictionaryImpl<TKey, TValue>.TrimExcess;
+begin
+  FDictionaly.TrimExcess;
+end;
+
+function TThriftDictionaryImpl<TKey, TValue>.TryGetValue(const Key: TKey;
+  out Value: TValue): Boolean;
+begin
+  Result := FDictionaly.TryGetValue( Key, Value);
+end;
+
+{ TThriftListImpl<T> }
+
+function TThriftListImpl<T>.Add(const Value: T): Integer;
+begin
+  Result := FList.Add( Value );
+end;
+
+procedure TThriftListImpl<T>.AddRange(Collection: TEnumerable<T>);
+begin
+  FList.AddRange( Collection );
+end;
+
+procedure TThriftListImpl<T>.AddRange(const Collection: IEnumerable<T>);
+begin
+  FList.AddRange( Collection );
+end;
+
+procedure TThriftListImpl<T>.AddRange(const Values: array of T);
+begin
+  FList.AddRange( Values );
+end;
+
+function TThriftListImpl<T>.BinarySearch(const Item: T;
+  out Index: Integer): Boolean;
+begin
+  Result := FList.BinarySearch( Item, Index);
+end;
+
+function TThriftListImpl<T>.BinarySearch(const Item: T; out Index: Integer;
+  const AComparer: IComparer<T>): Boolean;
+begin
+  Result := FList.BinarySearch( Item, Index, AComparer);
+end;
+
+procedure TThriftListImpl<T>.Clear;
+begin
+  FList.Clear;
+end;
+
+function TThriftListImpl<T>.Contains(const Value: T): Boolean;
+begin
+  Result := FList.Contains( Value );
+end;
+
+constructor TThriftListImpl<T>.Create;
+begin
+  inherited;
+  FList := TList<T>.Create;
+end;
+
+procedure TThriftListImpl<T>.Delete(Index: Integer);
+begin
+  FList.Delete( Index )
+end;
+
+procedure TThriftListImpl<T>.DeleteRange(AIndex, ACount: Integer);
+begin
+  FList.DeleteRange( AIndex, ACount)
+end;
+
+destructor TThriftListImpl<T>.Destroy;
+begin
+  FList.Free;
+  inherited;
+end;
+
+{$IF CompilerVersion >= 21.0}
+procedure TThriftListImpl<T>.Exchange(Index1, Index2: Integer);
+begin
+  FList.Exchange( Index1, Index2 )
+end;
+{$IFEND}
+
+function TThriftListImpl<T>.Extract(const Value: T): T;
+begin
+  Result := FList.Extract( Value )
+end;
+
+{$IF CompilerVersion >= 21.0}
+function TThriftListImpl<T>.First: T;
+begin
+  Result := FList.First;
+end;
+{$IFEND}
+
+function TThriftListImpl<T>.GetCapacity: Integer;
+begin
+  Result := FList.Capacity;
+end;
+
+function TThriftListImpl<T>.GetCount: Integer;
+begin
+  Result := FList.Count;
+end;
+
+function TThriftListImpl<T>.GetEnumerator: TEnumerator<T>;
+begin
+  Result := FList.GetEnumerator;
+end;
+
+function TThriftListImpl<T>.GetItem(Index: Integer): T;
+begin
+  Result := FList[Index];
+end;
+
+function TThriftListImpl<T>.IndexOf(const Value: T): Integer;
+begin
+  Result := FList.IndexOf( Value );
+end;
+
+procedure TThriftListImpl<T>.Insert(Index: Integer; const Value: T);
+begin
+  FList.Insert( Index, Value);
+end;
+
+procedure TThriftListImpl<T>.InsertRange(Index: Integer;
+  const Collection: TEnumerable<T>);
+begin
+  FList.InsertRange( Index, Collection );
+end;
+
+procedure TThriftListImpl<T>.InsertRange(Index: Integer;
+  const Values: array of T);
+begin
+  FList.InsertRange( Index, Values);
+end;
+
+procedure TThriftListImpl<T>.InsertRange(Index: Integer;
+  const Collection: IEnumerable<T>);
+begin
+  FList.InsertRange( Index, Collection );
+end;
+
+{$IF CompilerVersion >= 21.0}
+function TThriftListImpl<T>.Last: T;
+begin
+  Result := FList.Last;
+end;
+{$IFEND}
+
+function TThriftListImpl<T>.LastIndexOf(const Value: T): Integer;
+begin
+  Result := FList.LastIndexOf( Value );
+end;
+
+{$IF CompilerVersion >= 21.0}
+procedure TThriftListImpl<T>.Move(CurIndex, NewIndex: Integer);
+begin
+  FList.Move( CurIndex,  NewIndex);
+end;
+{$IFEND}
+
+function TThriftListImpl<T>.Remove(const Value: T): Integer;
+begin
+  Result := FList.Remove( Value );
+end;
+
+procedure TThriftListImpl<T>.Reverse;
+begin
+  FList.Reverse;
+end;
+
+procedure TThriftListImpl<T>.SetCapacity(Value: Integer);
+begin
+  FList.Capacity := Value;
+end;
+
+procedure TThriftListImpl<T>.SetCount(Value: Integer);
+begin
+  FList.Count := Value;
+end;
+
+procedure TThriftListImpl<T>.SetItem(Index: Integer; const Value: T);
+begin
+  FList[Index] := Value;
+end;
+
+procedure TThriftListImpl<T>.Sort;
+begin
+  FList.Sort;
+end;
+
+procedure TThriftListImpl<T>.Sort(const AComparer: IComparer<T>);
+begin
+  FList.Sort;
+end;
+
+function TThriftListImpl<T>.ToArray: TArray<T>;
+{$IF CompilerVersion < 22.0}
+var
+  x : T;
+  i : Integer;
+{$IFEND}
+begin
+{$IF CompilerVersion < 22.0}
+  SetLength(Result, Count);
+  i := 0;
+  for x in FList do
+  begin
+    Result[i] := x;
+    Inc( i );
+  end;
+{$ELSE}
+  Result := FList.ToArray;
+{$IFEND}
+end;
+
+procedure TThriftListImpl<T>.TrimExcess;
+begin
+  FList.TrimExcess;
+end;
+
+end.

vendor/git.apache.org/thrift.git/lib/delphi/src/Thrift.Console.pas

@@ -0,0 +1,133 @@
+(*
+ * 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 Thrift.Console;
+
+interface
+
+uses Classes;
+
+type
+  TThriftConsole = class
+  public
+    procedure Write( const S: string); virtual;
+    procedure WriteLine( const S: string); virtual;
+  end;
+
+  TGUIConsole = class( TThriftConsole )
+  private
+    FLineBreak : Boolean;
+    FMemo : TStrings;
+
+    procedure InternalWrite( const S: string; bWriteLine: Boolean);
+  public
+    procedure Write( const S: string); override;
+    procedure WriteLine( const S: string); override;
+    constructor Create( AMemo: TStrings);
+  end;
+
+function Console: TThriftConsole;
+procedure ChangeConsole( AConsole: TThriftConsole );
+procedure RestoreConsoleToDefault;
+
+implementation
+
+var
+  FDefaultConsole : TThriftConsole;
+  FConsole : TThriftConsole;
+
+function Console: TThriftConsole;
+begin
+  Result := FConsole;
+end;
+
+{ TThriftConsole }
+
+procedure TThriftConsole.Write(const S: string);
+begin
+  System.Write( S );
+end;
+
+procedure TThriftConsole.WriteLine(const S: string);
+begin
+  System.Writeln( S );
+end;
+
+procedure ChangeConsole( AConsole: TThriftConsole );
+begin
+  FConsole := AConsole;
+end;
+
+procedure RestoreConsoleToDefault;
+begin
+  FConsole := FDefaultConsole;
+end;
+
+{ TGUIConsole }
+
+constructor TGUIConsole.Create( AMemo: TStrings);
+begin
+  inherited Create;
+  FMemo := AMemo;
+  FLineBreak := True;
+end;
+
+procedure TGUIConsole.InternalWrite(const S: string; bWriteLine: Boolean);
+var
+  idx : Integer;
+begin
+  if FLineBreak then
+  begin
+    FMemo.Add( S );
+  end else
+  begin
+    idx := FMemo.Count - 1;
+    if idx < 0 then
+    begin
+      FMemo.Add( S );
+    end;
+    FMemo[idx] := FMemo[idx] + S;
+  end;
+  FLineBreak := bWriteLine;
+end;
+
+procedure TGUIConsole.Write(const S: string);
+begin
+  InternalWrite( S, False);
+end;
+
+procedure TGUIConsole.WriteLine(const S: string);
+begin
+  InternalWrite( S, True);
+end;
+
+initialization
+begin
+  FDefaultConsole := TThriftConsole.Create;
+  FConsole := FDefaultConsole;
+end;
+
+finalization
+begin
+  FDefaultConsole.Free;
+end;
+
+end.
+
+

vendor/git.apache.org/thrift.git/lib/delphi/src/Thrift.Defines.inc

@@ -0,0 +1,50 @@
+(*
+ * 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.
+ *)
+
+
+// Good lists of Delphi version numbers
+// https://github.com/project-jedi/jedi/blob/master/jedi.inc
+// http://docwiki.embarcadero.com/RADStudio/Seattle/en/Compiler_Versions
+
+
+// start with most backwards compatible defaults
+
+{$DEFINE OLD_UNIT_NAMES}
+{$DEFINE OLD_SOCKETS}      // TODO: add socket support for CompilerVersion >= 28.0
+{$UNDEF HAVE_CLASS_CTOR}
+
+
+// enable features as they are available
+
+{$IF CompilerVersion >= 21.0}   // Delphi 2010
+  {$DEFINE HAVE_CLASS_CTOR}
+{$IFEND}
+
+{$IF CompilerVersion >= 23.0}   // Delphi XE2
+  {$UNDEF OLD_UNIT_NAMES}
+{$IFEND}
+
+{$IF CompilerVersion >= 28.0}   // Delphi XE7
+  {$UNDEF OLD_SOCKETS}
+{$IFEND}
+
+
+// EOF
+
+

vendor/git.apache.org/thrift.git/lib/delphi/src/Thrift.Processor.Multiplex.pas

@@ -0,0 +1,216 @@
+(*
+ * 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 Thrift.Processor.Multiplex;
+
+
+interface
+
+uses
+  SysUtils,
+  Generics.Collections,
+  Thrift,
+  Thrift.Protocol,
+  Thrift.Protocol.Multiplex;
+
+{ TMultiplexedProcessor is a TProcessor allowing a single TServer to provide multiple services.
+  To do so, you instantiate the processor and then register additional processors with it,
+  as shown in the following example:
+
+
+     TMultiplexedProcessor processor = new TMultiplexedProcessor();
+
+     processor.registerProcessor(
+         "Calculator",
+         new Calculator.Processor(new CalculatorHandler()));
+
+     processor.registerProcessor(
+         "WeatherReport",
+         new WeatherReport.Processor(new WeatherReportHandler()));
+
+     TServerTransport t = new TServerSocket(9090);
+     TSimpleServer server = new TSimpleServer(processor, t);
+
+     server.serve();
+}
+
+
+type
+  IMultiplexedProcessor = interface( IProcessor)
+    ['{810FF32D-22A2-4D58-B129-B0590703ECEC}']
+    // Register a service with this TMultiplexedProcessor.  This allows us
+    // to broker requests to individual services by using the service name
+    // to select them at request time.
+    procedure RegisterProcessor( const serviceName : String; const processor : IProcessor);
+  end;
+
+
+  TMultiplexedProcessorImpl = class( TInterfacedObject, IMultiplexedProcessor, IProcessor)
+  private type
+    // Our goal was to work with any protocol.  In order to do that, we needed
+    // to allow them to call readMessageBegin() and get a TMessage in exactly
+    // the standard format, without the service name prepended to TMessage.name.
+    TStoredMessageProtocol = class( TProtocolDecorator)
+    private
+      FMessageBegin : IMessage;
+    public
+      constructor Create( const protocol : IProtocol; const aMsgBegin : IMessage);
+      function ReadMessageBegin: IMessage; override;
+    end;
+
+  private
+    FServiceProcessorMap : TDictionary<String, IProcessor>;
+
+    procedure Error( const oprot : IProtocol; const msg : IMessage;
+                     extype : TApplicationExceptionSpecializedClass; const etxt : string);
+
+  public
+    constructor Create;
+    destructor Destroy;  override;
+
+    // Register a service with this TMultiplexedProcessorImpl.  This allows us
+    // to broker requests to individual services by using the service name
+    // to select them at request time.
+    procedure RegisterProcessor( const serviceName : String; const processor : IProcessor);
+
+    { This implementation of process performs the following steps:
+      - Read the beginning of the message.
+      - Extract the service name from the message.
+      - Using the service name to locate the appropriate processor.
+      - Dispatch to the processor, with a decorated instance of TProtocol
+        that allows readMessageBegin() to return the original TMessage.
+
+      An exception is thrown if the message type is not CALL or ONEWAY
+      or if the service is unknown (or not properly registered).
+    }
+    function Process( const iprot, oprot: IProtocol; const events : IProcessorEvents = nil): Boolean;
+  end;
+
+
+implementation
+
+constructor TMultiplexedProcessorImpl.TStoredMessageProtocol.Create( const protocol : IProtocol; const aMsgBegin : IMessage);
+begin
+  inherited Create( protocol);
+  FMessageBegin := aMsgBegin;
+end;
+
+
+function TMultiplexedProcessorImpl.TStoredMessageProtocol.ReadMessageBegin: IMessage;
+begin
+  result := FMessageBegin;
+end;
+
+
+constructor TMultiplexedProcessorImpl.Create;
+begin
+  inherited Create;
+  FServiceProcessorMap := TDictionary<string,IProcessor>.Create;
+end;
+
+
+destructor TMultiplexedProcessorImpl.Destroy;
+begin
+  try
+    FreeAndNil( FServiceProcessorMap);
+  finally
+    inherited Destroy;
+  end;
+end;
+
+
+procedure TMultiplexedProcessorImpl.RegisterProcessor( const serviceName : String; const processor : IProcessor);
+begin
+  FServiceProcessorMap.Add( serviceName, processor);
+end;
+
+
+procedure TMultiplexedProcessorImpl.Error( const oprot : IProtocol; const msg : IMessage;
+                                           extype : TApplicationExceptionSpecializedClass;
+                                           const etxt : string);
+var appex  : TApplicationException;
+    newMsg : IMessage;
+begin
+  appex := extype.Create(etxt);
+  try
+    newMsg := TMessageImpl.Create( msg.Name, TMessageType.Exception, msg.SeqID);
+
+    oprot.WriteMessageBegin(newMsg);
+    appex.Write(oprot);
+    oprot.WriteMessageEnd();
+    oprot.Transport.Flush();
+
+  finally
+    appex.Free;
+  end;
+end;
+
+
+function TMultiplexedProcessorImpl.Process(const iprot, oprot : IProtocol; const events : IProcessorEvents = nil): Boolean;
+var msg, newMsg : IMessage;
+    idx         : Integer;
+    sService    : string;
+    processor   : IProcessor;
+    protocol    : IProtocol;
+const
+  ERROR_INVALID_MSGTYPE   = 'Message must be "call" or "oneway"';
+  ERROR_INCOMPATIBLE_PROT = 'No service name found in "%s". Client is expected to use TMultiplexProtocol.';
+  ERROR_UNKNOWN_SERVICE   = 'Service "%s" is not registered with MultiplexedProcessor';
+begin
+  // Use the actual underlying protocol (e.g. TBinaryProtocol) to read the message header.
+  // This pulls the message "off the wire", which we'll deal with at the end of this method.
+  msg := iprot.readMessageBegin();
+  if not (msg.Type_ in [TMessageType.Call, TMessageType.Oneway]) then begin
+    Error( oprot, msg,
+           TApplicationExceptionInvalidMessageType,
+           ERROR_INVALID_MSGTYPE);
+    Exit( FALSE);
+  end;
+
+  // Extract the service name
+  idx := Pos( TMultiplexedProtocol.SEPARATOR, msg.Name);
+  if idx < 1 then begin
+    Error( oprot, msg,
+           TApplicationExceptionInvalidProtocol,
+           Format(ERROR_INCOMPATIBLE_PROT,[msg.Name]));
+    Exit( FALSE);
+  end;
+
+  // Create a new TMessage, something that can be consumed by any TProtocol
+  sService := Copy( msg.Name, 1, idx-1);
+  if not FServiceProcessorMap.TryGetValue( sService, processor)
+  then begin
+    Error( oprot, msg,
+           TApplicationExceptionInternalError,
+           Format(ERROR_UNKNOWN_SERVICE,[sService]));
+    Exit( FALSE);
+  end;
+
+  // Create a new TMessage, removing the service name
+  Inc( idx, Length(TMultiplexedProtocol.SEPARATOR));
+  newMsg := TMessageImpl.Create( Copy( msg.Name, idx, MAXINT), msg.Type_, msg.SeqID);
+
+  // Dispatch processing to the stored processor
+  protocol := TStoredMessageProtocol.Create( iprot, newMsg);
+  result   := processor.process( protocol, oprot, events);
+end;
+
+
+end.
+

vendor/git.apache.org/thrift.git/lib/delphi/src/Thrift.Protocol.Multiplex.pas

@@ -0,0 +1,107 @@
+(*
+ * 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 Thrift.Protocol.Multiplex;
+
+interface
+
+uses Thrift.Protocol;
+
+{ TMultiplexedProtocol is a protocol-independent concrete decorator
+  that allows a Thrift client to communicate with a multiplexing Thrift server,
+  by prepending the service name to the function name during function calls.
+
+  NOTE: THIS IS NOT USED BY SERVERS.
+  On the server, use TMultiplexedProcessor to handle requests from a multiplexing client.
+
+  This example uses a single socket transport to invoke two services:
+
+      TSocket transport = new TSocket("localhost", 9090);
+      transport.open();
+
+      TBinaryProtocol protocol = new TBinaryProtocol(transport);
+
+      TMultiplexedProtocol mp = new TMultiplexedProtocol(protocol, "Calculator");
+      Calculator.Client service = new Calculator.Client(mp);
+
+      TMultiplexedProtocol mp2 = new TMultiplexedProtocol(protocol, "WeatherReport");
+      WeatherReport.Client service2 = new WeatherReport.Client(mp2);
+
+      System.out.println(service.add(2,2));
+      System.out.println(service2.getTemperature());
+
+}
+
+type
+  TMultiplexedProtocol = class( TProtocolDecorator)
+  public const
+    {  Used to delimit the service name from the function name }
+    SEPARATOR = ':';
+
+  private
+     FServiceName : String;
+
+  public
+    { Wrap the specified protocol, allowing it to be used to communicate with a multiplexing server.
+      The serviceName is required as it is prepended to the message header so that the multiplexing
+      server can broker the function call to the proper service.
+
+      Args:
+        protocol ....... Your communication protocol of choice, e.g. TBinaryProtocol.
+        serviceName .... The service name of the service communicating via this protocol.
+    }
+    constructor Create( const aProtocol : IProtocol; const aServiceName : string);
+
+    { Prepends the service name to the function name, separated by SEPARATOR.
+      Args: The original message.
+    }
+    procedure WriteMessageBegin( const msg: IMessage); override;
+  end;
+
+
+implementation
+
+
+constructor TMultiplexedProtocol.Create(const aProtocol: IProtocol; const aServiceName: string);
+begin
+  ASSERT( aServiceName <> '');
+  inherited Create(aProtocol);
+  FServiceName := aServiceName;
+end;
+
+
+procedure TMultiplexedProtocol.WriteMessageBegin( const msg: IMessage);
+// Prepends the service name to the function name, separated by TMultiplexedProtocol.SEPARATOR.
+var newMsg : IMessage;
+begin
+  case msg.Type_ of
+    TMessageType.Call,
+    TMessageType.Oneway : begin
+      newMsg := TMessageImpl.Create( FServiceName + SEPARATOR + msg.Name, msg.Type_, msg.SeqID);
+      inherited WriteMessageBegin( newMsg);
+    end;
+
+  else
+    inherited WriteMessageBegin( msg);
+  end;
+end;
+
+
+end.
+

vendor/git.apache.org/thrift.git/lib/delphi/src/Thrift.Serializer.pas

@@ -0,0 +1,230 @@
+(*
+ * 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 Thrift.Serializer;
+
+{$I Thrift.Defines.inc}
+
+interface
+
+uses
+  {$IFDEF OLD_UNIT_NAMES}
+  Classes, Windows, SysUtils,
+  {$ELSE}
+  System.Classes, Winapi.Windows, System.SysUtils,
+  {$ENDIF}
+  Thrift.Protocol,
+  Thrift.Transport,
+  Thrift.Stream;
+
+
+type
+  // Generic utility for easily serializing objects into a byte array or Stream.
+  TSerializer = class
+  private
+    FStream    : TMemoryStream;
+    FTransport : ITransport;
+    FProtocol  : IProtocol;
+
+  public
+    // Create a new TSerializer that uses the TBinaryProtocol by default.
+    constructor Create;  overload;
+
+    // Create a new TSerializer.
+    // It will use the TProtocol specified by the factory that is passed in.
+    constructor Create( const factory : IProtocolFactory);  overload;
+
+    // DTOR
+    destructor Destroy;  override;
+
+    // Serialize the Thrift object.
+    function  Serialize( const input : IBase) : TBytes;  overload;
+    procedure Serialize( const input : IBase; const aStm : TStream);  overload;
+  end;
+
+
+  // Generic utility for easily deserializing objects from byte array or Stream.
+  TDeserializer = class
+  private
+    FStream    : TMemoryStream;
+    FTransport : ITransport;
+    FProtocol  : IProtocol;
+
+  public
+    // Create a new TDeserializer that uses the TBinaryProtocol by default.
+    constructor Create;  overload;
+
+    // Create a new TDeserializer.
+    // It will use the TProtocol specified by the factory that is passed in.
+    constructor Create( const factory : IProtocolFactory);  overload;
+
+    // DTOR
+    destructor Destroy;  override;
+
+    // Deserialize the Thrift object data.
+    procedure Deserialize( const input : TBytes; const target : IBase);  overload;
+    procedure Deserialize( const input : TStream; const target : IBase);  overload;
+  end;
+
+
+
+implementation
+
+
+{ TSerializer }
+
+
+constructor TSerializer.Create();
+// Create a new TSerializer that uses the TBinaryProtocol by default.
+begin
+  //no inherited;
+  Create( TBinaryProtocolImpl.TFactory.Create);
+end;
+
+
+constructor TSerializer.Create( const factory : IProtocolFactory);
+// Create a new TSerializer.
+// It will use the TProtocol specified by the factory that is passed in.
+var adapter : IThriftStream;
+begin
+  inherited Create;
+  FStream    := TMemoryStream.Create;
+  adapter    := TThriftStreamAdapterDelphi.Create( FStream, FALSE);
+  FTransport := TStreamTransportImpl.Create( nil, adapter);
+  FProtocol  := factory.GetProtocol( FTransport);
+end;
+
+
+destructor TSerializer.Destroy;
+begin
+  try
+    FProtocol  := nil;
+    FTransport := nil;
+    FreeAndNil( FStream);
+  finally
+    inherited Destroy;
+  end;
+end;
+
+
+function TSerializer.Serialize( const input : IBase) : TBytes;
+// Serialize the Thrift object into a byte array. The process is simple,
+// just clear the byte array output, write the object into it, and grab the
+// raw bytes.
+var iBytes : Int64;
+begin
+  try
+    FStream.Size := 0;
+    input.Write( FProtocol);
+    SetLength( result, FStream.Size);
+    iBytes := Length(result);
+    if iBytes > 0
+    then Move( FStream.Memory^, result[0], iBytes);
+  finally
+    FStream.Size := 0;  // free any allocated memory
+  end;
+end;
+
+
+procedure TSerializer.Serialize( const input : IBase; const aStm : TStream);
+// Serialize the Thrift object into a byte array. The process is simple,
+// just clear the byte array output, write the object into it, and grab the
+// raw bytes.
+const COPY_ENTIRE_STREAM = 0;
+begin
+  try
+    FStream.Size := 0;
+    input.Write( FProtocol);
+    aStm.CopyFrom( FStream, COPY_ENTIRE_STREAM);
+  finally
+    FStream.Size := 0;  // free any allocated memory
+  end;
+end;
+
+
+{ TDeserializer }
+
+
+constructor TDeserializer.Create();
+// Create a new TDeserializer that uses the TBinaryProtocol by default.
+begin
+  //no inherited;
+  Create( TBinaryProtocolImpl.TFactory.Create);
+end;
+
+
+constructor TDeserializer.Create( const factory : IProtocolFactory);
+// Create a new TDeserializer.
+// It will use the TProtocol specified by the factory that is passed in.
+var adapter : IThriftStream;
+begin
+  inherited Create;
+  FStream    := TMemoryStream.Create;
+  adapter    := TThriftStreamAdapterDelphi.Create( FStream, FALSE);
+  FTransport := TStreamTransportImpl.Create( adapter, nil);
+  FProtocol  := factory.GetProtocol( FTransport);
+end;
+
+
+destructor TDeserializer.Destroy;
+begin
+  try
+    FProtocol  := nil;
+    FTransport := nil;
+    FreeAndNil( FStream);
+  finally
+    inherited Destroy;
+  end;
+end;
+
+
+procedure TDeserializer.Deserialize( const input : TBytes; const target : IBase);
+// Deserialize the Thrift object data from the byte array.
+var iBytes : Int64;
+begin
+  try
+    iBytes := Length(input);
+    FStream.Size := iBytes;
+    if iBytes > 0
+    then Move( input[0], FStream.Memory^, iBytes);
+
+    target.Read( FProtocol);
+  finally
+    FStream.Size := 0;  // free any allocated memory
+  end;
+end;
+
+
+procedure TDeserializer.Deserialize( const input : TStream; const target : IBase);
+// Deserialize the Thrift object data from the byte array.
+const COPY_ENTIRE_STREAM = 0;
+var before : Int64;
+begin
+  try
+    before := FStream.Position;
+    FStream.CopyFrom( input, COPY_ENTIRE_STREAM);
+    FStream.Position := before;
+    target.Read( FProtocol);
+  finally
+    FStream.Size := 0;  // free any allocated memory
+  end;
+end;
+
+
+end.
+

vendor/git.apache.org/thrift.git/lib/delphi/src/Thrift.Server.pas

@@ -0,0 +1,423 @@
+(*
+ * 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 Thrift.Server;
+
+{$I Thrift.Defines.inc}
+{$I-}  // prevent annoying errors with default log delegate and no console
+
+interface
+
+uses
+  {$IFDEF OLD_UNIT_NAMES}
+  Windows, SysUtils,
+  {$ELSE}
+  Winapi.Windows, System.SysUtils,
+  {$ENDIF}
+  Thrift,
+  Thrift.Protocol,
+  Thrift.Transport;
+
+type
+  IServerEvents = interface
+    ['{9E2A99C5-EE85-40B2-9A52-2D1722B18176}']
+    // Called before the server begins.
+    procedure PreServe;
+    // Called when the server transport is ready to accept requests
+    procedure PreAccept;
+    // Called when a new client has connected and the server is about to being processing.
+    function  CreateProcessingContext( const input, output : IProtocol) : IProcessorEvents;
+  end;
+
+
+  IServer = interface
+    ['{ADC46F2D-8199-4D1C-96D2-87FD54351723}']
+    procedure Serve;
+    procedure Stop;
+
+    function GetServerEvents : IServerEvents;
+    procedure SetServerEvents( const value : IServerEvents);
+
+    property ServerEvents : IServerEvents read GetServerEvents write SetServerEvents;
+  end;
+
+  TServerImpl = class abstract( TInterfacedObject, IServer )
+  public
+    type
+      TLogDelegate = reference to procedure( const str: string);
+  protected
+    FProcessor : IProcessor;
+    FServerTransport : IServerTransport;
+    FInputTransportFactory : ITransportFactory;
+    FOutputTransportFactory : ITransportFactory;
+    FInputProtocolFactory : IProtocolFactory;
+    FOutputProtocolFactory : IProtocolFactory;
+    FLogDelegate : TLogDelegate;
+    FServerEvents : IServerEvents;
+
+    class procedure DefaultLogDelegate( const str: string);
+
+    function GetServerEvents : IServerEvents;
+    procedure SetServerEvents( const value : IServerEvents);
+
+    procedure Serve; virtual; abstract;
+    procedure Stop; virtual; abstract;
+  public
+    constructor Create(
+      const AProcessor :IProcessor;
+      const AServerTransport: IServerTransport;
+      const AInputTransportFactory : ITransportFactory;
+      const AOutputTransportFactory : ITransportFactory;
+      const AInputProtocolFactory : IProtocolFactory;
+      const AOutputProtocolFactory : IProtocolFactory;
+      const ALogDelegate : TLogDelegate
+      ); overload;
+
+    constructor Create(
+      const AProcessor :IProcessor;
+      const AServerTransport: IServerTransport
+      ); overload;
+
+    constructor Create(
+      const AProcessor :IProcessor;
+      const AServerTransport: IServerTransport;
+      const ALogDelegate: TLogDelegate
+      ); overload;
+
+    constructor Create(
+      const AProcessor :IProcessor;
+      const AServerTransport: IServerTransport;
+      const ATransportFactory : ITransportFactory
+      ); overload;
+
+    constructor Create(
+      const AProcessor :IProcessor;
+      const AServerTransport: IServerTransport;
+      const ATransportFactory : ITransportFactory;
+      const AProtocolFactory : IProtocolFactory
+      ); overload;
+  end;
+
+  TSimpleServer = class( TServerImpl)
+  private
+    FStop : Boolean;
+  public
+    constructor Create( const AProcessor: IProcessor; const AServerTransport: IServerTransport); overload;
+    constructor Create( const AProcessor: IProcessor; const AServerTransport: IServerTransport;
+      ALogDel: TServerImpl.TLogDelegate); overload;
+    constructor Create( const AProcessor: IProcessor; const AServerTransport: IServerTransport;
+      const ATransportFactory: ITransportFactory); overload;
+    constructor Create( const AProcessor: IProcessor; const AServerTransport: IServerTransport;
+      const ATransportFactory: ITransportFactory; const AProtocolFactory: IProtocolFactory); overload;
+
+    procedure Serve; override;
+    procedure Stop; override;
+  end;
+
+
+implementation
+
+{ TServerImpl }
+
+constructor TServerImpl.Create( const AProcessor: IProcessor;
+  const AServerTransport: IServerTransport; const ALogDelegate: TLogDelegate);
+var
+  InputFactory, OutputFactory : IProtocolFactory;
+  InputTransFactory, OutputTransFactory : ITransportFactory;
+
+begin
+  InputFactory := TBinaryProtocolImpl.TFactory.Create;
+  OutputFactory := TBinaryProtocolImpl.TFactory.Create;
+  InputTransFactory := TTransportFactoryImpl.Create;
+  OutputTransFactory := TTransportFactoryImpl.Create;
+
+  //no inherited;
+  Create(
+    AProcessor,
+    AServerTransport,
+    InputTransFactory,
+    OutputTransFactory,
+    InputFactory,
+    OutputFactory,
+    ALogDelegate
+  );
+end;
+
+constructor TServerImpl.Create(const AProcessor: IProcessor;
+  const AServerTransport: IServerTransport);
+var
+  InputFactory, OutputFactory : IProtocolFactory;
+  InputTransFactory, OutputTransFactory : ITransportFactory;
+
+begin
+  InputFactory := TBinaryProtocolImpl.TFactory.Create;
+  OutputFactory := TBinaryProtocolImpl.TFactory.Create;
+  InputTransFactory := TTransportFactoryImpl.Create;
+  OutputTransFactory := TTransportFactoryImpl.Create;
+
+  //no inherited;
+  Create(
+    AProcessor,
+    AServerTransport,
+    InputTransFactory,
+    OutputTransFactory,
+    InputFactory,
+    OutputFactory,
+    DefaultLogDelegate
+  );
+end;
+
+constructor TServerImpl.Create(const AProcessor: IProcessor;
+  const AServerTransport: IServerTransport; const ATransportFactory: ITransportFactory);
+var
+  InputProtocolFactory : IProtocolFactory;
+  OutputProtocolFactory : IProtocolFactory;
+begin
+  InputProtocolFactory := TBinaryProtocolImpl.TFactory.Create;
+  OutputProtocolFactory := TBinaryProtocolImpl.TFactory.Create;
+
+  //no inherited;
+  Create( AProcessor, AServerTransport, ATransportFactory, ATransportFactory,
+    InputProtocolFactory, OutputProtocolFactory, DefaultLogDelegate);
+end;
+
+constructor TServerImpl.Create(const AProcessor: IProcessor;
+  const AServerTransport: IServerTransport;
+  const AInputTransportFactory, AOutputTransportFactory: ITransportFactory;
+  const AInputProtocolFactory, AOutputProtocolFactory: IProtocolFactory;
+  const ALogDelegate : TLogDelegate);
+begin
+  inherited Create;
+  FProcessor := AProcessor;
+  FServerTransport := AServerTransport;
+  FInputTransportFactory := AInputTransportFactory;
+  FOutputTransportFactory := AOutputTransportFactory;
+  FInputProtocolFactory := AInputProtocolFactory;
+  FOutputProtocolFactory := AOutputProtocolFactory;
+  FLogDelegate := ALogDelegate;
+end;
+
+class procedure TServerImpl.DefaultLogDelegate( const str: string);
+begin
+  try
+    Writeln( str);
+    if IoResult <> 0 then OutputDebugString(PChar(str));
+  except
+    OutputDebugString(PChar(str));
+  end;
+end;
+
+constructor TServerImpl.Create( const AProcessor: IProcessor;
+  const AServerTransport: IServerTransport; const ATransportFactory: ITransportFactory;
+  const AProtocolFactory: IProtocolFactory);
+begin
+  //no inherited;
+  Create( AProcessor, AServerTransport,
+          ATransportFactory, ATransportFactory,
+          AProtocolFactory, AProtocolFactory,
+          DefaultLogDelegate);
+end;
+
+
+function TServerImpl.GetServerEvents : IServerEvents;
+begin
+  result := FServerEvents;
+end;
+
+
+procedure TServerImpl.SetServerEvents( const value : IServerEvents);
+begin
+  // if you need more than one, provide a specialized IServerEvents implementation
+  FServerEvents := value;
+end;
+
+
+{ TSimpleServer }
+
+constructor TSimpleServer.Create( const AProcessor: IProcessor;
+  const AServerTransport: IServerTransport);
+var
+  InputProtocolFactory : IProtocolFactory;
+  OutputProtocolFactory : IProtocolFactory;
+  InputTransportFactory : ITransportFactory;
+  OutputTransportFactory : ITransportFactory;
+begin
+  InputProtocolFactory := TBinaryProtocolImpl.TFactory.Create;
+  OutputProtocolFactory := TBinaryProtocolImpl.TFactory.Create;
+  InputTransportFactory := TTransportFactoryImpl.Create;
+  OutputTransportFactory := TTransportFactoryImpl.Create;
+
+  inherited Create( AProcessor, AServerTransport, InputTransportFactory,
+    OutputTransportFactory, InputProtocolFactory, OutputProtocolFactory, DefaultLogDelegate);
+end;
+
+constructor TSimpleServer.Create( const AProcessor: IProcessor;
+  const AServerTransport: IServerTransport; ALogDel: TServerImpl.TLogDelegate);
+var
+  InputProtocolFactory : IProtocolFactory;
+  OutputProtocolFactory : IProtocolFactory;
+  InputTransportFactory : ITransportFactory;
+  OutputTransportFactory : ITransportFactory;
+begin
+  InputProtocolFactory := TBinaryProtocolImpl.TFactory.Create;
+  OutputProtocolFactory := TBinaryProtocolImpl.TFactory.Create;
+  InputTransportFactory := TTransportFactoryImpl.Create;
+  OutputTransportFactory := TTransportFactoryImpl.Create;
+
+  inherited Create( AProcessor, AServerTransport, InputTransportFactory,
+    OutputTransportFactory, InputProtocolFactory, OutputProtocolFactory, ALogDel);
+end;
+
+constructor TSimpleServer.Create( const AProcessor: IProcessor;
+  const AServerTransport: IServerTransport; const ATransportFactory: ITransportFactory);
+begin
+  inherited Create( AProcessor, AServerTransport, ATransportFactory,
+    ATransportFactory, TBinaryProtocolImpl.TFactory.Create, TBinaryProtocolImpl.TFactory.Create, DefaultLogDelegate);
+end;
+
+constructor TSimpleServer.Create( const AProcessor: IProcessor;
+  const AServerTransport: IServerTransport; const ATransportFactory: ITransportFactory;
+  const AProtocolFactory: IProtocolFactory);
+begin
+  inherited Create( AProcessor, AServerTransport, ATransportFactory,
+    ATransportFactory, AProtocolFactory, AProtocolFactory, DefaultLogDelegate);
+end;
+
+procedure TSimpleServer.Serve;
+var
+  client : ITransport;
+  InputTransport : ITransport;
+  OutputTransport : ITransport;
+  InputProtocol : IProtocol;
+  OutputProtocol : IProtocol;
+  context : IProcessorEvents;
+begin
+  try
+    FServerTransport.Listen;
+  except
+    on E: Exception do
+    begin
+      FLogDelegate( E.ToString);
+    end;
+  end;
+
+  if FServerEvents <> nil
+  then FServerEvents.PreServe;
+
+  client := nil;
+  while (not FStop) do
+  begin
+    try
+      // clean up any old instances before waiting for clients
+      InputTransport := nil;
+      OutputTransport := nil;
+      InputProtocol := nil;
+      OutputProtocol := nil;
+
+      // close any old connections before before waiting for new clients
+      if client <> nil then try
+        try
+          client.Close;
+        finally
+          client := nil;
+        end;
+      except
+        // catch all, we can't do much about it at this point
+      end;
+
+      client := FServerTransport.Accept( procedure
+                                         begin
+                                           if FServerEvents <> nil
+                                           then FServerEvents.PreAccept;
+                                         end);
+
+      if client = nil then begin
+        if FStop
+        then Abort  // silent exception
+        else raise TTransportExceptionUnknown.Create('ServerTransport.Accept() may not return NULL');
+      end;
+
+      FLogDelegate( 'Client Connected!');
+
+      InputTransport := FInputTransportFactory.GetTransport( client );
+      OutputTransport := FOutputTransportFactory.GetTransport( client );
+      InputProtocol := FInputProtocolFactory.GetProtocol( InputTransport );
+      OutputProtocol := FOutputProtocolFactory.GetProtocol( OutputTransport );
+
+      if FServerEvents <> nil
+      then context := FServerEvents.CreateProcessingContext( InputProtocol, OutputProtocol)
+      else context := nil;
+
+      while not FStop do begin
+        if context <> nil
+        then context.Processing( client);
+        if not FProcessor.Process( InputProtocol, OutputProtocol, context)
+        then Break;
+      end;
+
+    except
+      on E: TTransportException do
+      begin
+        if FStop
+        then FLogDelegate('TSimpleServer was shutting down, caught ' + E.ToString)
+        else FLogDelegate( E.ToString);
+      end;
+      on E: Exception do
+      begin
+        FLogDelegate( E.ToString);
+      end;
+    end;
+
+    if context <> nil
+    then begin
+      context.CleanupContext;
+      context := nil;
+    end;
+
+    if InputTransport <> nil then
+    begin
+      InputTransport.Close;
+    end;
+    if OutputTransport <> nil then
+    begin
+      OutputTransport.Close;
+    end;
+  end;
+
+  if FStop then
+  begin
+    try
+      FServerTransport.Close;
+    except
+      on E: TTransportException do
+      begin
+        FLogDelegate('TServerTranport failed on close: ' + E.Message);
+      end;
+    end;
+    FStop := False;
+  end;
+end;
+
+procedure TSimpleServer.Stop;
+begin
+  FStop := True;
+  FServerTransport.Close;
+end;
+
+end.

vendor/git.apache.org/thrift.git/lib/delphi/src/Thrift.Stream.pas

@@ -0,0 +1,288 @@
+(*
+ * 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 Thrift.Stream;
+
+{$I Thrift.Defines.inc}
+
+interface
+
+uses
+  Classes,
+  SysUtils,
+  SysConst,
+  RTLConsts,
+  {$IFDEF OLD_UNIT_NAMES}
+  ActiveX,
+  {$ELSE}
+  Winapi.ActiveX,
+  {$ENDIF}
+  Thrift.Utils;
+
+type
+
+  IThriftStream = interface
+    ['{732621B3-F697-4D76-A1B0-B4DD5A8E4018}']
+    procedure Write( const buffer: TBytes; offset: Integer; count: Integer);
+    function Read( var buffer: TBytes; offset: Integer; count: Integer): Integer;
+    procedure Open;
+    procedure Close;
+    procedure Flush;
+    function IsOpen: Boolean;
+    function ToArray: TBytes;
+  end;
+
+  TThriftStreamImpl = class( TInterfacedObject, IThriftStream)
+  private
+    procedure CheckSizeAndOffset( const buffer: TBytes; offset: Integer; count: Integer);
+  protected
+    procedure Write( const buffer: TBytes; offset: Integer; count: Integer); virtual;
+    function Read( var buffer: TBytes; offset: Integer; count: Integer): Integer; virtual;
+    procedure Open; virtual; abstract;
+    procedure Close; virtual; abstract;
+    procedure Flush; virtual; abstract;
+    function IsOpen: Boolean; virtual; abstract;
+    function ToArray: TBytes; virtual; abstract;
+  end;
+
+  TThriftStreamAdapterDelphi = class( TThriftStreamImpl )
+  private
+    FStream : TStream;
+    FOwnsStream : Boolean;
+  protected
+    procedure Write( const buffer: TBytes; offset: Integer; count: Integer); override;
+    function Read( var buffer: TBytes; offset: Integer; count: Integer): Integer; override;
+    procedure Open; override;
+    procedure Close; override;
+    procedure Flush; override;
+    function IsOpen: Boolean; override;
+    function ToArray: TBytes; override;
+  public
+    constructor Create( const AStream: TStream; AOwnsStream : Boolean);
+    destructor Destroy; override;
+  end;
+
+  TThriftStreamAdapterCOM = class( TThriftStreamImpl)
+  private
+    FStream : IStream;
+  protected
+    procedure Write( const buffer: TBytes; offset: Integer; count: Integer); override;
+    function Read( var buffer: TBytes; offset: Integer; count: Integer): Integer; override;
+    procedure Open; override;
+    procedure Close; override;
+    procedure Flush; override;
+    function IsOpen: Boolean; override;
+    function ToArray: TBytes; override;
+  public
+    constructor Create( const AStream: IStream);
+  end;
+
+implementation
+
+{ TThriftStreamAdapterCOM }
+
+procedure TThriftStreamAdapterCOM.Close;
+begin
+  FStream := nil;
+end;
+
+constructor TThriftStreamAdapterCOM.Create( const AStream: IStream);
+begin
+  inherited Create;
+  FStream := AStream;
+end;
+
+procedure TThriftStreamAdapterCOM.Flush;
+begin
+  if IsOpen then begin
+    if FStream <> nil then begin
+      FStream.Commit( STGC_DEFAULT );
+    end;
+  end;
+end;
+
+function TThriftStreamAdapterCOM.IsOpen: Boolean;
+begin
+  Result := FStream <> nil;
+end;
+
+procedure TThriftStreamAdapterCOM.Open;
+begin
+  // nothing to do
+end;
+
+function TThriftStreamAdapterCOM.Read( var buffer: TBytes; offset: Integer; count: Integer): Integer;
+begin
+  inherited;
+  Result := 0;
+  if FStream <> nil then begin
+    if count > 0 then begin
+      FStream.Read( @buffer[offset], count, @Result);
+    end;
+  end;
+end;
+
+function TThriftStreamAdapterCOM.ToArray: TBytes;
+var
+  statstg: TStatStg;
+  len : Integer;
+  NewPos : {$IF CompilerVersion >= 29.0} UInt64 {$ELSE} Int64  {$IFEND};
+  cbRead : Integer;
+begin
+  FillChar( statstg, SizeOf( statstg), 0);
+  len := 0;
+  if IsOpen then begin
+    if Succeeded( FStream.Stat( statstg, STATFLAG_NONAME )) then begin
+      len := statstg.cbSize;
+    end;
+  end;
+
+  SetLength( Result, len );
+
+  if len > 0 then begin
+    if Succeeded( FStream.Seek( 0, STREAM_SEEK_SET, NewPos) ) then begin
+      FStream.Read( @Result[0], len, @cbRead);
+    end;
+  end;
+end;
+
+procedure TThriftStreamAdapterCOM.Write( const buffer: TBytes; offset: Integer; count: Integer);
+var nWritten : Integer;
+begin
+  inherited;
+  if IsOpen then begin
+    if count > 0 then begin
+      FStream.Write( @buffer[0], count, @nWritten);
+    end;
+  end;
+end;
+
+{ TThriftStreamImpl }
+
+procedure TThriftStreamImpl.CheckSizeAndOffset(const buffer: TBytes; offset,
+  count: Integer);
+var
+  len : Integer;
+begin
+  if count > 0 then begin
+    len := Length( buffer );
+    if (offset < 0) or ( offset >= len) then begin
+      raise ERangeError.Create( SBitsIndexError );
+    end;
+    if count > len then begin
+      raise ERangeError.Create( SBitsIndexError );
+    end;
+  end;
+end;
+
+function TThriftStreamImpl.Read(var buffer: TBytes; offset, count: Integer): Integer;
+begin
+  Result := 0;
+  CheckSizeAndOffset( buffer, offset, count );
+end;
+
+procedure TThriftStreamImpl.Write(const buffer: TBytes; offset, count: Integer);
+begin
+  CheckSizeAndOffset( buffer, offset, count );
+end;
+
+{ TThriftStreamAdapterDelphi }
+
+procedure TThriftStreamAdapterDelphi.Close;
+begin
+  FStream.Free;
+  FStream := nil;
+  FOwnsStream := False;
+end;
+
+constructor TThriftStreamAdapterDelphi.Create( const AStream: TStream; AOwnsStream: Boolean);
+begin
+  inherited Create;
+  FStream := AStream;
+  FOwnsStream := AOwnsStream;
+end;
+
+destructor TThriftStreamAdapterDelphi.Destroy;
+begin
+  if FOwnsStream 
+  then Close;
+  
+  inherited;
+end;
+
+procedure TThriftStreamAdapterDelphi.Flush;
+begin
+  // nothing to do
+end;
+
+function TThriftStreamAdapterDelphi.IsOpen: Boolean;
+begin
+  Result := FStream <> nil;
+end;
+
+procedure TThriftStreamAdapterDelphi.Open;
+begin
+  // nothing to do
+end;
+
+function TThriftStreamAdapterDelphi.Read(var buffer: TBytes; offset,
+  count: Integer): Integer;
+begin
+  inherited;
+  Result := 0;
+  if count > 0 then begin
+    Result := FStream.Read( Pointer(@buffer[offset])^, count)
+  end;
+end;
+
+function TThriftStreamAdapterDelphi.ToArray: TBytes;
+var
+  OrgPos : Integer;
+  len : Integer;
+begin
+  len := 0;
+  if FStream <> nil then
+  begin
+    len := FStream.Size;
+  end;
+
+  SetLength( Result, len );
+
+  if len > 0 then
+  begin
+    OrgPos := FStream.Position;
+    try
+      FStream.Position := 0;
+      FStream.ReadBuffer( Pointer(@Result[0])^, len );
+    finally
+      FStream.Position := OrgPos;
+    end;
+  end
+end;
+
+procedure TThriftStreamAdapterDelphi.Write(const buffer: TBytes; offset,
+  count: Integer);
+begin
+  inherited;
+  if count > 0 then begin
+    FStream.Write( Pointer(@buffer[offset])^, count)
+  end;
+end;
+
+end.

vendor/git.apache.org/thrift.git/lib/delphi/src/Thrift.Transport.Pipes.pas

@@ -0,0 +1,997 @@
+(*
+ * 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 Thrift.Transport.Pipes;
+
+{$WARN SYMBOL_PLATFORM OFF}
+{$I Thrift.Defines.inc}
+
+interface
+
+uses
+  {$IFDEF OLD_UNIT_NAMES}
+  Windows, SysUtils, Math, AccCtrl, AclAPI, SyncObjs,
+  {$ELSE}
+  Winapi.Windows, System.SysUtils, System.Math, Winapi.AccCtrl, Winapi.AclAPI, System.SyncObjs,
+  {$ENDIF}
+  Thrift.Transport,
+  Thrift.Utils,
+  Thrift.Stream;
+
+const
+  DEFAULT_THRIFT_PIPE_OPEN_TIMEOUT = 10;  // default: fail fast on open
+
+
+type
+  //--- Pipe Streams ---
+
+
+  TPipeStreamBase = class( TThriftStreamImpl)
+  strict protected
+    FPipe    : THandle;
+    FTimeout : DWORD;
+    FOpenTimeOut : DWORD;  // separate value to allow for fail-fast-on-open scenarios
+    FOverlapped : Boolean;
+
+    procedure Write( const buffer: TBytes; offset: Integer; count: Integer); override;
+    function  Read( var buffer: TBytes; offset: Integer; count: Integer): Integer; override;
+    //procedure Open; override; - see derived classes
+    procedure Close; override;
+    procedure Flush; override;
+
+    function  ReadDirect(     var buffer: TBytes; offset: Integer; count: Integer): Integer;
+    function  ReadOverlapped( var buffer: TBytes; offset: Integer; count: Integer): Integer;
+    procedure WriteDirect(     const buffer: TBytes; offset: Integer; count: Integer);
+    procedure WriteOverlapped( const buffer: TBytes; offset: Integer; count: Integer);
+
+    function IsOpen: Boolean; override;
+    function ToArray: TBytes; override;
+  public
+    constructor Create( aEnableOverlapped : Boolean;
+                        const aTimeOut : DWORD = DEFAULT_THRIFT_TIMEOUT;
+                        const aOpenTimeOut : DWORD = DEFAULT_THRIFT_PIPE_OPEN_TIMEOUT);
+    destructor Destroy;  override;
+  end;
+
+
+  TNamedPipeStreamImpl = class sealed( TPipeStreamBase)
+  strict private
+    FPipeName  : string;
+    FShareMode : DWORD;
+    FSecurityAttribs : PSecurityAttributes;
+
+  strict protected
+    procedure Open; override;
+
+  public
+    constructor Create( const aPipeName : string;
+                        const aEnableOverlapped : Boolean;
+                        const aShareMode: DWORD = 0;
+                        const aSecurityAttributes: PSecurityAttributes = nil;
+                        const aTimeOut : DWORD = DEFAULT_THRIFT_TIMEOUT;
+                        const aOpenTimeOut : DWORD = DEFAULT_THRIFT_PIPE_OPEN_TIMEOUT);  overload;
+  end;
+
+
+  THandlePipeStreamImpl = class sealed( TPipeStreamBase)
+  strict private
+    FSrcHandle : THandle;
+
+  strict protected
+    procedure Open; override;
+
+  public
+    constructor Create( const aPipeHandle : THandle;
+                        const aOwnsHandle, aEnableOverlapped : Boolean;
+                        const aTimeOut : DWORD = DEFAULT_THRIFT_TIMEOUT);  overload;
+    destructor Destroy;  override;
+  end;
+
+
+  //--- Pipe Transports ---
+
+
+  IPipeTransport = interface( IStreamTransport)
+    ['{5E05CC85-434F-428F-BFB2-856A168B5558}']
+  end;
+
+
+  TPipeTransportBase = class( TStreamTransportImpl, IPipeTransport)
+  public
+    // ITransport
+    function  GetIsOpen: Boolean; override;
+    procedure Open; override;
+    procedure Close; override;
+  end;
+
+
+  TNamedPipeTransportClientEndImpl = class( TPipeTransportBase)
+  public
+    // Named pipe constructors
+    constructor Create( aPipe : THandle; aOwnsHandle : Boolean;
+                        const aTimeOut : DWORD); overload;
+    constructor Create( const aPipeName : string;
+                        const aShareMode: DWORD = 0;
+                        const aSecurityAttributes: PSecurityAttributes = nil;
+                        const aTimeOut : DWORD = DEFAULT_THRIFT_TIMEOUT;
+                        const aOpenTimeOut : DWORD = DEFAULT_THRIFT_PIPE_OPEN_TIMEOUT);  overload;
+  end;
+
+
+  TNamedPipeTransportServerEndImpl = class( TNamedPipeTransportClientEndImpl)
+  strict private
+    FHandle : THandle;
+  public
+    // ITransport
+    procedure Close; override;
+    constructor Create( aPipe : THandle; aOwnsHandle : Boolean;
+                        const aTimeOut : DWORD = DEFAULT_THRIFT_TIMEOUT); reintroduce;
+  end;
+
+
+  TAnonymousPipeTransportImpl = class( TPipeTransportBase)
+  public
+    // Anonymous pipe constructor
+    constructor Create(const aPipeRead, aPipeWrite : THandle;
+                       aOwnsHandles : Boolean;
+                       const aTimeOut : DWORD = DEFAULT_THRIFT_TIMEOUT); overload;
+  end;
+
+
+  //--- Server Transports ---
+
+
+  IAnonymousPipeServerTransport = interface( IServerTransport)
+    ['{7AEE6793-47B9-4E49-981A-C39E9108E9AD}']
+    // Server side anonymous pipe ends
+    function ReadHandle : THandle;
+    function WriteHandle : THandle;
+    // Client side anonymous pipe ends
+    function ClientAnonRead : THandle;
+    function ClientAnonWrite  : THandle;
+  end;
+
+
+  INamedPipeServerTransport = interface( IServerTransport)
+    ['{9DF9EE48-D065-40AF-8F67-D33037D3D960}']
+    function Handle : THandle;
+  end;
+
+
+  TPipeServerTransportBase = class( TServerTransportImpl)
+  strict protected
+    FStopServer : TEvent;
+    procedure InternalClose; virtual; abstract;
+    function QueryStopServer : Boolean;
+  public
+    constructor Create;
+    destructor Destroy;  override;
+    procedure Listen; override;
+    procedure Close; override;
+  end;
+
+
+  TAnonymousPipeServerTransportImpl = class( TPipeServerTransportBase, IAnonymousPipeServerTransport)
+  strict private
+    FBufSize      : DWORD;
+
+    // Server side anonymous pipe handles
+    FReadHandle,
+    FWriteHandle : THandle;
+
+    //Client side anonymous pipe handles
+    FClientAnonRead,
+    FClientAnonWrite  : THandle;
+
+    FTimeOut: DWORD;
+  protected
+    function Accept(const fnAccepting: TProc): ITransport; override;
+
+    function CreateAnonPipe : Boolean;
+
+    // IAnonymousPipeServerTransport
+    function ReadHandle : THandle;
+    function WriteHandle : THandle;
+    function ClientAnonRead : THandle;
+    function ClientAnonWrite  : THandle;
+
+    procedure InternalClose; override;
+
+  public
+    constructor Create(aBufsize : Cardinal = 4096; aTimeOut : DWORD = DEFAULT_THRIFT_TIMEOUT);
+  end;
+
+
+  TNamedPipeServerTransportImpl = class( TPipeServerTransportBase, INamedPipeServerTransport)
+  strict private
+    FPipeName     : string;
+    FMaxConns     : DWORD;
+    FBufSize      : DWORD;
+    FTimeout      : DWORD;
+    FHandle       : THandle;
+    FConnected    : Boolean;
+
+
+  strict protected
+    function Accept(const fnAccepting: TProc): ITransport; override;
+    function CreateNamedPipe : THandle;
+    function CreateTransportInstance : ITransport;
+
+    // INamedPipeServerTransport
+    function Handle : THandle;
+    procedure InternalClose; override;
+
+  public
+    constructor Create( aPipename : string; aBufsize : Cardinal = 4096;
+                        aMaxConns : Cardinal = PIPE_UNLIMITED_INSTANCES;
+                        aTimeOut : Cardinal = INFINITE);
+  end;
+
+
+implementation
+
+
+procedure ClosePipeHandle( var hPipe : THandle);
+begin
+  if hPipe <> INVALID_HANDLE_VALUE
+  then try
+    CloseHandle( hPipe);
+  finally
+    hPipe := INVALID_HANDLE_VALUE;
+  end;
+end;
+
+
+function DuplicatePipeHandle( const hSource : THandle) : THandle;
+begin
+  if not DuplicateHandle( GetCurrentProcess, hSource,
+                          GetCurrentProcess, @result,
+                          0, FALSE, DUPLICATE_SAME_ACCESS)
+  then raise TTransportExceptionNotOpen.Create('DuplicateHandle: '+SysErrorMessage(GetLastError));
+end;
+
+
+
+{ TPipeStreamBase }
+
+
+constructor TPipeStreamBase.Create( aEnableOverlapped : Boolean;
+                                    const aTimeOut, aOpenTimeOut : DWORD);
+begin
+  inherited Create;
+  ASSERT( aTimeout > 0);  // aOpenTimeout may be 0
+  FPipe        := INVALID_HANDLE_VALUE;
+  FTimeout     := aTimeOut;
+  FOpenTimeOut := aOpenTimeOut;
+  FOverlapped  := aEnableOverlapped;
+end;
+
+
+destructor TPipeStreamBase.Destroy;
+begin
+  try
+    Close;
+  finally
+    inherited Destroy;
+  end;
+end;
+
+
+procedure TPipeStreamBase.Close;
+begin
+  ClosePipeHandle( FPipe);
+end;
+
+
+procedure TPipeStreamBase.Flush;
+begin
+  FlushFileBuffers( FPipe);
+end;
+
+
+function TPipeStreamBase.IsOpen: Boolean;
+begin
+  result := (FPipe <> INVALID_HANDLE_VALUE);
+end;
+
+
+procedure TPipeStreamBase.Write(const buffer: TBytes; offset, count: Integer);
+begin
+  if FOverlapped
+  then WriteOverlapped( buffer, offset, count)
+  else WriteDirect( buffer, offset, count);
+end;
+
+
+function TPipeStreamBase.Read( var buffer: TBytes; offset, count: Integer): Integer;
+begin
+  if FOverlapped
+  then result := ReadOverlapped( buffer, offset, count)
+  else result := ReadDirect( buffer, offset, count);
+end;
+
+
+procedure TPipeStreamBase.WriteDirect(const buffer: TBytes; offset, count: Integer);
+var cbWritten : DWORD;
+begin
+  if not IsOpen
+  then raise TTransportExceptionNotOpen.Create('Called write on non-open pipe');
+
+  if not WriteFile( FPipe, buffer[offset], count, cbWritten, nil)
+  then raise TTransportExceptionNotOpen.Create('Write to pipe failed');
+end;
+
+
+function TPipeStreamBase.ReadDirect( var buffer: TBytes; offset, count: Integer): Integer;
+var cbRead, dwErr  : DWORD;
+    bytes, retries  : LongInt;
+    bOk     : Boolean;
+const INTERVAL = 10;  // ms
+begin
+  if not IsOpen
+  then raise TTransportExceptionNotOpen.Create('Called read on non-open pipe');
+
+  // MSDN: Handle can be a handle to a named pipe instance,
+  // or it can be a handle to the read end of an anonymous pipe,
+  // The handle must have GENERIC_READ access to the pipe.
+  if FTimeOut <> INFINITE then begin
+    retries := Max( 1, Round( 1.0 * FTimeOut / INTERVAL));
+    while TRUE do begin
+      if not PeekNamedPipe( FPipe, nil, 0, nil, @bytes, nil) then begin
+        dwErr := GetLastError;
+        if (dwErr = ERROR_INVALID_HANDLE)
+        or (dwErr = ERROR_BROKEN_PIPE)
+        or (dwErr = ERROR_PIPE_NOT_CONNECTED)
+        then begin
+          result := 0;  // other side closed the pipe
+          Exit;
+        end;
+      end
+      else if bytes > 0 then begin
+        Break;  // there are data
+      end;
+
+      Dec( retries);
+      if retries > 0
+      then Sleep( INTERVAL)
+      else raise TTransportExceptionTimedOut.Create('Pipe read timed out');
+    end;
+  end;
+
+  // read the data (or block INFINITE-ly)
+  bOk := ReadFile( FPipe, buffer[offset], count, cbRead, nil);
+  if (not bOk) and (GetLastError() <> ERROR_MORE_DATA)
+  then result := 0 // No more data, possibly because client disconnected.
+  else result := cbRead;
+end;
+
+
+procedure TPipeStreamBase.WriteOverlapped(const buffer: TBytes; offset, count: Integer);
+var cbWritten, dwWait, dwError : DWORD;
+    overlapped : IOverlappedHelper;
+begin
+  if not IsOpen
+  then raise TTransportExceptionNotOpen.Create('Called write on non-open pipe');
+
+  overlapped := TOverlappedHelperImpl.Create;
+
+  if not WriteFile( FPipe, buffer[offset], count, cbWritten, overlapped.OverlappedPtr)
+  then begin
+    dwError := GetLastError;
+    case dwError of
+      ERROR_IO_PENDING : begin
+        dwWait := overlapped.WaitFor(FTimeout);
+
+        if (dwWait = WAIT_TIMEOUT)
+        then raise TTransportExceptionTimedOut.Create('Pipe write timed out');
+
+        if (dwWait <> WAIT_OBJECT_0)
+        or not GetOverlappedResult( FPipe, overlapped.Overlapped, cbWritten, TRUE)
+        then raise TTransportExceptionUnknown.Create('Pipe write error');
+      end;
+
+    else
+      raise TTransportExceptionUnknown.Create(SysErrorMessage(dwError));
+    end;
+  end;
+
+  ASSERT( DWORD(count) = cbWritten);
+end;
+
+
+function TPipeStreamBase.ReadOverlapped( var buffer: TBytes; offset, count: Integer): Integer;
+var cbRead, dwWait, dwError  : DWORD;
+    bOk     : Boolean;
+    overlapped : IOverlappedHelper;
+begin
+  if not IsOpen
+  then raise TTransportExceptionNotOpen.Create('Called read on non-open pipe');
+
+  overlapped := TOverlappedHelperImpl.Create;
+
+  // read the data
+  bOk := ReadFile( FPipe, buffer[offset], count, cbRead, overlapped.OverlappedPtr);
+  if not bOk then begin
+    dwError := GetLastError;
+    case dwError of
+      ERROR_IO_PENDING : begin
+        dwWait := overlapped.WaitFor(FTimeout);
+
+        if (dwWait = WAIT_TIMEOUT)
+        then raise TTransportExceptionTimedOut.Create('Pipe read timed out');
+
+        if (dwWait <> WAIT_OBJECT_0)
+        or not GetOverlappedResult( FPipe, overlapped.Overlapped, cbRead, TRUE)
+        then raise TTransportExceptionUnknown.Create('Pipe read error');
+      end;
+
+    else
+      raise TTransportExceptionUnknown.Create(SysErrorMessage(dwError));
+    end;
+  end;
+
+  ASSERT( cbRead > 0);  // see TTransportImpl.ReadAll()
+  ASSERT( cbRead = DWORD(count));
+  result := cbRead;
+end;
+
+
+function TPipeStreamBase.ToArray: TBytes;
+var bytes : LongInt;
+begin
+  SetLength( result, 0);
+  bytes := 0;
+
+  if  IsOpen
+  and PeekNamedPipe( FPipe, nil, 0, nil, @bytes, nil)
+  and (bytes > 0)
+  then begin
+    SetLength( result, bytes);
+    Read( result, 0, bytes);
+  end;
+end;
+
+
+{ TNamedPipeStreamImpl }
+
+
+constructor TNamedPipeStreamImpl.Create( const aPipeName : string;
+                                         const aEnableOverlapped : Boolean;
+                                         const aShareMode: DWORD;
+                                         const aSecurityAttributes: PSecurityAttributes;
+                                         const aTimeOut, aOpenTimeOut : DWORD);
+begin
+  inherited Create( aEnableOverlapped, aTimeout, aOpenTimeOut);
+
+  FPipeName        := aPipeName;
+  FShareMode       := aShareMode;
+  FSecurityAttribs := aSecurityAttributes;
+
+  if Copy(FPipeName,1,2) <> '\\'
+  then FPipeName := '\\.\pipe\' + FPipeName;  // assume localhost
+end;
+
+
+procedure TNamedPipeStreamImpl.Open;
+var hPipe    : THandle;
+    retries, timeout, dwErr : DWORD;
+const INTERVAL = 10; // ms
+begin
+  if IsOpen then Exit;
+
+  retries := Max( 1, Round( 1.0 * FOpenTimeOut / INTERVAL));
+  timeout := FOpenTimeOut;
+
+  // if the server hasn't gotten to the point where the pipe has been created, at least wait the timeout
+  // According to MSDN, if no instances of the specified named pipe exist, the WaitNamedPipe function
+  // returns IMMEDIATELY, regardless of the time-out value.
+  // Always use INTERVAL, since WaitNamedPipe(0) defaults to some other value
+  while not WaitNamedPipe( PChar(FPipeName), INTERVAL) do begin
+    dwErr := GetLastError;
+    if dwErr <> ERROR_FILE_NOT_FOUND
+    then raise TTransportExceptionNotOpen.Create('Unable to open pipe, '+SysErrorMessage(dwErr));
+
+    if timeout <> INFINITE then begin
+      if (retries > 0)
+      then Dec(retries)
+      else raise TTransportExceptionNotOpen.Create('Unable to open pipe, timed out');
+    end;
+
+    Sleep(INTERVAL)
+  end;
+
+  // open that thingy
+  hPipe := CreateFile( PChar( FPipeName),
+                       GENERIC_READ or GENERIC_WRITE,
+                       FShareMode,        // sharing
+                       FSecurityAttribs,  // security attributes
+                       OPEN_EXISTING,     // opens existing pipe
+                       FILE_FLAG_OVERLAPPED or FILE_FLAG_WRITE_THROUGH, // async+fast, please
+                       0);                // no template file
+
+  if hPipe = INVALID_HANDLE_VALUE
+  then raise TTransportExceptionNotOpen.Create('Unable to open pipe, '+SysErrorMessage(GetLastError));
+
+  // everything fine
+  FPipe := hPipe;
+end;
+
+
+{ THandlePipeStreamImpl }
+
+
+constructor THandlePipeStreamImpl.Create( const aPipeHandle : THandle;
+                                          const aOwnsHandle, aEnableOverlapped : Boolean;
+                                          const aTimeOut : DWORD);
+begin
+  inherited Create( aEnableOverlapped, aTimeOut);
+
+  if aOwnsHandle
+  then FSrcHandle := aPipeHandle
+  else FSrcHandle := DuplicatePipeHandle( aPipeHandle);
+
+  Open;
+end;
+
+
+destructor THandlePipeStreamImpl.Destroy;
+begin
+  try
+    ClosePipeHandle( FSrcHandle);
+  finally
+    inherited Destroy;
+  end;
+end;
+
+
+procedure THandlePipeStreamImpl.Open;
+begin
+  if not IsOpen
+  then FPipe := DuplicatePipeHandle( FSrcHandle);
+end;
+
+
+{ TPipeTransportBase }
+
+
+function TPipeTransportBase.GetIsOpen: Boolean;
+begin
+  result := (FInputStream <> nil)  and (FInputStream.IsOpen)
+        and (FOutputStream <> nil) and (FOutputStream.IsOpen);
+end;
+
+
+procedure TPipeTransportBase.Open;
+begin
+  FInputStream.Open;
+  FOutputStream.Open;
+end;
+
+
+procedure TPipeTransportBase.Close;
+begin
+  FInputStream.Close;
+  FOutputStream.Close;
+end;
+
+
+{ TNamedPipeTransportClientEndImpl }
+
+
+constructor TNamedPipeTransportClientEndImpl.Create( const aPipeName : string; const aShareMode: DWORD;
+                                   const aSecurityAttributes: PSecurityAttributes;
+                                   const aTimeOut, aOpenTimeOut : DWORD);
+// Named pipe constructor
+begin
+  inherited Create( nil, nil);
+  FInputStream  := TNamedPipeStreamImpl.Create( aPipeName, TRUE, aShareMode, aSecurityAttributes, aTimeOut, aOpenTimeOut);
+  FOutputStream := FInputStream;  // true for named pipes
+end;
+
+
+constructor TNamedPipeTransportClientEndImpl.Create( aPipe : THandle; aOwnsHandle : Boolean;
+                                                     const aTimeOut : DWORD);
+// Named pipe constructor
+begin
+  inherited Create( nil, nil);
+  FInputStream  := THandlePipeStreamImpl.Create( aPipe, TRUE, aOwnsHandle, aTimeOut);
+  FOutputStream := FInputStream;  // true for named pipes
+end;
+
+
+{ TNamedPipeTransportServerEndImpl }
+
+
+constructor TNamedPipeTransportServerEndImpl.Create( aPipe : THandle; aOwnsHandle : Boolean;
+                                                     const aTimeOut : DWORD);
+// Named pipe constructor
+begin
+  FHandle := DuplicatePipeHandle( aPipe);
+  inherited Create( aPipe, aOwnsHandle, aTimeOut);
+end;
+
+
+procedure TNamedPipeTransportServerEndImpl.Close;
+begin
+  FlushFileBuffers( FHandle);
+  DisconnectNamedPipe( FHandle);  // force client off the pipe
+  ClosePipeHandle( FHandle);
+
+  inherited Close;
+end;
+
+
+{ TAnonymousPipeTransportImpl }
+
+
+constructor TAnonymousPipeTransportImpl.Create( const aPipeRead, aPipeWrite : THandle;
+                                                aOwnsHandles : Boolean;
+                                                const aTimeOut : DWORD = DEFAULT_THRIFT_TIMEOUT);
+// Anonymous pipe constructor
+begin
+  inherited Create( nil, nil);
+  // overlapped is not supported with AnonPipes, see MSDN
+  FInputStream  := THandlePipeStreamImpl.Create( aPipeRead, aOwnsHandles, FALSE, aTimeOut);
+  FOutputStream := THandlePipeStreamImpl.Create( aPipeWrite, aOwnsHandles, FALSE, aTimeOut);
+end;
+
+
+{ TPipeServerTransportBase }
+
+
+constructor TPipeServerTransportBase.Create;
+begin
+  inherited Create;
+  FStopServer := TEvent.Create(nil,TRUE,FALSE,'');  // manual reset
+end;
+
+
+destructor TPipeServerTransportBase.Destroy;
+begin
+  try
+    FreeAndNil( FStopServer);
+  finally
+    inherited Destroy;
+  end;
+end;
+
+
+function TPipeServerTransportBase.QueryStopServer : Boolean;
+begin
+  result := (FStopServer = nil)
+         or (FStopServer.WaitFor(0) <> wrTimeout);
+end;
+
+
+procedure TPipeServerTransportBase.Listen;
+begin
+  FStopServer.ResetEvent;
+end;
+
+
+procedure TPipeServerTransportBase.Close;
+begin
+  FStopServer.SetEvent;
+  InternalClose;
+end;
+
+
+{ TAnonymousPipeServerTransportImpl }
+
+
+constructor TAnonymousPipeServerTransportImpl.Create(aBufsize : Cardinal; aTimeOut : DWORD);
+// Anonymous pipe CTOR
+begin
+  inherited Create;
+  FBufsize  := aBufSize;
+  FReadHandle := INVALID_HANDLE_VALUE;
+  FWriteHandle := INVALID_HANDLE_VALUE;
+  FClientAnonRead := INVALID_HANDLE_VALUE;
+  FClientAnonWrite := INVALID_HANDLE_VALUE;
+  FTimeOut := aTimeOut;
+
+  // The anonymous pipe needs to be created first so that the server can
+  // pass the handles on to the client before the serve (acceptImpl)
+  // blocking call.
+  if not CreateAnonPipe
+  then raise TTransportExceptionNotOpen.Create(ClassName+'.Create() failed');
+end;
+
+
+function TAnonymousPipeServerTransportImpl.Accept(const fnAccepting: TProc): ITransport;
+var buf    : Byte;
+    br     : DWORD;
+begin
+  if Assigned(fnAccepting)
+  then fnAccepting();
+
+  // This 0-byte read serves merely as a blocking call.
+  if not ReadFile( FReadHandle, buf, 0, br, nil)
+  and (GetLastError() <> ERROR_MORE_DATA)
+  then raise TTransportExceptionNotOpen.Create('TServerPipe unable to initiate pipe communication');
+
+  // create the transport impl
+  result := TAnonymousPipeTransportImpl.Create( FReadHandle, FWriteHandle, FALSE, FTimeOut);
+end;
+
+
+procedure TAnonymousPipeServerTransportImpl.InternalClose;
+begin
+  ClosePipeHandle( FReadHandle);
+  ClosePipeHandle( FWriteHandle);
+  ClosePipeHandle( FClientAnonRead);
+  ClosePipeHandle( FClientAnonWrite);
+end;
+
+
+function TAnonymousPipeServerTransportImpl.ReadHandle : THandle;
+begin
+  result := FReadHandle;
+end;
+
+
+function TAnonymousPipeServerTransportImpl.WriteHandle : THandle;
+begin
+  result := FWriteHandle;
+end;
+
+
+function TAnonymousPipeServerTransportImpl.ClientAnonRead : THandle;
+begin
+  result := FClientAnonRead;
+end;
+
+
+function TAnonymousPipeServerTransportImpl.ClientAnonWrite  : THandle;
+begin
+  result := FClientAnonWrite;
+end;
+
+
+function TAnonymousPipeServerTransportImpl.CreateAnonPipe : Boolean;
+var sd           : PSECURITY_DESCRIPTOR;
+    sa           : SECURITY_ATTRIBUTES; //TSecurityAttributes;
+    hCAR, hPipeW, hCAW, hPipe : THandle;
+begin
+  result := FALSE;
+
+  sd := PSECURITY_DESCRIPTOR( LocalAlloc( LPTR,SECURITY_DESCRIPTOR_MIN_LENGTH));
+  try
+    Win32Check( InitializeSecurityDescriptor( sd, SECURITY_DESCRIPTOR_REVISION));
+    Win32Check( SetSecurityDescriptorDacl( sd, TRUE, nil, FALSE));
+
+    sa.nLength := sizeof( sa);
+    sa.lpSecurityDescriptor := sd;
+    sa.bInheritHandle       := TRUE; //allow passing handle to child
+
+    if not CreatePipe( hCAR, hPipeW, @sa, FBufSize) then begin   //create stdin pipe
+      raise TTransportExceptionNotOpen.Create('TServerPipe CreatePipe (anon) failed, '+SysErrorMessage(GetLastError));
+      Exit;
+    end;
+
+    if not CreatePipe( hPipe, hCAW, @sa, FBufSize) then begin  //create stdout pipe
+      CloseHandle( hCAR);
+      CloseHandle( hPipeW);
+      raise TTransportExceptionNotOpen.Create('TServerPipe CreatePipe (anon) failed, '+SysErrorMessage(GetLastError));
+      Exit;
+    end;
+
+    FClientAnonRead  := hCAR;
+    FClientAnonWrite := hCAW;
+    FReadHandle      := hPipe;
+    FWriteHandle     := hPipeW;
+
+    result := TRUE;
+
+  finally
+    if sd <> nil then LocalFree( Cardinal(sd));
+  end;
+end;
+
+
+{ TNamedPipeServerTransportImpl }
+
+
+constructor TNamedPipeServerTransportImpl.Create( aPipename : string; aBufsize, aMaxConns, aTimeOut : Cardinal);
+// Named Pipe CTOR
+begin
+  inherited Create;
+  ASSERT( aTimeout > 0);
+  FPipeName  := aPipename;
+  FBufsize   := aBufSize;
+  FMaxConns  := Max( 1, Min( PIPE_UNLIMITED_INSTANCES, aMaxConns));
+  FHandle    := INVALID_HANDLE_VALUE;
+  FTimeout   := aTimeOut;
+  FConnected := FALSE;
+
+  if Copy(FPipeName,1,2) <> '\\'
+  then FPipeName := '\\.\pipe\' + FPipeName;  // assume localhost
+end;
+
+
+function TNamedPipeServerTransportImpl.Accept(const fnAccepting: TProc): ITransport;
+var dwError, dwWait, dwDummy : DWORD;
+    overlapped : IOverlappedHelper;
+    handles : array[0..1] of THandle;
+begin
+  overlapped := TOverlappedHelperImpl.Create;
+
+  ASSERT( not FConnected);
+  CreateNamedPipe;
+  while not FConnected do begin
+
+    if QueryStopServer
+    then Abort;
+
+    if Assigned(fnAccepting)
+    then fnAccepting();
+
+    // Wait for the client to connect; if it succeeds, the
+    // function returns a nonzero value. If the function returns
+    // zero, GetLastError should return ERROR_PIPE_CONNECTED.
+    if ConnectNamedPipe( Handle, overlapped.OverlappedPtr) then begin
+      FConnected := TRUE;
+      Break;
+    end;
+
+    // ConnectNamedPipe() returns FALSE for OverlappedIO, even if connected.
+    // We have to check GetLastError() explicitly to find out
+    dwError := GetLastError;
+    case dwError of
+      ERROR_PIPE_CONNECTED : begin
+        FConnected := not QueryStopServer;  // special case: pipe immediately connected
+      end;
+
+      ERROR_IO_PENDING : begin
+        handles[0] := overlapped.WaitHandle;
+        handles[1] := FStopServer.Handle;
+        dwWait := WaitForMultipleObjects( 2, @handles, FALSE, FTimeout);
+        FConnected := (dwWait = WAIT_OBJECT_0)
+                  and GetOverlappedResult( Handle, overlapped.Overlapped, dwDummy, TRUE)
+                  and not QueryStopServer;
+      end;
+
+    else
+      InternalClose;
+      raise TTransportExceptionNotOpen.Create('Client connection failed');
+    end;
+  end;
+
+  // create the transport impl
+  result := CreateTransportInstance;
+end;
+
+
+function TNamedPipeServerTransportImpl.CreateTransportInstance : ITransport;
+// create the transport impl
+var hPipe : THandle;
+begin
+  hPipe := THandle( InterlockedExchangePointer( Pointer(FHandle), Pointer(INVALID_HANDLE_VALUE)));
+  try
+    FConnected := FALSE;
+    result := TNamedPipeTransportServerEndImpl.Create( hPipe, TRUE, FTimeout);
+  except
+    ClosePipeHandle(hPipe);
+    raise;
+  end;
+end;
+
+
+procedure TNamedPipeServerTransportImpl.InternalClose;
+var hPipe : THandle;
+begin
+  hPipe := THandle( InterlockedExchangePointer( Pointer(FHandle), Pointer(INVALID_HANDLE_VALUE)));
+  if hPipe = INVALID_HANDLE_VALUE then Exit;
+
+  try
+    if FConnected
+    then FlushFileBuffers( hPipe)
+    else CancelIo( hPipe);
+    DisconnectNamedPipe( hPipe);
+  finally
+    ClosePipeHandle( hPipe);
+    FConnected := FALSE;
+  end;
+end;
+
+
+function TNamedPipeServerTransportImpl.Handle : THandle;
+begin
+  {$IFDEF WIN64}
+  result := THandle( InterlockedExchangeAdd64( Int64(FHandle), 0));
+  {$ELSE}
+  result := THandle( InterlockedExchangeAdd( Integer(FHandle), 0));
+  {$ENDIF}
+end;
+
+
+function TNamedPipeServerTransportImpl.CreateNamedPipe : THandle;
+var SIDAuthWorld : SID_IDENTIFIER_AUTHORITY ;
+    everyone_sid : PSID;
+    ea           : EXPLICIT_ACCESS;
+    acl          : PACL;
+    sd           : PSECURITY_DESCRIPTOR;
+    sa           : SECURITY_ATTRIBUTES;
+const
+  SECURITY_WORLD_SID_AUTHORITY  : TSIDIdentifierAuthority = (Value : (0,0,0,0,0,1));
+  SECURITY_WORLD_RID = $00000000;
+begin
+  sd := nil;
+  everyone_sid := nil;
+  try
+    ASSERT( (FHandle = INVALID_HANDLE_VALUE) and not FConnected);
+
+    // Windows - set security to allow non-elevated apps
+    // to access pipes created by elevated apps.
+    SIDAuthWorld := SECURITY_WORLD_SID_AUTHORITY;
+    AllocateAndInitializeSid( SIDAuthWorld, 1, SECURITY_WORLD_RID, 0, 0, 0, 0, 0, 0, 0, everyone_sid);
+
+    ZeroMemory( @ea, SizeOf(ea));
+    ea.grfAccessPermissions := GENERIC_ALL; //SPECIFIC_RIGHTS_ALL or STANDARD_RIGHTS_ALL;
+    ea.grfAccessMode        := SET_ACCESS;
+    ea.grfInheritance       := NO_INHERITANCE;
+    ea.Trustee.TrusteeForm  := TRUSTEE_IS_SID;
+    ea.Trustee.TrusteeType  := TRUSTEE_IS_WELL_KNOWN_GROUP;
+    ea.Trustee.ptstrName    := PChar(everyone_sid);
+
+    acl := nil;
+    SetEntriesInAcl( 1, @ea, nil, acl);
+
+    sd := PSECURITY_DESCRIPTOR( LocalAlloc( LPTR,SECURITY_DESCRIPTOR_MIN_LENGTH));
+    Win32Check( InitializeSecurityDescriptor( sd, SECURITY_DESCRIPTOR_REVISION));
+    Win32Check( SetSecurityDescriptorDacl( sd, TRUE, acl, FALSE));
+
+    sa.nLength := SizeOf(sa);
+    sa.lpSecurityDescriptor := sd;
+    sa.bInheritHandle       := FALSE;
+
+    // Create an instance of the named pipe
+    {$IFDEF OLD_UNIT_NAMES}
+    result := Windows.CreateNamedPipe(
+    {$ELSE}
+    result := Winapi.Windows.CreateNamedPipe(
+    {$ENDIF}
+        PChar( FPipeName),        // pipe name
+        PIPE_ACCESS_DUPLEX or     // read/write access
+        FILE_FLAG_OVERLAPPED,     // async mode
+        PIPE_TYPE_BYTE or         // byte type pipe
+        PIPE_READMODE_BYTE,       // byte read mode
+        FMaxConns,                // max. instances
+        FBufSize,                 // output buffer size
+        FBufSize,                 // input buffer size
+        FTimeout,                 // time-out, see MSDN
+        @sa                       // default security attribute
+    );
+
+    if( result <> INVALID_HANDLE_VALUE)
+    then InterlockedExchangePointer( Pointer(FHandle), Pointer(result))
+    else raise TTransportExceptionNotOpen.Create('CreateNamedPipe() failed ' + IntToStr(GetLastError));
+
+  finally
+    if sd <> nil then LocalFree( Cardinal( sd));
+    if acl <> nil then LocalFree( Cardinal( acl));
+    if everyone_sid <> nil then FreeSid(everyone_sid);
+  end;
+end;
+
+
+
+end.
+
+
+

vendor/git.apache.org/thrift.git/lib/delphi/src/Thrift.TypeRegistry.pas

@@ -0,0 +1,95 @@
+(*
+ * 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 Thrift.TypeRegistry;
+
+interface
+
+uses
+  Generics.Collections, TypInfo,
+  Thrift.Protocol;
+
+type
+  TFactoryMethod<T> = function:T;
+
+  TypeRegistry = class
+  private
+    class var FTypeInfoToFactoryLookup : TDictionary<Pointer, Pointer>;
+  public
+    class constructor Create;
+    class destructor Destroy;
+    class procedure RegisterTypeFactory<F>(const aFactoryMethod: TFactoryMethod<F>);
+    class function  Construct<F>: F;
+    class function  ConstructFromTypeInfo(const aTypeInfo: PTypeInfo): IBase;
+  end;
+
+implementation
+
+
+{ TypeRegistration }
+
+class constructor TypeRegistry.Create;
+begin
+  FTypeInfoToFactoryLookup := TDictionary<Pointer, Pointer>.Create;
+end;
+
+class destructor TypeRegistry.Destroy;
+begin
+  FTypeInfoToFactoryLookup.Free;
+end;
+
+class procedure TypeRegistry.RegisterTypeFactory<F>(const aFactoryMethod: TFactoryMethod<F>);
+var
+  TypeInfo     : Pointer;
+begin
+  TypeInfo := System.TypeInfo(F);
+
+  if (TypeInfo <> nil) and (PTypeInfo(TypeInfo).Kind = tkInterface)
+  then FTypeInfoToFactoryLookup.AddOrSetValue(TypeInfo, @aFactoryMethod);
+end;
+
+class function TypeRegistry.Construct<F>: F;
+var
+  TypeInfo     : PTypeInfo;
+  Factory      : Pointer;
+begin
+  Result := default(F);
+
+  TypeInfo := System.TypeInfo(F);
+
+  if Assigned(TypeInfo) and (TypeInfo.Kind = tkInterface)
+  then begin
+    if FTypeInfoToFactoryLookup.TryGetValue(TypeInfo, Factory)
+    then Result := TFactoryMethod<F>(Factory)();
+  end;
+end;
+
+class function TypeRegistry.ConstructFromTypeInfo(const aTypeInfo: PTypeInfo): IBase;
+var
+  Factory      : Pointer;
+begin
+  Result := nil;
+  if FTypeInfoToFactoryLookup.TryGetValue(aTypeInfo, Factory)
+  then Result := IBase(TFactoryMethod<IBase>(Factory)());
+end;
+
+
+
+
+end.

vendor/git.apache.org/thrift.git/lib/delphi/src/Thrift.Utils.pas

@@ -0,0 +1,244 @@
+(*
+ * 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 Thrift.Utils;
+
+interface
+
+{$I Thrift.Defines.inc}
+
+uses
+  {$IFDEF OLD_UNIT_NAMES}
+  Classes, Windows, SysUtils, Character, SyncObjs;
+  {$ELSE}
+  System.Classes, Winapi.Windows, System.SysUtils, System.Character, System.SyncObjs;
+  {$ENDIF}
+
+type
+  IOverlappedHelper = interface
+    ['{A1832EFA-2E02-4884-8F09-F0A0277157FA}']
+    function Overlapped : TOverlapped;
+    function OverlappedPtr : POverlapped;
+    function WaitHandle : THandle;
+    function WaitFor(dwTimeout: DWORD) : DWORD;
+  end;
+
+  TOverlappedHelperImpl = class( TInterfacedObject, IOverlappedHelper)
+  strict protected
+    FOverlapped : TOverlapped;
+    FEvent      : TEvent;
+
+    // IOverlappedHelper
+    function Overlapped : TOverlapped;
+    function OverlappedPtr : POverlapped;
+    function WaitHandle : THandle;
+    function WaitFor(dwTimeout: DWORD) : DWORD;
+  public
+    constructor Create;
+    destructor Destroy;  override;
+  end;
+
+
+  Base64Utils = class sealed
+  public
+    class function Encode( const src : TBytes; srcOff, len : Integer; dst : TBytes; dstOff : Integer) : Integer; static;
+    class function Decode( const src : TBytes; srcOff, len : Integer; dst : TBytes; dstOff : Integer) : Integer; static;
+  end;
+
+
+  CharUtils = class sealed
+  public
+    class function IsHighSurrogate( const c : Char) : Boolean; static; inline;
+    class function IsLowSurrogate( const c : Char) : Boolean; static; inline;
+  end;
+
+
+function InterlockedCompareExchange64( var Target : Int64; Exchange, Comparand : Int64) : Int64; stdcall;
+function InterlockedExchangeAdd64( var Addend : Int64; Value : Int64) : Int64; stdcall;
+
+
+implementation
+
+{ TOverlappedHelperImpl }
+
+constructor TOverlappedHelperImpl.Create;
+begin
+  inherited Create;
+  FillChar( FOverlapped, SizeOf(FOverlapped), 0);
+  FEvent := TEvent.Create( nil, TRUE, FALSE, '');  // always ManualReset, see MSDN
+  FOverlapped.hEvent := FEvent.Handle;
+end;
+
+
+
+destructor TOverlappedHelperImpl.Destroy;
+begin
+  try
+    FOverlapped.hEvent := 0;
+    FreeAndNil( FEvent);
+
+  finally
+    inherited Destroy;
+  end;
+
+end;
+
+
+function TOverlappedHelperImpl.Overlapped : TOverlapped;
+begin
+  result := FOverlapped;
+end;
+
+
+function TOverlappedHelperImpl.OverlappedPtr : POverlapped;
+begin
+  result := @FOverlapped;
+end;
+
+
+function TOverlappedHelperImpl.WaitHandle : THandle;
+begin
+  result := FOverlapped.hEvent;
+end;
+
+
+function TOverlappedHelperImpl.WaitFor( dwTimeout : DWORD) : DWORD;
+begin
+  result := WaitForSingleObject( FOverlapped.hEvent, dwTimeout);
+end;
+
+
+{ Base64Utils }
+
+class function Base64Utils.Encode( const src : TBytes; srcOff, len : Integer; dst : TBytes; dstOff : Integer) : Integer;
+const ENCODE_TABLE : PAnsiChar = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
+begin
+  ASSERT( len in [1..3]);
+  dst[dstOff] := Byte( ENCODE_TABLE[ (src[srcOff] shr 2) and $3F]);
+  case len of
+    3 : begin
+      Inc(dstOff);
+      dst[dstOff] := Byte( ENCODE_TABLE[ ((src[srcOff] shl 4) and $30) or ((src[srcOff + 1] shr 4) and $0F)]);
+      Inc(dstOff);
+      dst[dstOff] := Byte( ENCODE_TABLE[ ((src[srcOff + 1] shl 2) and $3C) or ((src[srcOff + 2] shr 6) and $03)]);
+      Inc(dstOff);
+      dst[dstOff] := Byte( ENCODE_TABLE[ src[srcOff + 2] and $3F]);
+      result := 4;
+    end;
+
+    2 : begin
+      Inc(dstOff);
+      dst[dstOff] := Byte( ENCODE_TABLE[ ((src[srcOff] shl 4) and $30) or ((src[srcOff + 1] shr 4) and $0F)]);
+      Inc(dstOff);
+      dst[dstOff] := Byte( ENCODE_TABLE[ (src[srcOff + 1] shl 2) and $3C]);
+      result := 3;
+    end;
+
+    1 : begin
+      Inc(dstOff);
+      dst[dstOff] := Byte( ENCODE_TABLE[ (src[srcOff] shl 4) and $30]);
+      result := 2;
+    end;
+
+  else
+    ASSERT( FALSE);
+    result := 0;  // because invalid call
+  end;
+end;
+
+
+class function Base64Utils.Decode( const src : TBytes; srcOff, len : Integer; dst : TBytes; dstOff : Integer) : Integer;
+const DECODE_TABLE : array[0..$FF] of Integer
+                   = ( -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+                       -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+                       -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,62,-1,-1,-1,63,
+                       52,53,54,55,56,57,58,59,60,61,-1,-1,-1,-1,-1,-1,
+                       -1, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9,10,11,12,13,14,
+                       15,16,17,18,19,20,21,22,23,24,25,-1,-1,-1,-1,-1,
+                       -1,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,
+                       41,42,43,44,45,46,47,48,49,50,51,-1,-1,-1,-1,-1,
+                       -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+                       -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+                       -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+                       -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+                       -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+                       -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+                       -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
+                       -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1  );
+begin
+  ASSERT( len in [1..4]);
+  result := 1;
+  dst[dstOff] := ((DECODE_TABLE[src[srcOff]     and $0FF] shl 2)
+              or  (DECODE_TABLE[src[srcOff + 1] and $0FF] shr 4));
+
+  if (len > 2) then begin
+    Inc( result);
+    Inc( dstOff);
+    dst[dstOff] := (((DECODE_TABLE[src[srcOff + 1] and $0FF] shl 4) and $F0)
+                or   (DECODE_TABLE[src[srcOff + 2] and $0FF] shr 2));
+
+    if (len > 3) then begin
+      Inc( result);
+      Inc( dstOff);
+      dst[dstOff] := (((DECODE_TABLE[src[srcOff + 2] and $0FF] shl 6) and $C0)
+                  or    DECODE_TABLE[src[srcOff + 3] and $0FF]);
+    end;
+  end;
+end;
+
+
+class function CharUtils.IsHighSurrogate( const c : Char) : Boolean;
+begin
+  {$IF CompilerVersion < 23.0}
+  result := Character.IsHighSurrogate( c);
+  {$ELSE}
+  result := c.IsHighSurrogate();
+  {$IFEND}
+end;
+
+
+class function CharUtils.IsLowSurrogate( const c : Char) : Boolean;
+begin
+  {$IF CompilerVersion < 23.0}
+  result := Character.IsLowSurrogate( c);
+  {$ELSE}
+  result := c.IsLowSurrogate;
+  {$IFEND}
+end;
+
+
+// natively available since stone age
+function InterlockedCompareExchange64;
+external KERNEL32 name 'InterlockedCompareExchange64';
+
+
+// natively available >= Vista
+// implemented this way since there are still some people running Windows XP :-(
+function InterlockedExchangeAdd64( var Addend : Int64; Value : Int64) : Int64; stdcall;
+var old : Int64;
+begin
+  repeat
+    Old := Addend;
+  until (InterlockedCompareExchange64( Addend, Old + Value, Old) = Old);
+  result := Old;
+end;
+
+
+
+end.

vendor/git.apache.org/thrift.git/lib/delphi/src/Thrift.pas

@@ -0,0 +1,258 @@
+(*
+ * 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 Thrift;
+
+interface
+
+uses
+  SysUtils, Thrift.Protocol;
+
+const
+  Version = '0.10.0';
+
+type
+  TApplicationExceptionSpecializedClass = class of TApplicationExceptionSpecialized;
+
+  TApplicationException = class( SysUtils.Exception )
+  public
+    type
+{$SCOPEDENUMS ON}
+      TExceptionType = (
+        Unknown,
+        UnknownMethod,
+        InvalidMessageType,
+        WrongMethodName,
+        BadSequenceID,
+        MissingResult,
+        InternalError,
+        ProtocolError,
+        InvalidTransform,
+        InvalidProtocol,
+        UnsupportedClientType
+      );
+{$SCOPEDENUMS OFF}
+  private
+    function GetType: TExceptionType;
+  protected
+    constructor HiddenCreate(const Msg: string);
+  public
+    // purposefully hide inherited constructor
+    class function Create(const Msg: string): TApplicationException; overload; deprecated 'Use specialized TApplicationException types (or regenerate from IDL)';
+    class function Create: TApplicationException; overload; deprecated 'Use specialized TApplicationException types (or regenerate from IDL)';
+    class function Create( AType: TExceptionType): TApplicationException; overload; deprecated 'Use specialized TApplicationException types (or regenerate from IDL)';
+    class function Create( AType: TExceptionType; const msg: string): TApplicationException; overload; deprecated 'Use specialized TApplicationException types (or regenerate from IDL)';
+
+    class function GetSpecializedExceptionType(AType: TExceptionType): TApplicationExceptionSpecializedClass;
+
+    class function Read( const iprot: IProtocol): TApplicationException;
+    procedure Write( const oprot: IProtocol );
+  end;
+
+  // Needed to remove deprecation warning
+  TApplicationExceptionSpecialized = class abstract (TApplicationException)
+  public
+    constructor Create(const Msg: string);
+  end;
+
+  TApplicationExceptionUnknown = class (TApplicationExceptionSpecialized);
+  TApplicationExceptionUnknownMethod = class (TApplicationExceptionSpecialized);
+  TApplicationExceptionInvalidMessageType = class (TApplicationExceptionSpecialized);
+  TApplicationExceptionWrongMethodName = class (TApplicationExceptionSpecialized);
+  TApplicationExceptionBadSequenceID = class (TApplicationExceptionSpecialized);
+  TApplicationExceptionMissingResult = class (TApplicationExceptionSpecialized);
+  TApplicationExceptionInternalError = class (TApplicationExceptionSpecialized);
+  TApplicationExceptionProtocolError = class (TApplicationExceptionSpecialized);
+  TApplicationExceptionInvalidTransform = class (TApplicationExceptionSpecialized);
+  TApplicationExceptionInvalidProtocol = class (TApplicationExceptionSpecialized);
+  TApplicationExceptionUnsupportedClientType = class (TApplicationExceptionSpecialized);
+
+  // base class for IDL-generated exceptions
+  TException = class( SysUtils.Exception)
+  public
+    function Message : string;        // hide inherited property: allow read, but prevent accidental writes
+    procedure UpdateMessageProperty;  // update inherited message property with toString()
+  end;
+
+implementation
+
+{ TException }
+
+function TException.Message;
+// allow read (exception summary), but prevent accidental writes
+// read will return the exception summary
+begin
+  result := Self.ToString;
+end;
+
+procedure TException.UpdateMessageProperty;
+// Update the inherited Message property to better conform to standard behaviour.
+// Nice benefit: The IDE is now able to show the exception message again.
+begin
+  inherited Message := Self.ToString;  // produces a summary text
+end;
+
+{ TApplicationException }
+
+function TApplicationException.GetType: TExceptionType;
+begin
+  if Self is TApplicationExceptionUnknownMethod then Result := TExceptionType.UnknownMethod
+  else if Self is TApplicationExceptionInvalidMessageType then Result := TExceptionType.InvalidMessageType
+  else if Self is TApplicationExceptionWrongMethodName then Result := TExceptionType.WrongMethodName
+  else if Self is TApplicationExceptionBadSequenceID then Result := TExceptionType.BadSequenceID
+  else if Self is TApplicationExceptionMissingResult then Result := TExceptionType.MissingResult
+  else if Self is TApplicationExceptionInternalError then Result := TExceptionType.InternalError
+  else if Self is TApplicationExceptionProtocolError then Result := TExceptionType.ProtocolError
+  else if Self is TApplicationExceptionInvalidTransform then Result := TExceptionType.InvalidTransform
+  else if Self is TApplicationExceptionInvalidProtocol then Result := TExceptionType.InvalidProtocol
+  else if Self is TApplicationExceptionUnsupportedClientType then Result := TExceptionType.UnsupportedClientType
+  else Result := TExceptionType.Unknown;
+end;
+
+constructor TApplicationException.HiddenCreate(const Msg: string);
+begin
+  inherited Create(Msg);
+end;
+
+class function TApplicationException.Create(const Msg: string): TApplicationException;
+begin
+  Result := TApplicationExceptionUnknown.Create(Msg);
+end;
+
+class function TApplicationException.Create: TApplicationException;
+begin
+  Result := TApplicationExceptionUnknown.Create('');
+end;
+
+class function TApplicationException.Create( AType: TExceptionType): TApplicationException;
+begin
+{$WARN SYMBOL_DEPRECATED OFF}
+  Result := Create(AType, '');
+{$WARN SYMBOL_DEPRECATED DEFAULT}
+end;
+
+class function TApplicationException.Create( AType: TExceptionType; const msg: string): TApplicationException;
+begin
+  Result := GetSpecializedExceptionType(AType).Create(msg);
+end;
+
+class function TApplicationException.GetSpecializedExceptionType(AType: TExceptionType): TApplicationExceptionSpecializedClass;
+begin
+  case AType of
+    TExceptionType.UnknownMethod:         Result := TApplicationExceptionUnknownMethod;
+    TExceptionType.InvalidMessageType:    Result := TApplicationExceptionInvalidMessageType;
+    TExceptionType.WrongMethodName:       Result := TApplicationExceptionWrongMethodName;
+    TExceptionType.BadSequenceID:         Result := TApplicationExceptionBadSequenceID;
+    TExceptionType.MissingResult:         Result := TApplicationExceptionMissingResult;
+    TExceptionType.InternalError:         Result := TApplicationExceptionInternalError;
+    TExceptionType.ProtocolError:         Result := TApplicationExceptionProtocolError;
+    TExceptionType.InvalidTransform:      Result := TApplicationExceptionInvalidTransform;
+    TExceptionType.InvalidProtocol:       Result := TApplicationExceptionInvalidProtocol;
+    TExceptionType.UnsupportedClientType: Result := TApplicationExceptionUnsupportedClientType;
+  else
+    Result := TApplicationExceptionUnknown;
+  end;
+end;
+
+class function TApplicationException.Read( const iprot: IProtocol): TApplicationException;
+var
+  field : IField;
+  msg : string;
+  typ : TExceptionType;
+  struc : IStruct;
+begin
+  msg := '';
+  typ := TExceptionType.Unknown;
+  struc := iprot.ReadStructBegin;
+  while ( True ) do
+  begin
+    field := iprot.ReadFieldBegin;
+    if ( field.Type_ = TType.Stop) then
+    begin
+      Break;
+    end;
+
+    case field.Id of
+      1 : begin
+        if ( field.Type_ = TType.String_) then
+        begin
+          msg := iprot.ReadString;
+        end else
+        begin
+          TProtocolUtil.Skip( iprot, field.Type_ );
+        end;
+      end;
+
+      2 : begin
+        if ( field.Type_ = TType.I32) then
+        begin
+          typ := TExceptionType( iprot.ReadI32 );
+        end else
+        begin
+          TProtocolUtil.Skip( iprot, field.Type_ );
+        end;
+      end else
+      begin
+        TProtocolUtil.Skip( iprot, field.Type_);
+      end;
+    end;
+    iprot.ReadFieldEnd;
+  end;
+  iprot.ReadStructEnd;
+  Result := GetSpecializedExceptionType(typ).Create(msg);
+end;
+
+procedure TApplicationException.Write( const oprot: IProtocol);
+var
+  struc : IStruct;
+  field : IField;
+
+begin
+  struc := TStructImpl.Create( 'TApplicationException' );
+  field := TFieldImpl.Create;
+
+  oprot.WriteStructBegin( struc );
+  if Message <> '' then
+  begin
+    field.Name := 'message';
+    field.Type_ := TType.String_;
+    field.Id := 1;
+    oprot.WriteFieldBegin( field );
+    oprot.WriteString( Message );
+    oprot.WriteFieldEnd;
+  end;
+
+  field.Name := 'type';
+  field.Type_ := TType.I32;
+  field.Id := 2;
+  oprot.WriteFieldBegin(field);
+  oprot.WriteI32(Integer(GetType));
+  oprot.WriteFieldEnd();
+  oprot.WriteFieldStop();
+  oprot.WriteStructEnd();
+end;
+
+{ TApplicationExceptionSpecialized }
+
+constructor TApplicationExceptionSpecialized.Create(const Msg: string);
+begin
+  inherited HiddenCreate(Msg);
+end;
+
+end.

vendor/git.apache.org/thrift.git/lib/delphi/test/TestConstants.pas

@@ -0,0 +1,162 @@
+(*
+ * 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 TestConstants;
+
+interface
+
+uses SysUtils;
+
+type
+  TKnownProtocol = (
+    prot_Binary,  // default binary protocol
+    prot_JSON,    // JSON protocol
+    prot_Compact
+  );
+
+  TServerType = (
+    srv_Simple,
+    srv_Nonblocking,
+    srv_Threadpool,
+    srv_Threaded
+  );
+
+  TEndpointTransport = (
+    trns_Sockets,
+    trns_Http,
+    trns_NamedPipes,
+    trns_AnonPipes,
+    trns_EvHttp  // as listed on http://thrift.apache.org/test
+  );
+
+  TLayeredTransport = (
+    trns_Buffered,
+    trns_Framed
+  );
+
+  TLayeredTransports = set of TLayeredTransport;
+
+const
+  SERVER_TYPES : array[TServerType] of string
+                  = ('Simple', 'Nonblocking', 'Threadpool', 'Threaded');
+
+  THRIFT_PROTOCOLS : array[TKnownProtocol] of string
+                  = ('Binary', 'JSON', 'Compact');
+
+  LAYERED_TRANSPORTS : array[TLayeredTransport] of string
+                  = ('Buffered', 'Framed');
+
+  ENDPOINT_TRANSPORTS : array[TEndpointTransport] of string
+                  = ('Sockets', 'Http', 'Named Pipes','Anon Pipes', 'EvHttp');
+
+  // defaults are: read=false, write=true
+  BINARY_STRICT_READ  = FALSE;
+  BINARY_STRICT_WRITE = FALSE;
+
+  HUGE_TEST_STRING = 'Lorem ipsum dolor sit amet, consetetur sadipscing elitr, sed diam nonumy '
+                   + 'eirmod tempor invidunt ut labore et dolore magna aliquyam erat, sed diam '
+                   + 'voluptua. At vero eos et accusam et justo duo dolores et ea rebum. Stet '
+                   + 'clita kasd gubergren, no sea takimata sanctus est Lorem ipsum dolor sit '
+                   + 'amet. Lorem ipsum dolor sit amet, consetetur sadipscing elitr, sed diam '
+                   + 'nonumy eirmod tempor invidunt ut labore et dolore magna aliquyam erat, sed '
+                   + 'diam voluptua. At vero eos et accusam et justo duo dolores et ea rebum. Stet '
+                   + 'clita kasd gubergren, no sea takimata sanctus est Lorem ipsum dolor sit amet. '
+                   + 'Lorem ipsum dolor sit amet, consetetur sadipscing elitr, sed diam nonumy '
+                   + 'eirmod tempor invidunt ut labore et dolore magna aliquyam erat, sed diam '
+                   + 'voluptua. At vero eos et accusam et justo duo dolores et ea rebum. Stet '
+                   + 'clita kasd gubergren, no sea takimata sanctus est Lorem ipsum dolor sit '
+                   + 'amet. Lorem ipsum dolor sit amet, consetetur sadipscing elitr, sed diam '
+                   + 'nonumy eirmod tempor invidunt ut labore et dolore magna aliquyam erat, sed '
+                   + 'diam voluptua. At vero eos et accusam et justo duo dolores et ea rebum. Stet '
+                   + 'clita kasd gubergren, no sea takimata sanctus est Lorem ipsum dolor sit amet. '
+                   + 'Lorem ipsum dolor sit amet, consetetur sadipscing elitr, sed diam nonumy '
+                   + 'eirmod tempor invidunt ut labore et dolore magna aliquyam erat, sed diam '
+                   + 'voluptua. At vero eos et accusam et justo duo dolores et ea rebum. Stet '
+                   + 'clita kasd gubergren, no sea takimata sanctus est Lorem ipsum dolor sit '
+                   + 'amet. Lorem ipsum dolor sit amet, consetetur sadipscing elitr, sed diam '
+                   + 'nonumy eirmod tempor invidunt ut labore et dolore magna aliquyam erat, sed '
+                   + 'diam voluptua. At vero eos et accusam et justo duo dolores et ea rebum. Stet '
+                   + 'clita kasd gubergren, no sea takimata sanctus est Lorem ipsum dolor sit amet. '
+                   + 'Lorem ipsum dolor sit amet, consetetur sadipscing elitr, sed diam nonumy '
+                   + 'eirmod tempor invidunt ut labore et dolore magna aliquyam erat, sed diam '
+                   + 'voluptua. At vero eos et accusam et justo duo dolores et ea rebum. Stet '
+                   + 'clita kasd gubergren, no sea takimata sanctus est Lorem ipsum dolor sit '
+                   + 'amet. Lorem ipsum dolor sit amet, consetetur sadipscing elitr, sed diam '
+                   + 'nonumy eirmod tempor invidunt ut labore et dolore magna aliquyam erat, sed '
+                   + 'diam voluptua. At vero eos et accusam et justo duo dolores et ea rebum. Stet '
+                   + 'clita kasd gubergren, no sea takimata sanctus est Lorem ipsum dolor sit amet. '
+                   + 'Lorem ipsum dolor sit amet, consetetur sadipscing elitr, sed diam nonumy '
+                   + 'eirmod tempor invidunt ut labore et dolore magna aliquyam erat, sed diam '
+                   + 'voluptua. At vero eos et accusam et justo duo dolores et ea rebum. Stet '
+                   + 'clita kasd gubergren, no sea takimata sanctus est Lorem ipsum dolor sit '
+                   + 'amet. Lorem ipsum dolor sit amet, consetetur sadipscing elitr, sed diam '
+                   + 'nonumy eirmod tempor invidunt ut labore et dolore magna aliquyam erat, sed '
+                   + 'diam voluptua. At vero eos et accusam et justo duo dolores et ea rebum. Stet '
+                   + 'clita kasd gubergren, no sea takimata sanctus est Lorem ipsum dolor sit amet. '
+                   + 'Lorem ipsum dolor sit amet, consetetur sadipscing elitr, sed diam nonumy '
+                   + 'eirmod tempor invidunt ut labore et dolore magna aliquyam erat, sed diam '
+                   + 'voluptua. At vero eos et accusam et justo duo dolores et ea rebum. Stet '
+                   + 'clita kasd gubergren, no sea takimata sanctus est Lorem ipsum dolor sit '
+                   + 'amet. Lorem ipsum dolor sit amet, consetetur sadipscing elitr, sed diam '
+                   + 'nonumy eirmod tempor invidunt ut labore et dolore magna aliquyam erat, sed '
+                   + 'diam voluptua. At vero eos et accusam et justo duo dolores et ea rebum. Stet '
+                   + 'clita kasd gubergren, no sea takimata sanctus est Lorem ipsum dolor sit amet. '
+                   + 'Lorem ipsum dolor sit amet, consetetur sadipscing elitr, sed diam nonumy '
+                   + 'eirmod tempor invidunt ut labore et dolore magna aliquyam erat, sed diam '
+                   + 'voluptua. At vero eos et accusam et justo duo dolores et ea rebum. Stet '
+                   + 'clita kasd gubergren, no sea takimata sanctus est Lorem ipsum dolor sit '
+                   + 'amet. Lorem ipsum dolor sit amet, consetetur sadipscing elitr, sed diam '
+                   + 'nonumy eirmod tempor invidunt ut labore et dolore magna aliquyam erat, sed '
+                   + 'diam voluptua. At vero eos et accusam et justo duo dolores et ea rebum. Stet '
+                   + 'clita kasd gubergren, no sea takimata sanctus est Lorem ipsum dolor sit amet. '
+                   + 'Lorem ipsum dolor sit amet, consetetur sadipscing elitr, sed diam nonumy '
+                   + 'eirmod tempor invidunt ut labore et dolore magna aliquyam erat, sed diam '
+                   + 'voluptua. At vero eos et accusam et justo duo dolores et ea rebum. Stet '
+                   + 'clita kasd gubergren, no sea takimata sanctus est Lorem ipsum dolor sit '
+                   + 'amet. Lorem ipsum dolor sit amet, consetetur sadipscing elitr, sed diam '
+                   + 'nonumy eirmod tempor invidunt ut labore et dolore magna aliquyam erat, sed '
+                   + 'diam voluptua. At vero eos et accusam et justo duo dolores et ea rebum. Stet '
+                   + 'clita kasd gubergren, no sea takimata sanctus est Lorem ipsum dolor sit amet. '
+                   + 'Lorem ipsum dolor sit amet, consetetur sadipscing elitr, sed diam nonumy '
+                   + 'eirmod tempor invidunt ut labore et dolore magna aliquyam erat, sed diam '
+                   + 'voluptua. At vero eos et accusam et justo duo dolores et ea rebum. Stet '
+                   + 'clita kasd gubergren, no sea takimata sanctus est Lorem ipsum dolor sit '
+                   + 'amet. Lorem ipsum dolor sit amet, consetetur sadipscing elitr, sed diam '
+                   + 'nonumy eirmod tempor invidunt ut labore et dolore magna aliquyam erat, sed '
+                   + 'diam voluptua. At vero eos et accusam et justo duo dolores et ea rebum. Stet '
+                   + 'clita kasd gubergren, no sea takimata sanctus est Lorem ipsum dolor sit amet. ';
+
+
+function BytesToHex( const bytes : TBytes) : string;
+
+
+implementation
+
+
+function BytesToHex( const bytes : TBytes) : string;
+var i : Integer;
+begin
+  result := '';
+  for i := Low(bytes) to High(bytes) do begin
+    result := result + IntToHex(bytes[i],2);
+  end;
+end;
+
+
+end.

vendor/git.apache.org/thrift.git/lib/delphi/test/TestServer.pas

@@ -0,0 +1,756 @@
+(*
+ * 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 TestServer;
+
+{$I ../src/Thrift.Defines.inc}
+{$WARN SYMBOL_PLATFORM OFF}
+
+{.$DEFINE RunEndless}   // activate to interactively stress-test the server stop routines via Ctrl+C
+
+interface
+
+uses
+  Windows, SysUtils,
+  Generics.Collections,
+  Thrift.Console,
+  Thrift.Server,
+  Thrift.Transport,
+  Thrift.Transport.Pipes,
+  Thrift.Protocol,
+  Thrift.Protocol.JSON,
+  Thrift.Protocol.Compact,
+  Thrift.Collections,
+  Thrift.Utils,
+  Thrift.Test,
+  Thrift,
+  TestConstants,
+  TestServerEvents,
+  Contnrs;
+
+type
+  TTestServer = class
+  public
+    type
+
+      ITestHandler = interface( TThriftTest.Iface )
+        procedure SetServer( const AServer : IServer );
+        procedure TestStop;
+      end;
+
+      TTestHandlerImpl = class( TInterfacedObject, ITestHandler )
+      private
+        FServer : IServer;
+      protected
+        procedure testVoid();
+        function testBool(thing: Boolean): Boolean;
+        function testString(const thing: string): string;
+        function testByte(thing: ShortInt): ShortInt;
+        function testI32(thing: Integer): Integer;
+        function testI64(const thing: Int64): Int64;
+        function testDouble(const thing: Double): Double;
+        function testBinary(const thing: TBytes): TBytes;
+        function testStruct(const thing: IXtruct): IXtruct;
+        function testNest(const thing: IXtruct2): IXtruct2;
+        function testMap(const thing: IThriftDictionary<Integer, Integer>): IThriftDictionary<Integer, Integer>;
+        function testStringMap(const thing: IThriftDictionary<string, string>): IThriftDictionary<string, string>;
+        function testSet(const thing: IHashSet<Integer>): IHashSet<Integer>;
+        function testList(const thing: IThriftList<Integer>): IThriftList<Integer>;
+        function testEnum(thing: TNumberz): TNumberz;
+        function testTypedef(const thing: Int64): Int64;
+        function testMapMap(hello: Integer): IThriftDictionary<Integer, IThriftDictionary<Integer, Integer>>;
+        function testInsanity(const argument: IInsanity): IThriftDictionary<Int64, IThriftDictionary<TNumberz, IInsanity>>;
+        function testMulti(arg0: ShortInt; arg1: Integer; const arg2: Int64; const arg3: IThriftDictionary<SmallInt, string>; arg4: TNumberz; const arg5: Int64): IXtruct;
+        procedure testException(const arg: string);
+        function testMultiException(const arg0: string; const arg1: string): IXtruct;
+        procedure testOneway(secondsToSleep: Integer);
+
+        procedure TestStop;
+        procedure SetServer( const AServer : IServer );
+      end;
+
+      class procedure PrintCmdLineHelp;
+      class procedure InvalidArgs;
+
+      class procedure LaunchAnonPipeChild( const app : string; const transport : IAnonymousPipeServerTransport);
+      class procedure Execute( const args: array of string);
+  end;
+
+implementation
+
+
+var g_Handler : TTestServer.ITestHandler = nil;
+
+
+function MyConsoleEventHandler( dwCtrlType : DWORD) : BOOL;  stdcall;
+// Note that this Handler procedure is called from another thread
+var handler : TTestServer.ITestHandler;
+begin
+  result := TRUE;
+  try
+    case dwCtrlType of
+      CTRL_C_EVENT        :  Console.WriteLine( 'Ctrl+C pressed');
+      CTRL_BREAK_EVENT    :  Console.WriteLine( 'Ctrl+Break pressed');
+      CTRL_CLOSE_EVENT    :  Console.WriteLine( 'Received CloseTask signal');
+      CTRL_LOGOFF_EVENT   :  Console.WriteLine( 'Received LogOff signal');
+      CTRL_SHUTDOWN_EVENT :  Console.WriteLine( 'Received Shutdown signal');
+    else
+      Console.WriteLine( 'Received console event #'+IntToStr(Integer(dwCtrlType)));
+    end;
+
+    handler := g_Handler;
+    if handler <> nil then handler.TestStop;
+
+  except
+    // catch all
+  end;
+end;
+
+
+{ TTestServer.TTestHandlerImpl }
+
+procedure TTestServer.TTestHandlerImpl.SetServer( const AServer: IServer);
+begin
+  FServer := AServer;
+end;
+
+function TTestServer.TTestHandlerImpl.testByte(thing: ShortInt): ShortInt;
+begin
+  Console.WriteLine('testByte("' + IntToStr( thing) + '")');
+  Result := thing;
+end;
+
+function TTestServer.TTestHandlerImpl.testDouble( const thing: Double): Double;
+begin
+  Console.WriteLine('testDouble("' + FloatToStr( thing ) + '")');
+  Result := thing;
+end;
+
+function TTestServer.TTestHandlerImpl.testBinary(const thing: TBytes): TBytes;
+begin
+  Console.WriteLine('testBinary("' + BytesToHex( thing ) + '")');
+  Result := thing;
+end;
+
+function TTestServer.TTestHandlerImpl.testEnum(thing: TNumberz): TNumberz;
+begin
+  Console.WriteLine('testEnum(' + IntToStr( Integer( thing)) + ')');
+  Result := thing;
+end;
+
+procedure TTestServer.TTestHandlerImpl.testException(const arg: string);
+begin
+  Console.WriteLine('testException(' + arg + ')');
+  if ( arg = 'Xception') then
+  begin
+    raise TXception.Create( 1001, arg);
+  end;
+
+  if (arg = 'TException') then
+  begin
+    raise TException.Create('');
+  end;
+
+  // else do not throw anything
+end;
+
+function TTestServer.TTestHandlerImpl.testI32(thing: Integer): Integer;
+begin
+  Console.WriteLine('testI32("' + IntToStr( thing) + '")');
+  Result := thing;
+end;
+
+function TTestServer.TTestHandlerImpl.testI64( const thing: Int64): Int64;
+begin
+  Console.WriteLine('testI64("' + IntToStr( thing) + '")');
+  Result := thing;
+end;
+
+function TTestServer.TTestHandlerImpl.testInsanity(
+  const argument: IInsanity): IThriftDictionary<Int64, IThriftDictionary<TNumberz, IInsanity>>;
+var
+  hello, goodbye : IXtruct;
+  crazy : IInsanity;
+  looney : IInsanity;
+  first_map : IThriftDictionary<TNumberz, IInsanity>;
+  second_map : IThriftDictionary<TNumberz, IInsanity>;
+  insane : IThriftDictionary<Int64, IThriftDictionary<TNumberz, IInsanity>>;
+
+begin
+
+  Console.WriteLine('testInsanity()');
+  hello := TXtructImpl.Create;
+  hello.String_thing := 'Hello2';
+  hello.Byte_thing := 2;
+  hello.I32_thing := 2;
+  hello.I64_thing := 2;
+
+  goodbye := TXtructImpl.Create;
+  goodbye.String_thing := 'Goodbye4';
+  goodbye.Byte_thing := 4;
+  goodbye.I32_thing := 4;
+  goodbye.I64_thing := 4;
+
+  crazy := TInsanityImpl.Create;
+  crazy.UserMap := TThriftDictionaryImpl<TNumberz, Int64>.Create;
+  crazy.UserMap.AddOrSetValue( TNumberz.EIGHT, 8);
+  crazy.Xtructs := TThriftListImpl<IXtruct>.Create;
+  crazy.Xtructs.Add(goodbye);
+
+  looney := TInsanityImpl.Create;
+  crazy.UserMap.AddOrSetValue( TNumberz.FIVE, 5);
+  crazy.Xtructs.Add(hello);
+
+  first_map := TThriftDictionaryImpl<TNumberz, IInsanity>.Create;
+  second_map := TThriftDictionaryImpl<TNumberz, IInsanity>.Create;
+
+  first_map.AddOrSetValue( TNumberz.TWO, crazy);
+  first_map.AddOrSetValue( TNumberz.THREE, crazy);
+
+  second_map.AddOrSetValue( TNumberz.SIX, looney);
+
+  insane := TThriftDictionaryImpl<Int64, IThriftDictionary<TNumberz, IInsanity>>.Create;
+
+  insane.AddOrSetValue( 1, first_map);
+  insane.AddOrSetValue( 2, second_map);
+
+  Result := insane;
+end;
+
+function TTestServer.TTestHandlerImpl.testList(
+  const thing: IThriftList<Integer>): IThriftList<Integer>;
+var
+  first : Boolean;
+  elem : Integer;
+begin
+  Console.Write('testList({');
+  first := True;
+  for elem in thing do
+  begin
+    if first then
+    begin
+      first := False;
+    end else
+    begin
+      Console.Write(', ');
+    end;
+    Console.Write( IntToStr( elem));
+  end;
+  Console.WriteLine('})');
+  Result := thing;
+end;
+
+function TTestServer.TTestHandlerImpl.testMap(
+  const thing: IThriftDictionary<Integer, Integer>): IThriftDictionary<Integer, Integer>;
+var
+  first : Boolean;
+  key : Integer;
+begin
+  Console.Write('testMap({');
+  first := True;
+  for key in thing.Keys do
+  begin
+    if (first) then
+    begin
+      first := false;
+    end else
+    begin
+      Console.Write(', ');
+    end;
+    Console.Write(IntToStr(key) + ' => ' + IntToStr( thing[key]));
+  end;
+  Console.WriteLine('})');
+  Result := thing;
+end;
+
+function TTestServer.TTestHandlerImpl.TestMapMap(
+  hello: Integer): IThriftDictionary<Integer, IThriftDictionary<Integer, Integer>>;
+var
+  mapmap : IThriftDictionary<Integer, IThriftDictionary<Integer, Integer>>;
+  pos : IThriftDictionary<Integer, Integer>;
+  neg : IThriftDictionary<Integer, Integer>;
+  i : Integer;
+begin
+  Console.WriteLine('testMapMap(' + IntToStr( hello) + ')');
+  mapmap := TThriftDictionaryImpl<Integer, IThriftDictionary<Integer, Integer>>.Create;
+  pos := TThriftDictionaryImpl<Integer, Integer>.Create;
+  neg := TThriftDictionaryImpl<Integer, Integer>.Create;
+
+  for i := 1 to 4 do
+  begin
+    pos.AddOrSetValue( i, i);
+    neg.AddOrSetValue( -i, -i);
+  end;
+
+  mapmap.AddOrSetValue(4, pos);
+  mapmap.AddOrSetValue( -4, neg);
+
+  Result := mapmap;
+end;
+
+function TTestServer.TTestHandlerImpl.testMulti(arg0: ShortInt; arg1: Integer;
+  const arg2: Int64; const arg3: IThriftDictionary<SmallInt, string>;
+  arg4: TNumberz; const arg5: Int64): IXtruct;
+var
+  hello : IXtruct;
+begin
+  Console.WriteLine('testMulti()');
+  hello := TXtructImpl.Create;
+  hello.String_thing := 'Hello2';
+  hello.Byte_thing := arg0;
+  hello.I32_thing := arg1;
+  hello.I64_thing := arg2;
+  Result := hello;
+end;
+
+function TTestServer.TTestHandlerImpl.testMultiException( const arg0, arg1: string): IXtruct;
+var
+  x2 : TXception2;
+begin
+  Console.WriteLine('testMultiException(' + arg0 + ', ' + arg1 + ')');
+  if ( arg0 = 'Xception') then
+  begin
+    raise TXception.Create( 1001, 'This is an Xception');  // test the new rich CTOR
+  end else
+  if ( arg0 = 'Xception2') then
+  begin
+    x2 := TXception2.Create;  // the old way still works too?
+    x2.ErrorCode := 2002;
+    x2.Struct_thing := TXtructImpl.Create;
+    x2.Struct_thing.String_thing := 'This is an Xception2';
+    x2.UpdateMessageProperty;
+    raise x2;
+  end;
+
+  Result := TXtructImpl.Create;
+  Result.String_thing := arg1;
+end;
+
+function TTestServer.TTestHandlerImpl.testNest( const thing: IXtruct2): IXtruct2;
+var
+  temp : IXtruct;
+begin
+  temp := thing.Struct_thing;
+  Console.WriteLine('testNest({' +
+         IntToStr( thing.Byte_thing) + ', {' +
+         '"' + temp.String_thing + '", ' +
+         IntToStr( temp.Byte_thing) + ', ' +
+         IntToStr( temp.I32_thing) + ', ' +
+         IntToStr( temp.I64_thing) + '}, ' +
+         IntToStr( temp.I32_thing) + '})');
+  Result := thing;
+end;
+
+procedure TTestServer.TTestHandlerImpl.testOneway(secondsToSleep: Integer);
+begin
+  Console.WriteLine('testOneway(' + IntToStr( secondsToSleep )+ '), sleeping...');
+  Sleep(secondsToSleep * 1000);
+  Console.WriteLine('testOneway finished');
+end;
+
+function TTestServer.TTestHandlerImpl.testSet(
+  const thing: IHashSet<Integer>):IHashSet<Integer>;
+var
+  first : Boolean;
+  elem : Integer;
+begin
+  Console.Write('testSet({');
+  first := True;
+
+  for elem in thing do
+  begin
+    if first then
+    begin
+      first := False;
+    end else
+    begin
+      Console.Write( ', ');
+    end;
+    Console.Write( IntToStr( elem));
+  end;
+  Console.WriteLine('})');
+  Result := thing;
+end;
+
+procedure TTestServer.TTestHandlerImpl.testStop;
+begin
+  if FServer <> nil then
+  begin
+    FServer.Stop;
+  end;
+end;
+
+function TTestServer.TTestHandlerImpl.testBool(thing: Boolean): Boolean;
+begin
+  Console.WriteLine('testBool(' + BoolToStr(thing,true) + ')');
+  Result := thing;
+end;
+
+function TTestServer.TTestHandlerImpl.testString( const thing: string): string;
+begin
+  Console.WriteLine('teststring("' + thing + '")');
+  Result := thing;
+end;
+
+function TTestServer.TTestHandlerImpl.testStringMap(
+  const thing: IThriftDictionary<string, string>): IThriftDictionary<string, string>;
+var
+  first : Boolean;
+  key : string;
+begin
+  Console.Write('testStringMap({');
+  first := True;
+  for key in thing.Keys do
+  begin
+    if (first) then
+    begin
+      first := false;
+    end else
+    begin
+      Console.Write(', ');
+    end;
+    Console.Write(key + ' => ' + thing[key]);
+  end;
+  Console.WriteLine('})');
+  Result := thing;
+end;
+
+function TTestServer.TTestHandlerImpl.testTypedef( const thing: Int64): Int64;
+begin
+  Console.WriteLine('testTypedef(' + IntToStr( thing) + ')');
+  Result := thing;
+end;
+
+procedure TTestServer.TTestHandlerImpl.TestVoid;
+begin
+  Console.WriteLine('testVoid()');
+end;
+
+function TTestServer.TTestHandlerImpl.testStruct( const thing: IXtruct): IXtruct;
+begin
+  Console.WriteLine('testStruct({' +
+    '"' + thing.String_thing + '", ' +
+      IntToStr( thing.Byte_thing) + ', ' +
+      IntToStr( thing.I32_thing) + ', ' +
+      IntToStr( thing.I64_thing));
+  Result := thing;
+end;
+
+
+{ TTestServer }
+
+
+class procedure TTestServer.PrintCmdLineHelp;
+const HELPTEXT = ' [options]'#10
+               + #10
+               + 'Allowed options:'#10
+               + '  -h [ --help ]               produce help message'#10
+               + '  --port arg (=9090)          Port number to listen'#10
+               + '  --domain-socket arg         Unix Domain Socket (e.g. /tmp/ThriftTest.thrift)'#10
+               + '  --named-pipe arg            Windows Named Pipe (e.g. MyThriftPipe)'#10
+               + '  --server-type arg (=simple) type of server, "simple", "thread-pool",'#10
+               + '                              "threaded", or "nonblocking"'#10
+               + '  --transport arg (=socket)   transport: buffered, framed, http, anonpipe'#10
+               + '  --protocol arg (=binary)    protocol: binary, compact, json'#10
+               + '  --ssl                       Encrypted Transport using SSL'#10
+               + '  --processor-events          processor-events'#10
+               + '  -n [ --workers ] arg (=4)   Number of thread pools workers. Only valid for'#10
+               + '                              thread-pool server type'#10
+               ;
+begin
+  Console.WriteLine( ChangeFileExt(ExtractFileName(ParamStr(0)),'') + HELPTEXT);
+end;
+
+class procedure TTestServer.InvalidArgs;
+begin
+  Console.WriteLine( 'Invalid args.');
+  Console.WriteLine( ChangeFileExt(ExtractFileName(ParamStr(0)),'') + ' -h for more information');
+  Abort;
+end;
+
+class procedure TTestServer.LaunchAnonPipeChild( const app : string; const transport : IAnonymousPipeServerTransport);
+//Launch child process and pass R/W anonymous pipe handles on cmd line.
+//This is a simple example and does not include elevation or other
+//advanced features.
+var pi : PROCESS_INFORMATION;
+        si : STARTUPINFO;
+        sArg, sHandles, sCmdLine : string;
+    i : Integer;
+begin
+  GetStartupInfo( si);  //set startupinfo for the spawned process
+
+  // preformat handles args
+  sHandles := Format( '%d %d',
+                    [ Integer(transport.ClientAnonRead),
+                      Integer(transport.ClientAnonWrite)]);
+
+  // pass all settings to client
+  sCmdLine := app;
+  for i := 1 to ParamCount do begin
+    sArg := ParamStr(i);
+
+    // add anonymous handles and quote strings where appropriate
+    if sArg = '-anon'
+    then sArg := sArg +' '+ sHandles
+    else begin
+      if Pos(' ',sArg) > 0
+      then sArg := '"'+sArg+'"';
+    end;;
+
+    sCmdLine := sCmdLine +' '+ sArg;
+  end;
+
+  // spawn the child process
+  Console.WriteLine('Starting client '+sCmdLine);
+  Win32Check( CreateProcess( nil, PChar(sCmdLine), nil,nil,TRUE,0,nil,nil,si,pi));
+
+  CloseHandle( pi.hThread);
+    CloseHandle( pi.hProcess);
+end;
+
+
+class procedure TTestServer.Execute( const args: array of string);
+var
+  Port : Integer;
+  ServerEvents : Boolean;
+  sPipeName : string;
+  testHandler : ITestHandler;
+  testProcessor : IProcessor;
+  ServerTrans : IServerTransport;
+  ServerEngine : IServer;
+  anonymouspipe : IAnonymousPipeServerTransport;
+  namedpipe : INamedPipeServerTransport;
+  TransportFactory : ITransportFactory;
+  ProtocolFactory : IProtocolFactory;
+  i, numWorker : Integer;
+  s : string;
+  protType : TKnownProtocol;
+  servertype : TServerType;
+  endpoint : TEndpointTransport;
+  layered : TLayeredTransports;
+  UseSSL : Boolean; // include where appropriate (TLayeredTransport?)
+begin
+  try
+    ServerEvents := FALSE;
+    protType := prot_Binary;
+    servertype := srv_Simple;
+    endpoint := trns_Sockets;
+    layered := [];
+    UseSSL := FALSE;
+    Port := 9090;
+    sPipeName := '';
+    numWorker := 4;
+
+    i := 0;
+    while ( i < Length(args) ) do begin
+      s := args[i];
+      Inc(i);
+
+      // Allowed options:
+      if (s = '-h') or (s = '--help') then begin
+        // -h [ --help ]               produce help message
+        PrintCmdLineHelp;
+        Exit;
+      end
+      else if (s = '--port') then begin
+        // --port arg (=9090)          Port number to listen
+        s := args[i];
+        Inc(i);
+        Port := StrToIntDef( s, Port);
+      end
+      else if (s = '--domain-socket') then begin
+        // --domain-socket arg         Unix Domain Socket (e.g. /tmp/ThriftTest.thrift)
+        raise Exception.Create('domain-socket not supported');
+      end
+      else if (s = '--named-pipe') then begin
+        // --named-pipe arg            Windows Named Pipe (e.g. MyThriftPipe)
+        endpoint := trns_NamedPipes;
+        sPipeName := args[i];  // -pipe <name>
+        Inc( i );
+      end
+      else if (s = '--server-type') then begin
+        // --server-type arg (=simple) type of server,
+        // arg = "simple", "thread-pool", "threaded", or "nonblocking"
+        s := args[i];
+        Inc(i);
+
+        if      s = 'simple'      then servertype := srv_Simple
+        else if s = 'thread-pool' then servertype := srv_Threadpool
+        else if s = 'threaded'    then servertype := srv_Threaded
+        else if s = 'nonblocking' then servertype := srv_Nonblocking
+        else InvalidArgs;
+      end
+      else if (s = '--transport') then begin
+        // --transport arg (=buffered) transport: buffered, framed, http
+        s := args[i];
+        Inc(i);
+
+        if      s = 'buffered' then Include( layered, trns_Buffered)
+        else if s = 'framed'   then Include( layered, trns_Framed)
+        else if s = 'http'     then endpoint := trns_Http
+        else if s = 'anonpipe' then endpoint := trns_AnonPipes
+        else InvalidArgs;
+      end
+      else if (s = '--protocol') then begin
+        // --protocol arg (=binary)    protocol: binary, compact, json
+        s := args[i];
+        Inc(i);
+
+        if      s = 'binary'   then protType := prot_Binary
+        else if s = 'compact'  then protType := prot_Compact
+        else if s = 'json'     then protType := prot_JSON
+        else InvalidArgs;
+      end
+      else if (s = '--ssl') then begin
+        // --ssl     Encrypted Transport using SSL
+        UseSSL := TRUE;
+      end
+      else if (s = '--processor-events') then begin
+         // --processor-events          processor-events
+        ServerEvents := TRUE;
+      end
+      else if (s = '-n') or (s = '--workers') then begin
+        // -n [ --workers ] arg (=4)   Number of thread pools workers.
+        // Only valid for thread-pool server type
+        s := args[i];
+        numWorker := StrToIntDef(s,0);
+        if numWorker > 0
+        then Inc(i)
+        else numWorker := 4;
+      end
+      else begin
+        InvalidArgs;
+      end;
+    end;
+
+
+    Console.WriteLine('Server configuration: ');
+
+    // create protocol factory, default to BinaryProtocol
+    case protType of
+      prot_Binary  :  ProtocolFactory := TBinaryProtocolImpl.TFactory.Create( BINARY_STRICT_READ, BINARY_STRICT_WRITE);
+      prot_JSON    :  ProtocolFactory := TJSONProtocolImpl.TFactory.Create;
+      prot_Compact :  ProtocolFactory := TCompactProtocolImpl.TFactory.Create;
+    else
+      raise Exception.Create('Unhandled protocol');
+    end;
+    ASSERT( ProtocolFactory <> nil);
+    Console.WriteLine('- '+THRIFT_PROTOCOLS[protType]+' protocol');
+
+    case endpoint of
+
+      trns_Sockets : begin
+        Console.WriteLine('- sockets (port '+IntToStr(port)+')');
+        if (trns_Buffered in layered) then Console.WriteLine('- buffered');
+        servertrans := TServerSocketImpl.Create( Port, 0, (trns_Buffered in layered));
+      end;
+
+      trns_Http : begin
+        raise Exception.Create(ENDPOINT_TRANSPORTS[endpoint]+' server transport not implemented');
+      end;
+
+      trns_NamedPipes : begin
+        Console.WriteLine('- named pipe ('+sPipeName+')');
+        namedpipe   := TNamedPipeServerTransportImpl.Create( sPipeName, 4096, PIPE_UNLIMITED_INSTANCES);
+        servertrans := namedpipe;
+      end;
+
+      trns_AnonPipes : begin
+        Console.WriteLine('- anonymous pipes');
+        anonymouspipe := TAnonymousPipeServerTransportImpl.Create;
+        servertrans   := anonymouspipe;
+      end
+
+    else
+      raise Exception.Create('Unhandled endpoint transport');
+    end;
+    ASSERT( servertrans <> nil);
+
+    if UseSSL then begin
+      raise Exception.Create('SSL not implemented');
+    end;
+
+    if (trns_Framed in layered) then begin
+      Console.WriteLine('- framed transport');
+      TransportFactory := TFramedTransportImpl.TFactory.Create
+    end
+    else begin
+      TransportFactory := TTransportFactoryImpl.Create;
+    end;
+    ASSERT( TransportFactory <> nil);
+
+    testHandler   := TTestHandlerImpl.Create;
+    testProcessor := TThriftTest.TProcessorImpl.Create( testHandler );
+
+    case servertype of
+      srv_Simple      : begin
+        ServerEngine := TSimpleServer.Create( testProcessor, ServerTrans, TransportFactory, ProtocolFactory);
+      end;
+
+      srv_Nonblocking : begin
+        raise Exception.Create(SERVER_TYPES[servertype]+' server not implemented');
+      end;
+
+      srv_Threadpool,
+      srv_Threaded: begin
+        if numWorker > 1 then {use here};
+        raise Exception.Create(SERVER_TYPES[servertype]+' server not implemented');
+      end;
+
+    else
+      raise Exception.Create('Unhandled server type');
+    end;
+    ASSERT( ServerEngine <> nil);
+
+    testHandler.SetServer( ServerEngine);
+
+    // test events?
+    if ServerEvents then begin
+      Console.WriteLine('- server events test enabled');
+      ServerEngine.ServerEvents := TServerEventsImpl.Create;
+    end;
+
+    // start the client now when we have the anon handles, but before the server starts
+    if endpoint = trns_AnonPipes
+    then LaunchAnonPipeChild( ExtractFilePath(ParamStr(0))+'client.exe', anonymouspipe);
+
+    // install Ctrl+C handler before the server starts
+    g_Handler := testHandler;
+    SetConsoleCtrlHandler( @MyConsoleEventHandler, TRUE);
+
+    Console.WriteLine('');
+    repeat
+      Console.WriteLine('Starting the server ...');
+      serverEngine.Serve;
+    until {$IFDEF RunEndless} FALSE {$ELSE} TRUE {$ENDIF};
+
+    testHandler.SetServer( nil);
+    g_Handler := nil;
+
+  except
+    on E: EAbort do raise;
+    on E: Exception do begin
+      Console.WriteLine( E.Message + #10 + E.StackTrace );
+    end;
+  end;
+  Console.WriteLine( 'done.');
+end;
+
+
+end.

vendor/git.apache.org/thrift.git/lib/delphi/test/TestServerEvents.pas

@@ -0,0 +1,174 @@
+(*
+ * 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 TestServerEvents;
+
+interface
+
+uses
+  SysUtils,
+  Thrift,
+  Thrift.Protocol,
+  Thrift.Transport,
+  Thrift.Server,
+  Thrift.Console;
+
+type
+  TRequestEventsImpl = class( TInterfacedObject, IRequestEvents)
+  protected
+    FStart : TDateTime;
+    // IRequestProcessingEvents
+    procedure PreRead;
+    procedure PostRead;
+    procedure PreWrite;
+    procedure PostWrite;
+    procedure OnewayComplete;
+    procedure UnhandledError( const e : Exception);
+    procedure CleanupContext;
+  public
+    constructor Create;
+  end;
+
+
+  TProcessorEventsImpl = class( TInterfacedObject, IProcessorEvents)
+  protected
+    FReqs : Integer;
+    // IProcessorEvents
+    procedure Processing( const transport : ITransport);
+    function  CreateRequestContext( const aFunctionName : string) : IRequestEvents;
+    procedure CleanupContext;
+  public
+    constructor Create;
+  end;
+
+
+  TServerEventsImpl = class( TInterfacedObject, IServerEvents)
+  protected
+    // IServerEvents
+    procedure PreServe;
+    procedure PreAccept;
+    function  CreateProcessingContext( const input, output : IProtocol) : IProcessorEvents;
+  end;
+
+
+implementation
+
+{ TServerEventsImpl }
+
+procedure TServerEventsImpl.PreServe;
+begin
+  Console.WriteLine('ServerEvents: Server starting to serve requests');
+end;
+
+
+procedure TServerEventsImpl.PreAccept;
+begin
+  Console.WriteLine('ServerEvents: Server transport is ready to accept incoming calls');
+end;
+
+
+function TServerEventsImpl.CreateProcessingContext(const input, output: IProtocol): IProcessorEvents;
+begin
+  result := TProcessorEventsImpl.Create;
+end;
+
+
+{ TProcessorEventsImpl }
+
+constructor TProcessorEventsImpl.Create;
+begin
+  inherited Create;
+  FReqs := 0;
+  Console.WriteLine('ProcessorEvents: Client connected, processing begins');
+end;
+
+procedure TProcessorEventsImpl.Processing(const transport: ITransport);
+begin
+  Console.WriteLine('ProcessorEvents: Processing of incoming request begins');
+end;
+
+
+function TProcessorEventsImpl.CreateRequestContext( const aFunctionName: string): IRequestEvents;
+begin
+  result := TRequestEventsImpl.Create;
+  Inc( FReqs);
+end;
+
+
+procedure TProcessorEventsImpl.CleanupContext;
+begin
+  Console.WriteLine( 'ProcessorEvents: completed after handling '+IntToStr(FReqs)+' requests.');
+end;
+
+
+{ TRequestEventsImpl }
+
+
+constructor TRequestEventsImpl.Create;
+begin
+  inherited Create;
+  FStart := Now;
+  Console.WriteLine('RequestEvents: New request');
+end;
+
+
+procedure TRequestEventsImpl.PreRead;
+begin
+  Console.WriteLine('RequestEvents: Reading request message ...');
+end;
+
+
+procedure TRequestEventsImpl.PostRead;
+begin
+  Console.WriteLine('RequestEvents: Reading request message completed');
+end;
+
+procedure TRequestEventsImpl.PreWrite;
+begin
+  Console.WriteLine('RequestEvents: Writing response message ...');
+end;
+
+
+procedure TRequestEventsImpl.PostWrite;
+begin
+  Console.WriteLine('RequestEvents: Writing response message completed');
+end;
+
+
+procedure TRequestEventsImpl.OnewayComplete;
+begin
+  Console.WriteLine('RequestEvents: Oneway message processed');
+end;
+
+
+procedure TRequestEventsImpl.UnhandledError(const e: Exception);
+begin
+  Console.WriteLine('RequestEvents: Unhandled exception of type '+e.classname);
+end;
+
+
+procedure TRequestEventsImpl.CleanupContext;
+var millis : Double;
+begin
+  millis := (Now - FStart) * (24*60*60*1000);
+  Console.WriteLine( 'Request processing completed in '+IntToStr(Round(millis))+' ms');
+end;
+
+
+end.

vendor/git.apache.org/thrift.git/lib/delphi/test/client.dpr

@@ -0,0 +1,72 @@
+(*
+ * 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.
+ *)
+
+
+program client;
+
+{$APPTYPE CONSOLE}
+
+uses
+  SysUtils,
+  TestClient in 'TestClient.pas',
+  Thrift.Test, // in 'gen-delphi\Thrift.Test.pas',
+  Thrift in '..\src\Thrift.pas',
+  Thrift.Transport in '..\src\Thrift.Transport.pas',
+  Thrift.Socket in '..\src\Thrift.Socket.pas',
+  Thrift.Transport.Pipes in '..\src\Thrift.Transport.Pipes.pas',
+  Thrift.Protocol in '..\src\Thrift.Protocol.pas',
+  Thrift.Protocol.JSON in '..\src\Thrift.Protocol.JSON.pas',
+  Thrift.Protocol.Compact in '..\src\Thrift.Protocol.Compact.pas',
+  Thrift.Protocol.Multiplex in '..\src\Thrift.Protocol.Multiplex.pas',
+  Thrift.Collections in '..\src\Thrift.Collections.pas',
+  Thrift.Server in '..\src\Thrift.Server.pas',
+  Thrift.Stream in '..\src\Thrift.Stream.pas',
+  Thrift.Console in '..\src\Thrift.Console.pas',
+  Thrift.TypeRegistry in '..\src\Thrift.TypeRegistry.pas',
+  Thrift.Utils in '..\src\Thrift.Utils.pas';
+
+var
+  nParamCount : Integer;
+  args : array of string;
+  i : Integer;
+  arg : string;
+
+begin
+  try
+    Writeln( 'Delphi TestClient '+Thrift.Version);
+    nParamCount := ParamCount;
+    SetLength( args, nParamCount);
+    for i := 1 to nParamCount do begin
+      arg := ParamStr( i );
+      args[i-1] := arg;
+    end;
+
+    ExitCode := TTestClient.Execute( args);
+
+  except
+    on E: EAbort do begin
+      ExitCode := $FF;
+    end;
+    on E: Exception do begin
+      Writeln(E.ClassName, ': ', E.Message);
+      ExitCode := $FF;
+    end;
+  end;
+end.
+

vendor/git.apache.org/thrift.git/lib/delphi/test/codegen/README.md

@@ -0,0 +1,28 @@
+How to use the test case:
+----------------------------------------------
+- copy and the template batch file
+- open the batch file and adjust configuration as necessary
+- run the batch
+
+
+Configuration:
+----------------------------------------------
+SVNWORKDIR
+should point to the Thrift working copy root
+
+MY_THRIFT_FILES
+can be set to point to a folder with more thrift IDL files.
+If you don't have any such files, just leave the setting blank.
+
+BIN
+Local MSYS binary folder. Your THRIFT.EXE is installed here.
+
+MINGW_BIN
+Local MinGW bin folder. Contains DLL files required by THRIFT.EXE
+
+DCC
+Identifies the Delphi Command Line compiler (dcc32.exe)
+To be configuired only, if the default is not suitable.
+
+----------------------------------------------
+*EOF*

vendor/git.apache.org/thrift.git/lib/delphi/test/codegen/ReservedKeywords.thrift

@@ -0,0 +1,55 @@
+/*
+ * 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.
+ */
+
+// make sure generated code does not produce name collisions with predefined keywords
+
+
+
+typedef i32 Cardinal
+typedef string message
+typedef list< map< Cardinal, message>> program
+
+struct unit {
+  1: Cardinal downto;
+  2: program procedure;
+}
+
+typedef set< unit> units
+
+exception exception1 {
+  1: program message;
+  2: unit array;
+}
+
+service constructor {
+  unit Create(1: Cardinal asm; 2: message inherited) throws (1: exception1 label);
+  units Destroy();
+}
+
+const Cardinal downto = +1
+const Cardinal published = -1
+
+enum keywords {
+  record = 1,
+  repeat = 2,
+  deprecated = 3
+}
+
+
+

vendor/git.apache.org/thrift.git/lib/delphi/test/codegen/run-Pascal-Codegen-Tests.bat.tmpl

@@ -0,0 +1,173 @@
+REM /*
+REM * Licensed to the Apache Software Foundation (ASF) under one
+REM * or more contributor license agreements. See the NOTICE file
+REM * distributed with this work for additional information
+REM * regarding copyright ownership. The ASF licenses this file
+REM * to you under the Apache License, Version 2.0 (the
+REM * "License"); you may not use this file except in compliance
+REM * with the License. You may obtain a copy of the License at
+REM *
+REM *   http://www.apache.org/licenses/LICENSE-2.0
+REM *
+REM * Unless required by applicable law or agreed to in writing,
+REM * software distributed under the License is distributed on an
+REM * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+REM * KIND, either express or implied. See the License for the
+REM * specific language governing permissions and limitations
+REM * under the License.
+REM */
+@echo off
+if ""=="%1" goto CONFIG
+goto HANDLEDIR
+
+REM -----------------------------------------------------
+:CONFIG
+REM -----------------------------------------------------
+
+rem * CONFIGURATION BEGIN
+rem * configuration settings, adjust as necessary to meet your system setup
+set SVNWORKDIR=
+set MY_THRIFT_FILES=
+set BIN=C:\MSys10\local\bin
+set MINGW_BIN=C:\MinGW\bin
+set DCC=
+set SUBDIR=gen-delphi
+rem * CONFIGURATION END
+
+
+REM -----------------------------------------------------
+:START
+REM -----------------------------------------------------
+
+rem * configured?
+if "%SVNWORKDIR%"=="" goto CONFIG_ERROR
+
+rem * try to find dcc32.exe
+echo Looking for dcc32.exe ...
+if not exist "%DCC%" set DCC=%ProgramFiles%\Embarcadero\RAD Studio\8.0\bin\dcc32.exe
+if not exist "%DCC%" set DCC=%ProgramFiles(x86)%\Embarcadero\RAD Studio\8.0\bin\dcc32.exe
+if not exist "%DCC%" goto CONFIG_ERROR
+echo Found %DCC%
+echo.
+
+rem * some helpers
+set PATH=%BIN%;%MINGW_BIN%;%PATH%
+set TARGET=%SVNWORKDIR%\..\thrift-testing
+set SOURCE=%SVNWORKDIR%
+set TESTAPP=TestProject
+set UNITSEARCH=%SOURCE%\lib\pas\src;%SOURCE%\lib\delphi\src
+set OUTDCU="%TARGET%\dcu"
+set LOGFILE=%TARGET%\%SUBDIR%\codegen.log
+
+rem * create and/or empty target dirs
+if not exist "%TARGET%"           md "%TARGET%"
+if not exist "%TARGET%\%SUBDIR%"  md "%TARGET%\%SUBDIR%"
+if not exist "%OUTDCU%"           md "%OUTDCU%"
+if exist "%TARGET%\*.thrift"      del "%TARGET%\*.thrift"       /Q
+if exist "%TARGET%\%SUBDIR%\*.*"  del "%TARGET%\%SUBDIR%\*.*"   /Q
+if exist "%OUTDCU%\*.*"           del "%OUTDCU%\*.*"            /Q
+
+rem * recurse through thrift WC and "my thrift files" folder
+rem * copies all .thrift files into thrift-testing
+call %0 %SOURCE%
+if not "%MY_THRIFT_FILES%"=="" call %0 %MY_THRIFT_FILES%
+
+rem * compile all thrift files, generate PAS and C++ code
+echo.
+echo Generating code, please wait ...
+cd "%TARGET%"
+for %%a in (*.thrift) do "%BIN%\thrift.exe" -v --gen delphi:register_types,constprefix,events,xmldoc "%%a" 2>> "%LOGFILE%"
+REM * for %%a in (*.thrift) do "%BIN%\thrift.exe" -v --gen cpp "%%a" >> NUL:
+cmd /c start notepad "%LOGFILE%"
+cd ..
+
+rem * check for special Delphi testcases being processed
+if not exist "%TARGET%\%SUBDIR%\ReservedKeywords.pas" goto TESTCASE_MISSING
+
+
+rem * generate a minimal DPR file that uses all generated pascal units
+cd "%TARGET%\%SUBDIR%\"
+if exist inherited.*  ren inherited.*  _inherited.*
+echo program %TESTAPP%;                                           > %TESTAPP%.dpr
+echo {$APPTYPE CONSOLE}                                          >> %TESTAPP%.dpr
+echo.                                                            >> %TESTAPP%.dpr
+echo uses                                                        >> %TESTAPP%.dpr
+for %%a in (*.pas) do echo   %%~na,                              >> %TESTAPP%.dpr
+echo   Windows, Classes, SysUtils;                               >> %TESTAPP%.dpr
+echo.                                                            >> %TESTAPP%.dpr
+echo begin                                                       >> %TESTAPP%.dpr
+echo   Writeln('Successfully compiled!');                        >> %TESTAPP%.dpr
+echo   Writeln('List of units:');                                >> %TESTAPP%.dpr
+for %%a in (*.pas) do echo   Write('%%~na':30,'':10);            >> %TESTAPP%.dpr
+echo   Writeln;                                                  >> %TESTAPP%.dpr
+echo end.                                                        >> %TESTAPP%.dpr
+echo.                                                            >> %TESTAPP%.dpr
+cd ..\..
+
+rem * try to compile the DPR
+rem * this should not throw any errors, warnings or hints
+"%DCC%"  -B "%TARGET%\%SUBDIR%\%TESTAPP%" -U"%UNITSEARCH%" -I"%UNITSEARCH%" -N"%OUTDCU%" -E"%TARGET%\%SUBDIR%"
+dir "%TARGET%\%SUBDIR%\%TESTAPP%.exe"
+if not exist "%TARGET%\%SUBDIR%\%TESTAPP%.exe"  goto CODEGEN_FAILED
+echo.
+echo -----------------------------------------------------------------
+echo The compiled program is now executed. If it hangs or crashes, we
+echo have a serious problem with the generated code. Expected output
+echo is "Successfully compiled:" followed by a list of generated units.
+echo -----------------------------------------------------------------
+"%TARGET%\%SUBDIR%\%TESTAPP%.exe"
+echo -----------------------------------------------------------------
+echo.
+pause
+GOTO EOF
+
+REM -----------------------------------------------------
+:DXE_NOT_FOUND
+REM -----------------------------------------------------
+echo Delphi Compiler (dcc32.exe) not found.
+echo Please check the "DCC" setting in this batch.
+echo.
+cmd /c start notepad README.MD
+cmd /c start notepad %0
+pause
+GOTO EOF
+
+
+REM -----------------------------------------------------
+:CONFIG_ERROR
+REM -----------------------------------------------------
+echo Missing, incomplete or wrong configuration settings!
+cmd /c start notepad README.MD
+cmd /c start notepad %0
+pause
+GOTO EOF
+
+
+REM -----------------------------------------------------
+:TESTCASE_MISSING
+REM -----------------------------------------------------
+echo Missing an expected Delphi testcase!
+pause
+GOTO EOF
+
+
+REM -----------------------------------------------------
+:CODEGEN_FAILED
+REM -----------------------------------------------------
+echo Code generation FAILED!
+pause
+GOTO EOF
+
+
+REM -----------------------------------------------------
+:HANDLEDIR
+REM -----------------------------------------------------
+REM echo %1
+for /D %%a in (%1\*) do call %0 %%a
+if exist "%1\*.thrift"   copy /b "%1\*.thrift" "%TARGET%\*.*"
+GOTO EOF
+
+
+REM -----------------------------------------------------
+:EOF
+REM -----------------------------------------------------

vendor/git.apache.org/thrift.git/lib/delphi/test/maketest.sh

@@ -0,0 +1,23 @@
+#!/bin/sh
+
+#
+# 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.
+#
+
+../../../compiler/cpp/thrift --gen delphi -o . ../../../test/ThriftTest.thrift
+

vendor/git.apache.org/thrift.git/lib/delphi/test/multiplexed/Multiplex.Client.Main.pas

@@ -0,0 +1,131 @@
+(*
+ * 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 Multiplex.Client.Main;
+
+{.$DEFINE StressTest}   // activate to stress-test the server with frequent connects/disconnects
+{.$DEFINE PerfTest}     // activate to activate the performance test
+
+interface
+
+uses
+  Windows, SysUtils, Classes,
+  DateUtils,
+  Generics.Collections,
+  Thrift,
+  Thrift.Protocol,
+  Thrift.Protocol.Multiplex,
+  Thrift.Transport.Pipes,
+  Thrift.Transport,
+  Thrift.Stream,
+  Thrift.Collections,
+  Benchmark,  // in gen-delphi folder
+  Aggr,       // in gen-delphi folder
+  Multiplex.Test.Common;
+
+type
+  TTestClient = class
+  protected
+    FProtocol : IProtocol;
+
+    procedure ParseArgs( const args: array of string);
+    procedure Setup;
+    procedure Run;
+  public
+    constructor Create( const args: array of string);
+    class procedure Execute( const args: array of string);
+  end;
+
+implementation
+
+
+type
+  IServiceClient = interface
+    ['{7745C1C2-AB20-43BA-B6F0-08BF92DE0BAC}']
+    procedure Test;
+  end;
+
+//--- TTestClient -------------------------------------
+
+
+class procedure TTestClient.Execute( const args: array of string);
+var client : TTestClient;
+begin
+  client := TTestClient.Create(args);
+  try
+    client.Run;
+  finally
+    client.Free;
+  end;
+end;
+
+
+constructor TTestClient.Create( const args: array of string);
+begin
+  inherited Create;
+  ParseArgs(args);
+  Setup;
+end;
+
+
+procedure TTestClient.ParseArgs( const args: array of string);
+begin
+  if Length(args) <> 0
+  then raise Exception.Create('No args accepted so far');
+end;
+
+
+procedure TTestClient.Setup;
+var trans : ITransport;
+begin
+  trans := TSocketImpl.Create( 'localhost', 9090);
+  trans := TFramedTransportImpl.Create( trans);
+  trans.Open;
+  FProtocol := TBinaryProtocolImpl.Create( trans, TRUE, TRUE);
+end;
+
+
+procedure TTestClient.Run;
+var bench : TBenchmarkService.Iface;
+    aggr  : TAggr.Iface;
+    multiplex : IProtocol;
+    i         : Integer;
+begin
+  try
+    multiplex := TMultiplexedProtocol.Create( FProtocol, NAME_BENCHMARKSERVICE);
+    bench     := TBenchmarkService.TClient.Create( multiplex);
+
+    multiplex := TMultiplexedProtocol.Create( FProtocol, NAME_AGGR);
+    aggr      := TAggr.TClient.Create( multiplex);
+
+    for i := 1 to 10
+    do aggr.addValue( bench.fibonacci(i));
+
+    for i in aggr.getValues
+    do Write(IntToStr(i)+' ');
+    WriteLn;
+  except
+    on e:Exception do Writeln(#10+e.Message);
+  end;
+end;
+
+
+end.
+
+

vendor/git.apache.org/thrift.git/lib/delphi/test/multiplexed/Multiplex.Server.Main.pas

@@ -0,0 +1,201 @@
+(*
+ * 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 Multiplex.Server.Main;
+
+{$WARN SYMBOL_PLATFORM OFF}
+
+{.$DEFINE RunEndless}   // activate to interactively stress-test the server stop routines via Ctrl+C
+
+interface
+
+uses
+  Windows, SysUtils,
+  Generics.Collections,
+  Thrift.Console,
+  Thrift.Server,
+  Thrift.Transport,
+  Thrift.Transport.Pipes,
+  Thrift.Protocol,
+  Thrift.Protocol.Multiplex,
+  Thrift.Processor.Multiplex,
+  Thrift.Collections,
+  Thrift.Utils,
+  Thrift,
+  Benchmark,  // in gen-delphi folder
+  Aggr,       // in gen-delphi folder
+  Multiplex.Test.Common,
+  Contnrs;
+
+type
+  TTestServer = class
+  public type
+    ITestHandler = interface
+      ['{CAE09AAB-80FB-48E9-B3A8-7F9B96F5419A}']
+      procedure SetServer( const AServer : IServer );
+    end;
+
+  protected type
+    TTestHandlerImpl = class( TInterfacedObject, ITestHandler)
+    private
+      FServer : IServer;
+    protected
+      // ITestHandler
+      procedure SetServer( const AServer : IServer );
+
+      property Server : IServer read FServer write SetServer;
+    end;
+
+    TBenchmarkServiceImpl = class( TTestHandlerImpl, TBenchmarkService.Iface)
+    protected
+      // TBenchmarkService.Iface
+      function fibonacci(n: ShortInt): Integer;
+    end;
+
+
+    TAggrImpl = class( TTestHandlerImpl, TAggr.Iface)
+    protected
+      FList : IThriftList<Integer>;
+
+      // TAggr.Iface
+      procedure addValue(value: Integer);
+      function getValues(): IThriftList<Integer>;
+    public
+      constructor Create;
+      destructor Destroy;  override;
+    end;
+
+  public
+    class procedure Execute( const args: array of string);
+  end;
+
+
+implementation
+
+
+{ TTestServer.TTestHandlerImpl }
+
+procedure TTestServer.TTestHandlerImpl.SetServer( const AServer: IServer);
+begin
+  FServer := AServer;
+end;
+
+
+{ TTestServer.TBenchmarkServiceImpl }
+
+function TTestServer.TBenchmarkServiceImpl.fibonacci(n: ShortInt): Integer;
+var prev, next : Integer;
+begin
+  prev   := 0;
+  result := 1;
+  while n > 0 do begin
+    next   := result + prev;
+    prev   := result;
+    result := next;
+    Dec(n);
+  end;
+end;
+
+{ TTestServer.TAggrImpl }
+
+constructor TTestServer.TAggrImpl.Create;
+begin
+  inherited Create;
+  FList := TThriftListImpl<Integer>.Create;
+end;
+
+
+destructor TTestServer.TAggrImpl.Destroy;
+begin
+  try
+    FreeAndNil( FList);
+  finally
+    inherited Destroy;
+  end;
+end;
+
+
+procedure TTestServer.TAggrImpl.addValue(value: Integer);
+begin
+  FList.Add( value);
+end;
+
+
+function TTestServer.TAggrImpl.getValues(): IThriftList<Integer>;
+begin
+  result := FList;
+end;
+
+
+{ TTestServer }
+
+class procedure TTestServer.Execute( const args: array of string);
+var
+  TransportFactory : ITransportFactory;
+  ProtocolFactory  : IProtocolFactory;
+  ServerTrans      : IServerTransport;
+  benchHandler     : TBenchmarkService.Iface;
+  aggrHandler      : TAggr.Iface;
+  benchProcessor   : IProcessor;
+  aggrProcessor    : IProcessor;
+  multiplex        : IMultiplexedProcessor;
+  ServerEngine     : IServer;
+begin
+  try
+    // create protocol factory, default to BinaryProtocol
+    ProtocolFactory  := TBinaryProtocolImpl.TFactory.Create( TRUE, TRUE);
+    servertrans      := TServerSocketImpl.Create( 9090, 0, FALSE);
+    TransportFactory := TFramedTransportImpl.TFactory.Create;
+
+    benchHandler     := TBenchmarkServiceImpl.Create;
+    benchProcessor   := TBenchmarkService.TProcessorImpl.Create( benchHandler);
+
+    aggrHandler      := TAggrImpl.Create;
+    aggrProcessor    := TAggr.TProcessorImpl.Create( aggrHandler);
+
+    multiplex        := TMultiplexedProcessorImpl.Create;
+    multiplex.RegisterProcessor( NAME_BENCHMARKSERVICE, benchProcessor);
+    multiplex.RegisterProcessor( NAME_AGGR,  aggrProcessor);
+
+    ServerEngine := TSimpleServer.Create( multiplex,
+                                          ServerTrans,
+                                          TransportFactory,
+                                          ProtocolFactory);
+
+    (benchHandler as ITestHandler).SetServer( ServerEngine);
+    (aggrHandler as ITestHandler).SetServer( ServerEngine);
+
+    Console.WriteLine('Starting the server ...');
+    ServerEngine.serve();
+
+    (benchHandler as ITestHandler).SetServer( nil);
+    (aggrHandler as ITestHandler).SetServer( nil);
+
+  except
+    on E: Exception do
+    begin
+      Console.Write( E.Message);
+    end;
+  end;
+  Console.WriteLine( 'done.');
+end;
+
+
+end.
+

vendor/git.apache.org/thrift.git/lib/delphi/test/multiplexed/Multiplex.Test.Client.dpr

@@ -0,0 +1,67 @@
+(*
+ * 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.
+ *)
+
+
+program Multiplex.Test.Client;
+
+{$APPTYPE CONSOLE}
+
+uses
+  SysUtils,
+  Multiplex.Client.Main in 'Multiplex.Client.Main.pas',
+  Thrift in '..\..\src\Thrift.pas',
+  Thrift.Socket in '..\..\src\Thrift.Socket.pas',
+  Thrift.Transport in '..\..\src\Thrift.Transport.pas',
+  Thrift.Transport.Pipes in '..\..\src\Thrift.Transport.Pipes.pas',
+  Thrift.Protocol in '..\..\src\Thrift.Protocol.pas',
+  Thrift.Protocol.Multiplex in '..\..\src\Thrift.Protocol.Multiplex.pas',
+  Thrift.Collections in '..\..\src\Thrift.Collections.pas',
+  Thrift.Server in '..\..\src\Thrift.Server.pas',
+  Thrift.Stream in '..\..\src\Thrift.Stream.pas',
+  Thrift.Console in '..\..\src\Thrift.Console.pas',
+  Thrift.TypeRegistry in '..\..\src\Thrift.TypeRegistry.pas',
+  Thrift.Utils in '..\..\src\Thrift.Utils.pas';
+
+var
+  nParamCount : Integer;
+  args : array of string;
+  i : Integer;
+  arg : string;
+  s : string;
+
+begin
+  try
+    Writeln( 'Multiplex TestClient '+Thrift.Version);
+    nParamCount := ParamCount;
+    SetLength( args, nParamCount);
+    for i := 1 to nParamCount do
+    begin
+      arg := ParamStr( i );
+      args[i-1] := arg;
+    end;
+    TTestClient.Execute( args );
+    Readln;
+  except
+    on E: Exception do begin
+      Writeln(E.ClassName, ': ', E.Message);
+      ExitCode := $FFFF;
+    end;
+  end;
+end.
+

vendor/git.apache.org/thrift.git/lib/delphi/test/multiplexed/Multiplex.Test.Common.pas

@@ -0,0 +1,35 @@
+(*
+ * 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 Multiplex.Test.Common;
+
+interface
+
+const
+  NAME_BENCHMARKSERVICE = 'BenchmarkService';
+  NAME_AGGR             = 'Aggr';
+
+
+implementation
+
+// nix
+
+end.
+
+

vendor/git.apache.org/thrift.git/lib/delphi/test/multiplexed/Multiplex.Test.Server.dpr

@@ -0,0 +1,67 @@
+(*
+ * 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.
+ *)
+
+program Multiplex.Test.Server;
+
+{$APPTYPE CONSOLE}
+
+uses
+  SysUtils,
+  Multiplex.Server.Main in 'Multiplex.Server.Main.pas',
+  Thrift in '..\..\src\Thrift.pas',
+  Thrift.Socket in '..\..\src\Thrift.Socket.pas',
+  Thrift.Transport in '..\..\src\Thrift.Transport.pas',
+  Thrift.Transport.Pipes in '..\..\src\Thrift.Transport.Pipes.pas',
+  Thrift.Protocol in '..\..\src\Thrift.Protocol.pas',
+  Thrift.Protocol.Multiplex in '..\..\src\Thrift.Protocol.Multiplex.pas',
+  Thrift.Processor.Multiplex in '..\..\src\Thrift.Processor.Multiplex.pas',
+  Thrift.Collections in '..\..\src\Thrift.Collections.pas',
+  Thrift.Server in '..\..\src\Thrift.Server.pas',
+  Thrift.Console in '..\..\src\Thrift.Console.pas',
+  Thrift.Utils in '..\..\src\Thrift.Utils.pas',
+  Thrift.TypeRegistry in '..\..\src\Thrift.TypeRegistry.pas',
+  Thrift.Stream in '..\..\src\Thrift.Stream.pas';
+
+var
+  nParamCount : Integer;
+  args : array of string;
+  i : Integer;
+  arg : string;
+  s : string;
+
+begin
+  try
+    Writeln( 'Multiplex TestServer '+Thrift.Version);
+    nParamCount := ParamCount;
+    SetLength( args, nParamCount);
+    for i := 1 to nParamCount do
+    begin
+      arg := ParamStr( i );
+      args[i-1] := arg;
+    end;
+    TTestServer.Execute( args );
+    Writeln('Press ENTER to close ... '); Readln;
+  except
+    on E: Exception do
+      Writeln(E.ClassName, ': ', E.Message);
+  end;
+end.
+
+
+

vendor/git.apache.org/thrift.git/lib/delphi/test/serializer/TestSerializer.Data.pas

@@ -0,0 +1,349 @@
+(*
+ * 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 TestSerializer.Data;
+
+interface
+
+uses
+  Thrift.Collections,
+  DebugProtoTest;
+
+
+type
+  Fixtures = class
+  public
+    class function CreateOneOfEach : IOneOfEach;
+    class function CreateNesting : INesting;
+    class function CreateHolyMoley : IHolyMoley;
+    class function CreateCompactProtoTestStruct : ICompactProtoTestStruct;
+
+  // These byte arrays are serialized versions of the above structs.
+  // They were serialized in binary protocol using thrift 0.6.x and are used to
+  // test backwards compatibility with respect to the standard scheme.
+  (*
+          all data copied from JAVA version,
+          to be used later
+
+  public static final byte[] persistentBytesOneOfEach = new byte[] {
+    $02, $00, $01, $01, $02, $00, $02, $00, $03, $00,
+    $03, $D6, $06, $00, $04, $69, $78, $08, $00, $05,
+    $01, $00, $00, $00, $0A, $00, $06, $00, $00, $00,
+    $01, $65, $A0, $BC, $00, $04, $00, $07, $40, $09,
+    $21, $FB, $54, $44, $2D, $18, $0B, $00, $08, $00,
+    $00, $00, $0D, $4A, $53, $4F, $4E, $20, $54, $48,
+    $49, $53, $21, $20, $22, $01, $0B, $00, $09, $00,
+    $00, $00, $2E, $D3, $80, $E2, $85, $AE, $CE, $9D,
+    $20, $D0, $9D, $CE, $BF, $E2, $85, $BF, $D0, $BE,
+    $C9, $A1, $D0, $B3, $D0, $B0, $CF, $81, $E2, $84,
+    $8E, $20, $CE, $91, $74, $74, $CE, $B1, $E2, $85,
+    $BD, $CE, $BA, $EF, $BF, $BD, $E2, $80, $BC, $02,
+    $00, $0A, $00, $0B, $00, $0B, $00, $00, $00, $06,
+    $62, $61, $73, $65, $36, $34, $0F, $00, $0C, $03,
+    $00, $00, $00, $03, $01, $02, $03, $0F, $00, $0D,
+    $06, $00, $00, $00, $03, $00, $01, $00, $02, $00,
+    $03, $0F, $00, $0E, $0A, $00, $00, $00, $03, $00,
+    $00, $00, $00, $00, $00, $00, $01, $00, $00, $00,
+    $00, $00, $00, $00, $02, $00, $00, $00, $00, $00,
+    $00, $00, $03, $00 };
+
+
+  public static final byte[] persistentBytesNesting = new byte[] {
+    $0C, $00, $01, $08, $00, $01, $00, $00, $7A, $69,
+    $0B, $00, $02, $00, $00, $00, $13, $49, $20, $61,
+    $6D, $20, $61, $20, $62, $6F, $6E, $6B, $2E, $2E,
+    $2E, $20, $78, $6F, $72, $21, $00, $0C, $00, $02,
+    $02, $00, $01, $01, $02, $00, $02, $00, $03, $00,
+    $03, $D6, $06, $00, $04, $69, $78, $08, $00, $05,
+    $01, $00, $00, $00, $0A, $00, $06, $00, $00, $00,
+    $01, $65, $A0, $BC, $00, $04, $00, $07, $40, $09,
+    $21, $FB, $54, $44, $2D, $18, $0B, $00, $08, $00,
+    $00, $00, $0D, $4A, $53, $4F, $4E, $20, $54, $48,
+    $49, $53, $21, $20, $22, $01, $0B, $00, $09, $00,
+    $00, $00, $2E, $D3, $80, $E2, $85, $AE, $CE, $9D,
+    $20, $D0, $9D, $CE, $BF, $E2, $85, $BF, $D0, $BE,
+    $C9, $A1, $D0, $B3, $D0, $B0, $CF, $81, $E2, $84,
+    $8E, $20, $CE, $91, $74, $74, $CE, $B1, $E2, $85,
+    $BD, $CE, $BA, $EF, $BF, $BD, $E2, $80, $BC, $02,
+    $00, $0A, $00, $0B, $00, $0B, $00, $00, $00, $06,
+    $62, $61, $73, $65, $36, $34, $0F, $00, $0C, $03,
+    $00, $00, $00, $03, $01, $02, $03, $0F, $00, $0D,
+    $06, $00, $00, $00, $03, $00, $01, $00, $02, $00,
+    $03, $0F, $00, $0E, $0A, $00, $00, $00, $03, $00,
+    $00, $00, $00, $00, $00, $00, $01, $00, $00, $00,
+    $00, $00, $00, $00, $02, $00, $00, $00, $00, $00,
+    $00, $00, $03, $00, $00 };
+
+  public static final byte[] persistentBytesHolyMoley = new byte[] {
+    $0F, $00, $01, $0C, $00, $00, $00, $02, $02, $00,
+    $01, $01, $02, $00, $02, $00, $03, $00, $03, $23,
+    $06, $00, $04, $69, $78, $08, $00, $05, $01, $00,
+    $00, $00, $0A, $00, $06, $00, $00, $00, $01, $65,
+    $A0, $BC, $00, $04, $00, $07, $40, $09, $21, $FB,
+    $54, $44, $2D, $18, $0B, $00, $08, $00, $00, $00,
+    $0D, $4A, $53, $4F, $4E, $20, $54, $48, $49, $53,
+    $21, $20, $22, $01, $0B, $00, $09, $00, $00, $00,
+    $2E, $D3, $80, $E2, $85, $AE, $CE, $9D, $20, $D0,
+    $9D, $CE, $BF, $E2, $85, $BF, $D0, $BE, $C9, $A1,
+    $D0, $B3, $D0, $B0, $CF, $81, $E2, $84, $8E, $20,
+    $CE, $91, $74, $74, $CE, $B1, $E2, $85, $BD, $CE,
+    $BA, $EF, $BF, $BD, $E2, $80, $BC, $02, $00, $0A,
+    $00, $0B, $00, $0B, $00, $00, $00, $06, $62, $61,
+    $73, $65, $36, $34, $0F, $00, $0C, $03, $00, $00,
+    $00, $03, $01, $02, $03, $0F, $00, $0D, $06, $00,
+    $00, $00, $03, $00, $01, $00, $02, $00, $03, $0F,
+    $00, $0E, $0A, $00, $00, $00, $03, $00, $00, $00,
+    $00, $00, $00, $00, $01, $00, $00, $00, $00, $00,
+    $00, $00, $02, $00, $00, $00, $00, $00, $00, $00,
+    $03, $00, $02, $00, $01, $01, $02, $00, $02, $00,
+    $03, $00, $03, $D6, $06, $00, $04, $69, $78, $08,
+    $00, $05, $01, $00, $00, $00, $0A, $00, $06, $00,
+    $00, $00, $01, $65, $A0, $BC, $00, $04, $00, $07,
+    $40, $09, $21, $FB, $54, $44, $2D, $18, $0B, $00,
+    $08, $00, $00, $00, $0D, $4A, $53, $4F, $4E, $20,
+    $54, $48, $49, $53, $21, $20, $22, $01, $0B, $00,
+    $09, $00, $00, $00, $2E, $D3, $80, $E2, $85, $AE,
+    $CE, $9D, $20, $D0, $9D, $CE, $BF, $E2, $85, $BF,
+    $D0, $BE, $C9, $A1, $D0, $B3, $D0, $B0, $CF, $81,
+    $E2, $84, $8E, $20, $CE, $91, $74, $74, $CE, $B1,
+    $E2, $85, $BD, $CE, $BA, $EF, $BF, $BD, $E2, $80,
+    $BC, $02, $00, $0A, $00, $0B, $00, $0B, $00, $00,
+    $00, $06, $62, $61, $73, $65, $36, $34, $0F, $00,
+    $0C, $03, $00, $00, $00, $03, $01, $02, $03, $0F,
+    $00, $0D, $06, $00, $00, $00, $03, $00, $01, $00,
+    $02, $00, $03, $0F, $00, $0E, $0A, $00, $00, $00,
+    $03, $00, $00, $00, $00, $00, $00, $00, $01, $00,
+    $00, $00, $00, $00, $00, $00, $02, $00, $00, $00,
+    $00, $00, $00, $00, $03, $00, $0E, $00, $02, $0F,
+    $00, $00, $00, $03, $0B, $00, $00, $00, $00, $0B,
+    $00, $00, $00, $03, $00, $00, $00, $0F, $74, $68,
+    $65, $6E, $20, $61, $20, $6F, $6E, $65, $2C, $20,
+    $74, $77, $6F, $00, $00, $00, $06, $74, $68, $72,
+    $65, $65, $21, $00, $00, $00, $06, $46, $4F, $55,
+    $52, $21, $21, $0B, $00, $00, $00, $02, $00, $00,
+    $00, $09, $61, $6E, $64, $20, $61, $20, $6F, $6E,
+    $65, $00, $00, $00, $09, $61, $6E, $64, $20, $61,
+    $20, $74, $77, $6F, $0D, $00, $03, $0B, $0F, $00,
+    $00, $00, $03, $00, $00, $00, $03, $74, $77, $6F,
+    $0C, $00, $00, $00, $02, $08, $00, $01, $00, $00,
+    $00, $01, $0B, $00, $02, $00, $00, $00, $05, $57,
+    $61, $69, $74, $2E, $00, $08, $00, $01, $00, $00,
+    $00, $02, $0B, $00, $02, $00, $00, $00, $05, $57,
+    $68, $61, $74, $3F, $00, $00, $00, $00, $05, $74,
+    $68, $72, $65, $65, $0C, $00, $00, $00, $00, $00,
+    $00, $00, $04, $7A, $65, $72, $6F, $0C, $00, $00,
+    $00, $00, $00 };
+
+
+*)
+
+  private
+    const
+      kUnicodeBytes : packed array[0..43] of Byte
+                    = ( $d3, $80, $e2, $85, $ae, $ce, $9d, $20, $d0, $9d,
+                        $ce, $bf, $e2, $85, $bf, $d0, $be, $c9, $a1, $d0,
+                        $b3, $d0, $b0, $cf, $81, $e2, $84, $8e, $20, $ce,
+                        $91, $74, $74, $ce, $b1, $e2, $85, $bd, $ce, $ba,
+                        $83, $e2, $80, $bc);
+
+  end;
+
+
+implementation
+
+
+class function Fixtures.CreateOneOfEach : IOneOfEach;
+var db : Double;
+    us : Utf8String;
+begin
+  result := TOneOfEachImpl.Create;
+  result.setIm_true( TRUE);
+  result.setIm_false( FALSE);
+  result.setA_bite( ShortInt($D6));
+  result.setInteger16( 27000);
+  result.setInteger32( 1 shl 24);
+  result.setInteger64( Int64(6000) * Int64(1000) * Int64(1000));
+  db := Pi;
+  result.setDouble_precision( db);
+  result.setSome_characters( 'JSON THIS! \"\1');
+
+  // ??
+  SetLength( us, Length(kUnicodeBytes));
+  Move( kUnicodeBytes[0], us[1], Length(kUnicodeBytes));
+  // ??
+  SetString( us, PChar(@kUnicodeBytes[0]), Length(kUnicodeBytes));
+  // !!
+  result.setZomg_unicode( UnicodeString( us));
+
+  {$IF cDebugProtoTest_Option_AnsiStr_Binary}
+  result.SetBase64('base64');
+  {$ELSE}
+  not yet impl
+  {$IFEND}
+
+  // byte, i16, and i64 lists are populated by default constructor
+end;
+
+
+class function Fixtures.CreateNesting : INesting;
+var bonk : IBonk;
+begin
+  bonk := TBonkImpl.Create;
+  bonk.Type_   := 31337;
+  bonk.Message := 'I am a bonk... xor!';
+
+  result := TNestingImpl.Create;
+  result.My_bonk := bonk;
+  result.My_ooe := CreateOneOfEach;
+end;
+
+
+class function Fixtures.CreateHolyMoley : IHolyMoley;
+var big : IThriftList<IOneOfEach>;
+    stage1 : IThriftList<String>;
+    stage2 : IThriftList<IBonk>;
+    b      : IBonk;
+begin
+  result := THolyMoleyImpl.Create;
+
+  big := TThriftListImpl<IOneOfEach>.Create;
+  big.add( CreateOneOfEach);
+  big.add( CreateNesting.my_ooe);
+  result.Big := big;
+  result.Big[0].setA_bite( $22);
+  result.Big[0].setA_bite( $23);
+
+  result.Contain := THashSetImpl< IThriftList<string>>.Create;
+  stage1 := TThriftListImpl<String>.Create;
+  stage1.add( 'and a one');
+  stage1.add( 'and a two');
+  result.Contain.add( stage1);
+
+  stage1 := TThriftListImpl<String>.Create;
+  stage1.add( 'then a one, two');
+  stage1.add( 'three!');
+  stage1.add( 'FOUR!!');
+  result.Contain.add( stage1);
+
+  stage1 := TThriftListImpl<String>.Create;
+  result.Contain.add( stage1);
+
+  stage2 := TThriftListImpl<IBonk>.Create;
+  result.Bonks := TThriftDictionaryImpl< String, IThriftList< IBonk>>.Create;
+  // one empty
+  result.Bonks.Add( 'zero', stage2);
+
+  // one with two
+  stage2 := TThriftListImpl<IBonk>.Create;
+  b := TBonkImpl.Create;
+  b.type_ := 1;
+  b.message := 'Wait.';
+  stage2.Add( b);
+  b := TBonkImpl.Create;
+  b.type_ := 2;
+  b.message := 'What?';
+  stage2.Add( b);
+  result.Bonks.Add( 'two', stage2);
+
+  // one with three
+  stage2 := TThriftListImpl<IBonk>.Create;
+  b := TBonkImpl.Create;
+  b.type_ := 3;
+  b.message := 'quoth';
+  stage2.Add( b);
+  b := TBonkImpl.Create;
+  b.type_ := 4;
+  b.message := 'the raven';
+  stage2.Add( b);
+  b := TBonkImpl.Create;
+  b.type_ := 5;
+  b.message := 'nevermore';
+  stage2.Add( b);
+  result.bonks.Add( 'three', stage2);
+end;
+
+
+class function Fixtures.CreateCompactProtoTestStruct : ICompactProtoTestStruct;
+// superhuge compact proto test struct
+begin
+  result := TCompactProtoTestStructImpl.Create;
+  result.A_byte := TDebugProtoTestConstants.COMPACT_TEST.A_byte;
+  result.A_i16 := TDebugProtoTestConstants.COMPACT_TEST.A_i16;
+  result.A_i32 := TDebugProtoTestConstants.COMPACT_TEST.A_i32;
+  result.A_i64 := TDebugProtoTestConstants.COMPACT_TEST.A_i64;
+  result.A_double := TDebugProtoTestConstants.COMPACT_TEST.A_double;
+  result.A_string := TDebugProtoTestConstants.COMPACT_TEST.A_string;
+  result.A_binary := TDebugProtoTestConstants.COMPACT_TEST.A_binary;
+  result.True_field := TDebugProtoTestConstants.COMPACT_TEST.True_field;
+  result.False_field := TDebugProtoTestConstants.COMPACT_TEST.False_field;
+  result.Empty_struct_field := TDebugProtoTestConstants.COMPACT_TEST.Empty_struct_field;
+  result.Byte_list := TDebugProtoTestConstants.COMPACT_TEST.Byte_list;
+  result.I16_list := TDebugProtoTestConstants.COMPACT_TEST.I16_list;
+  result.I32_list := TDebugProtoTestConstants.COMPACT_TEST.I32_list;
+  result.I64_list := TDebugProtoTestConstants.COMPACT_TEST.I64_list;
+  result.Double_list := TDebugProtoTestConstants.COMPACT_TEST.Double_list;
+  result.String_list := TDebugProtoTestConstants.COMPACT_TEST.String_list;
+  result.Binary_list := TDebugProtoTestConstants.COMPACT_TEST.Binary_list;
+  result.Boolean_list := TDebugProtoTestConstants.COMPACT_TEST.Boolean_list;
+  result.Struct_list := TDebugProtoTestConstants.COMPACT_TEST.Struct_list;
+  result.Byte_set := TDebugProtoTestConstants.COMPACT_TEST.Byte_set;
+  result.I16_set := TDebugProtoTestConstants.COMPACT_TEST.I16_set;
+  result.I32_set := TDebugProtoTestConstants.COMPACT_TEST.I32_set;
+  result.I64_set := TDebugProtoTestConstants.COMPACT_TEST.I64_set;
+  result.Double_set := TDebugProtoTestConstants.COMPACT_TEST.Double_set;
+  result.String_set := TDebugProtoTestConstants.COMPACT_TEST.String_set;
+  result.String_set := TDebugProtoTestConstants.COMPACT_TEST.String_set;
+  result.String_set := TDebugProtoTestConstants.COMPACT_TEST.String_set;
+  result.Binary_set := TDebugProtoTestConstants.COMPACT_TEST.Binary_set;
+  result.Boolean_set := TDebugProtoTestConstants.COMPACT_TEST.Boolean_set;
+  result.Struct_set := TDebugProtoTestConstants.COMPACT_TEST.Struct_set;
+  result.Byte_byte_map := TDebugProtoTestConstants.COMPACT_TEST.Byte_byte_map;
+  result.I16_byte_map := TDebugProtoTestConstants.COMPACT_TEST.I16_byte_map;
+  result.I32_byte_map := TDebugProtoTestConstants.COMPACT_TEST.I32_byte_map;
+  result.I64_byte_map := TDebugProtoTestConstants.COMPACT_TEST.I64_byte_map;
+  result.Double_byte_map := TDebugProtoTestConstants.COMPACT_TEST.Double_byte_map;
+  result.String_byte_map := TDebugProtoTestConstants.COMPACT_TEST.String_byte_map;
+  result.Binary_byte_map := TDebugProtoTestConstants.COMPACT_TEST.Binary_byte_map;
+  result.Boolean_byte_map := TDebugProtoTestConstants.COMPACT_TEST.Boolean_byte_map;
+  result.Byte_i16_map := TDebugProtoTestConstants.COMPACT_TEST.Byte_i16_map;
+  result.Byte_i32_map := TDebugProtoTestConstants.COMPACT_TEST.Byte_i32_map;
+  result.Byte_i64_map := TDebugProtoTestConstants.COMPACT_TEST.Byte_i64_map;
+  result.Byte_double_map := TDebugProtoTestConstants.COMPACT_TEST.Byte_double_map;
+  result.Byte_string_map := TDebugProtoTestConstants.COMPACT_TEST.Byte_string_map;
+  result.Byte_binary_map := TDebugProtoTestConstants.COMPACT_TEST.Byte_binary_map;
+  result.Byte_boolean_map := TDebugProtoTestConstants.COMPACT_TEST.Byte_boolean_map;
+  result.List_byte_map := TDebugProtoTestConstants.COMPACT_TEST.List_byte_map;
+  result.Set_byte_map := TDebugProtoTestConstants.COMPACT_TEST.Set_byte_map;
+  result.Map_byte_map := TDebugProtoTestConstants.COMPACT_TEST.Map_byte_map;
+  result.Byte_map_map := TDebugProtoTestConstants.COMPACT_TEST.Byte_map_map;
+  result.Byte_set_map := TDebugProtoTestConstants.COMPACT_TEST.Byte_set_map;
+  result.Byte_list_map := TDebugProtoTestConstants.COMPACT_TEST.Byte_list_map;
+
+  {$IF cDebugProtoTest_Option_AnsiStr_Binary}
+  result.A_binary := AnsiString( #0#1#2#3#4#5#6#7#8);
+  {$ELSE}
+  not yet impl
+  {$IFEND}
+end;
+
+
+
+
+end.
+

vendor/git.apache.org/thrift.git/lib/delphi/test/serializer/TestSerializer.dpr

@@ -0,0 +1,230 @@
+(*
+ * 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.
+ *)
+
+program TestSerializer;
+
+{$APPTYPE CONSOLE}
+
+uses
+  Classes, Windows, SysUtils, Generics.Collections,
+  Thrift in '..\..\src\Thrift.pas',
+  Thrift.Socket in '..\..\src\Thrift.Socket.pas',
+  Thrift.Transport in '..\..\src\Thrift.Transport.pas',
+  Thrift.Protocol in '..\..\src\Thrift.Protocol.pas',
+  Thrift.Protocol.JSON in '..\..\src\Thrift.Protocol.JSON.pas',
+  Thrift.Collections in '..\..\src\Thrift.Collections.pas',
+  Thrift.Server in '..\..\src\Thrift.Server.pas',
+  Thrift.Console in '..\..\src\Thrift.Console.pas',
+  Thrift.Utils in '..\..\src\Thrift.Utils.pas',
+  Thrift.Serializer in '..\..\src\Thrift.Serializer.pas',
+  Thrift.Stream in '..\..\src\Thrift.Stream.pas',
+  Thrift.TypeRegistry in '..\..\src\Thrift.TypeRegistry.pas',
+  DebugProtoTest,
+  TestSerializer.Data;
+
+
+
+type
+  TTestSerializer = class //extends TestCase {
+  private
+    FProtocols : TList< IProtocolFactory>;
+
+    class function  Serialize(const input : IBase; const factory : IProtocolFactory) : TBytes;  overload;
+    class procedure Serialize(const input : IBase; const factory : IProtocolFactory; const aStream : TStream);  overload;
+    class procedure Deserialize( const input : TBytes; const target : IBase; const factory : IProtocolFactory);  overload;
+    class procedure Deserialize( const input : TStream; const target : IBase; const factory : IProtocolFactory);  overload;
+
+    procedure Test_Serializer_Deserializer;
+
+  public
+    constructor Create;
+    destructor Destroy;  override;
+
+    procedure RunTests;
+  end;
+
+
+
+{ TTestSerializer }
+
+constructor TTestSerializer.Create;
+begin
+  inherited Create;
+  FProtocols := TList< IProtocolFactory>.Create;
+  FProtocols.Add( TBinaryProtocolImpl.TFactory.Create);
+  //FProtocols.Add( TCompactProtocolImpl.TFactory.Create);
+  FProtocols.Add( TJSONProtocolImpl.TFactory.Create);
+end;
+
+
+destructor TTestSerializer.Destroy;
+begin
+  try
+    FreeAndNil( FProtocols);
+  finally
+    inherited Destroy;
+  end;
+end;
+
+type TMethod = (mt_Bytes, mt_Stream);
+
+
+procedure TTestSerializer.Test_Serializer_Deserializer;
+var level3ooe, correct : IOneOfEach;
+    factory : IProtocolFactory;
+    bytes   : TBytes;
+    stream  : TFileStream;
+    i       : Integer;
+    method  : TMethod;
+begin
+  correct := Fixtures.CreateOneOfEach;
+  stream  := TFileStream.Create( 'TestSerializer.dat', fmCreate);
+  try
+
+    for method in [Low(TMethod)..High(TMethod)] do begin
+      for factory in FProtocols do begin
+
+        // write
+        level3ooe := Fixtures.CreateOneOfEach;
+        case method of
+          mt_Bytes:  bytes := Serialize( level3ooe, factory);
+          mt_Stream: begin
+            stream.Size := 0;
+            Serialize( level3ooe, factory, stream);
+          end
+        else
+          ASSERT( FALSE);
+        end;
+
+        // init + read
+        level3ooe := TOneOfEachImpl.Create;
+        case method of
+          mt_Bytes:  Deserialize( bytes, level3ooe, factory);
+          mt_Stream: begin
+            stream.Position := 0;
+            Deserialize( stream, level3ooe, factory);
+          end
+        else
+          ASSERT( FALSE);
+        end;
+
+
+        // check
+        ASSERT( level3ooe.Im_true = correct.Im_true);
+        ASSERT( level3ooe.Im_false = correct.Im_false);
+        ASSERT( level3ooe.A_bite = correct.A_bite);
+        ASSERT( level3ooe.Integer16 = correct.Integer16);
+        ASSERT( level3ooe.Integer32 = correct.Integer32);
+        ASSERT( level3ooe.Integer64 = correct.Integer64);
+        ASSERT( Abs( level3ooe.Double_precision - correct.Double_precision) < 1E-12);
+        ASSERT( level3ooe.Some_characters = correct.Some_characters);
+        ASSERT( level3ooe.Zomg_unicode = correct.Zomg_unicode);
+        ASSERT( level3ooe.What_who = correct.What_who);
+        ASSERT( level3ooe.Base64 = correct.Base64);
+
+        ASSERT( level3ooe.Byte_list.Count = correct.Byte_list.Count);
+        for i := 0 to level3ooe.Byte_list.Count-1
+        do ASSERT( level3ooe.Byte_list[i] = correct.Byte_list[i]);
+
+        ASSERT( level3ooe.I16_list.Count = correct.I16_list.Count);
+        for i := 0 to level3ooe.I16_list.Count-1
+        do ASSERT( level3ooe.I16_list[i] = correct.I16_list[i]);
+
+        ASSERT( level3ooe.I64_list.Count = correct.I64_list.Count);
+        for i := 0 to level3ooe.I64_list.Count-1
+        do ASSERT( level3ooe.I64_list[i] = correct.I64_list[i]);
+      end;
+    end;
+
+  finally
+    stream.Free;
+  end;
+end;
+
+
+procedure TTestSerializer.RunTests;
+begin
+  try
+    Test_Serializer_Deserializer;
+  except
+    on e:Exception do begin
+      Writeln( e.Message);
+      Write('Hit ENTER to close ... '); Readln;
+    end;
+  end;
+end;
+
+
+class function TTestSerializer.Serialize(const input : IBase; const factory : IProtocolFactory) : TBytes;
+var serial : TSerializer;
+begin
+  serial := TSerializer.Create( factory);
+  try
+    result := serial.Serialize( input);
+  finally
+    serial.Free;
+  end;
+end;
+
+
+class procedure TTestSerializer.Serialize(const input : IBase; const factory : IProtocolFactory; const aStream : TStream);
+var serial : TSerializer;
+begin
+  serial := TSerializer.Create( factory);
+  try
+    serial.Serialize( input, aStream);
+  finally
+    serial.Free;
+  end;
+end;
+
+
+class procedure TTestSerializer.Deserialize( const input : TBytes; const target : IBase; const factory : IProtocolFactory);
+var serial : TDeserializer;
+begin
+  serial := TDeserializer.Create( factory);
+  try
+    serial.Deserialize( input, target);
+  finally
+    serial.Free;
+  end;
+end;
+
+class procedure TTestSerializer.Deserialize( const input : TStream; const target : IBase; const factory : IProtocolFactory);
+var serial : TDeserializer;
+begin
+  serial := TDeserializer.Create( factory);
+  try
+    serial.Deserialize( input, target);
+  finally
+    serial.Free;
+  end;
+end;
+
+
+var test : TTestSerializer;
+begin
+  test := TTestSerializer.Create;
+  try
+    test.RunTests;
+  finally
+    test.Free;
+  end;
+end.
+

vendor/git.apache.org/thrift.git/lib/delphi/test/server.dpr

@@ -0,0 +1,73 @@
+(*
+ * 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.
+ *)
+
+program server;
+
+{$APPTYPE CONSOLE}
+
+uses
+  SysUtils,
+  TestServer in 'TestServer.pas',
+  TestServerEvents in 'TestServerEvents.pas',
+  Thrift.Test,  // in gen-delphi folder
+  Thrift in '..\src\Thrift.pas',
+  Thrift.Transport in '..\src\Thrift.Transport.pas',
+  Thrift.Socket in '..\src\Thrift.Socket.pas',
+  Thrift.Transport.Pipes in '..\src\Thrift.Transport.Pipes.pas',
+  Thrift.Protocol in '..\src\Thrift.Protocol.pas',
+  Thrift.Protocol.JSON in '..\src\Thrift.Protocol.JSON.pas',
+  Thrift.Protocol.Compact in '..\src\Thrift.Protocol.Compact.pas',
+  Thrift.Protocol.Multiplex in '..\src\Thrift.Protocol.Multiplex.pas',
+  Thrift.Processor.Multiplex in '..\src\Thrift.Processor.Multiplex.pas',
+  Thrift.Collections in '..\src\Thrift.Collections.pas',
+  Thrift.Server in '..\src\Thrift.Server.pas',
+  Thrift.Console in '..\src\Thrift.Console.pas',
+  Thrift.TypeRegistry in '..\src\Thrift.TypeRegistry.pas',
+  Thrift.Utils in '..\src\Thrift.Utils.pas',
+  Thrift.Stream in '..\src\Thrift.Stream.pas';
+
+var
+  nParamCount : Integer;
+  args : array of string;
+  i : Integer;
+  arg : string;
+
+begin
+  try
+    Writeln( 'Delphi TestServer '+Thrift.Version);
+    nParamCount := ParamCount;
+    SetLength( args, nParamCount);
+    for i := 1 to nParamCount do begin
+      arg := ParamStr( i );
+      args[i-1] := arg;
+    end;
+
+    TTestServer.Execute( args );
+
+  except
+    on E: EAbort do begin
+      ExitCode := $FF;
+    end;
+    on E: Exception do begin
+      Writeln(E.ClassName, ': ', E.Message);
+      ExitCode := $FF;
+    end;
+  end;
+end.
+

vendor/git.apache.org/thrift.git/lib/delphi/test/skip/README.md

@@ -0,0 +1,11 @@
+These two projects belong together. Both programs
+simulate server and client for different versions
+of the same protocol.
+
+The intention of this test is to ensure fully
+working compatibility features of the Delphi Thrift
+implementation.
+
+The expected test result is, that no errors occur
+with both programs, regardless in which order they
+might be started.

vendor/git.apache.org/thrift.git/lib/delphi/test/skip/idl/skiptest_version_1.thrift

@@ -0,0 +1,45 @@
+/*
+ * 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.
+ */
+
+
+// version 1 of the interface
+
+namespace * Skiptest.One
+
+const i32 SKIPTESTSERVICE_VERSION = 1
+
+struct Pong {
+  1 : optional i32 version1
+}
+
+struct Ping {
+  1 : optional i32 version1
+}
+
+exception PongFailed {
+  222 : optional i32 pongErrorCode
+}
+
+
+service SkipTestService {
+  void PingPong( 1: Ping pong) throws (444: PongFailed pof);
+}
+
+
+// EOF

vendor/git.apache.org/thrift.git/lib/delphi/test/skip/idl/skiptest_version_2.thrift

@@ -0,0 +1,69 @@
+/*
+ * 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.
+ */
+
+
+// version 2 of the interface
+
+namespace * Skiptest.Two
+
+const i32 SKIPTESTSERVICE_VERSION = 2
+
+struct Pong {
+  1 : optional i32 version1
+  2 : optional i16 version2
+}
+
+struct Ping {
+  1 : optional i32 version1
+  10 : optional bool boolVal
+  11 : optional byte byteVal
+  12 : optional double dbVal
+  13 : optional i16 i16Val
+  14 : optional i32 i32Val
+  15 : optional i64 i64Val
+  16 : optional string strVal
+  17 : optional Pong structVal
+  18 : optional map< list< Pong>, set< string>> mapVal
+}
+
+exception PingFailed {
+  1 : optional i32 pingErrorCode
+}
+
+exception PongFailed {
+  222 : optional i32 pongErrorCode
+  10 : optional bool boolVal
+  11 : optional byte byteVal
+  12 : optional double dbVal
+  13 : optional i16 i16Val
+  14 : optional i32 i32Val
+  15 : optional i64 i64Val
+  16 : optional string strVal
+  17 : optional Pong structVal
+  18 : optional map< list< Pong>, set< string>> mapVal
+}
+
+
+service SkipTestService {
+  Ping PingPong( 1: Ping ping, 3: Pong pong) throws (1: PingFailed pif, 444: PongFailed pof);
+}
+
+
+// EOF
+

vendor/git.apache.org/thrift.git/lib/delphi/test/skip/skiptest_version1.dpr

@@ -0,0 +1,201 @@
+(*
+ * 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.
+ *)
+
+program skiptest_version1;
+
+{$APPTYPE CONSOLE}
+
+uses
+  Classes, Windows, SysUtils,
+  Skiptest.One,
+  Thrift in '..\..\src\Thrift.pas',
+  Thrift.Socket in '..\..\src\Thrift.Socket.pas',
+  Thrift.Transport in '..\..\src\Thrift.Transport.pas',
+  Thrift.Protocol in '..\..\src\Thrift.Protocol.pas',
+  Thrift.Protocol.JSON in '..\..\src\Thrift.Protocol.JSON.pas',
+  Thrift.Collections in '..\..\src\Thrift.Collections.pas',
+  Thrift.Server in '..\..\src\Thrift.Server.pas',
+  Thrift.Console in '..\..\src\Thrift.Console.pas',
+  Thrift.Utils in '..\..\src\Thrift.Utils.pas',
+  Thrift.TypeRegistry in '..\..\src\Thrift.TypeRegistry.pas',
+  Thrift.Stream in '..\..\src\Thrift.Stream.pas';
+
+const
+  REQUEST_EXT  = '.request';
+  RESPONSE_EXT = '.response';
+
+
+function CreatePing : IPing;
+begin
+  result := TPingImpl.Create;
+  result.Version1  := Skiptest.One.TConstants.SKIPTESTSERVICE_VERSION;
+end;
+
+
+type
+  TDummyServer = class( TInterfacedObject, TSkipTestService.Iface)
+  protected
+    // TSkipTestService.Iface
+    procedure PingPong(const ping: IPing);
+  end;
+
+
+procedure TDummyServer.PingPong(const ping: IPing);
+// TSkipTestService.Iface
+begin
+  Writeln('- performing request from version '+IntToStr(ping.Version1)+' client');
+end;
+
+
+function CreateProtocol( protfact : IProtocolFactory; stm : TStream; aForInput : Boolean) : IProtocol;
+var adapt  : IThriftStream;
+    trans  : ITransport;
+begin
+  adapt  := TThriftStreamAdapterDelphi.Create( stm, FALSE);
+  if aForInput
+  then trans := TStreamTransportImpl.Create( adapt, nil)
+  else trans := TStreamTransportImpl.Create( nil, adapt);
+  result := protfact.GetProtocol( trans);
+end;
+
+
+procedure CreateRequest( protfact : IProtocolFactory; fname : string);
+var stm    : TFileStream;
+    ping   : IPing;
+    proto  : IProtocol;
+    client : TSkipTestService.TClient;   // we need access to send/recv_pingpong()
+    cliRef : IUnknown;                   // holds the refcount
+begin
+  Writeln('- creating new request');
+  stm := TFileStream.Create( fname+REQUEST_EXT+'.tmp', fmCreate);
+  try
+    ping := CreatePing;
+
+    // save request data
+    proto  := CreateProtocol( protfact, stm, FALSE);
+    client := TSkipTestService.TClient.Create( nil, proto);
+    cliRef := client as IUnknown;
+    client.send_PingPong( ping);
+
+  finally
+    client := nil;  // not Free!
+    cliRef := nil;
+    stm.Free;
+    if client = nil then {warning suppressed};
+  end;
+
+  DeleteFile( fname+REQUEST_EXT);
+  RenameFile( fname+REQUEST_EXT+'.tmp', fname+REQUEST_EXT);
+end;
+
+
+procedure ReadResponse( protfact : IProtocolFactory; fname : string);
+var stm    : TFileStream;
+    proto  : IProtocol;
+    client : TSkipTestService.TClient;   // we need access to send/recv_pingpong()
+    cliRef : IUnknown;                   // holds the refcount
+begin
+  Writeln('- reading response');
+  stm := TFileStream.Create( fname+RESPONSE_EXT, fmOpenRead);
+  try
+    // save request data
+    proto  := CreateProtocol( protfact, stm, TRUE);
+    client := TSkipTestService.TClient.Create( proto, nil);
+    cliRef := client as IUnknown;
+    client.recv_PingPong;
+
+  finally
+    client := nil;  // not Free!
+    cliRef := nil;
+    stm.Free;
+    if client = nil then {warning suppressed};
+  end;
+end;
+
+
+procedure ProcessFile( protfact : IProtocolFactory; fname : string);
+var stmIn, stmOut   : TFileStream;
+    protIn, protOut : IProtocol;
+    server : IProcessor;
+begin
+  Writeln('- processing request');
+  stmOut := nil;
+  stmIn  := TFileStream.Create( fname+REQUEST_EXT, fmOpenRead);
+  try
+    stmOut := TFileStream.Create( fname+RESPONSE_EXT+'.tmp', fmCreate);
+
+    // process request and write response data
+    protIn  := CreateProtocol( protfact, stmIn,  TRUE);
+    protOut := CreateProtocol( protfact, stmOut, FALSE);
+
+    server := TSkipTestService.TProcessorImpl.Create( TDummyServer.Create);
+    server.Process( protIn, protOut);
+
+  finally
+    server := nil;  // not Free!
+    stmIn.Free;
+    stmOut.Free;
+    if server = nil then {warning suppressed};
+  end;
+
+  DeleteFile( fname+RESPONSE_EXT);
+  RenameFile( fname+RESPONSE_EXT+'.tmp', fname+RESPONSE_EXT);
+end;
+
+
+procedure Test( protfact : IProtocolFactory; fname : string);
+begin
+  // try to read an existing request
+  if FileExists( fname + REQUEST_EXT) then begin
+    ProcessFile( protfact, fname);
+    ReadResponse( protfact, fname);
+  end;
+
+  // create a new request and try to process
+  CreateRequest( protfact, fname);
+  ProcessFile( protfact, fname);
+  ReadResponse( protfact, fname);
+end;
+
+
+const
+  FILE_BINARY = 'pingpong.bin';
+  FILE_JSON   = 'pingpong.json';
+begin
+  try
+    Writeln( 'Delphi SkipTest '+IntToStr(TConstants.SKIPTESTSERVICE_VERSION)+' using '+Thrift.Version);
+
+    Writeln;
+    Writeln('Binary protocol');
+    Test( TBinaryProtocolImpl.TFactory.Create, FILE_BINARY);
+
+    Writeln;
+    Writeln('JSON protocol');
+    Test( TJSONProtocolImpl.TFactory.Create,   FILE_JSON);
+
+    Writeln;
+    Writeln('Test completed without errors.');
+    Writeln;
+    Write('Press ENTER to close ...');  Readln;
+  except
+    on E: Exception do
+      Writeln(E.ClassName, ': ', E.Message);
+  end;
+end.
+

vendor/git.apache.org/thrift.git/lib/delphi/test/skip/skiptest_version2.dpr

@@ -0,0 +1,228 @@
+(*
+ * 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.
+ *)
+
+program skiptest_version2;
+
+{$APPTYPE CONSOLE}
+
+uses
+  Classes, Windows, SysUtils,
+  Skiptest.Two,
+  Thrift in '..\..\src\Thrift.pas',
+  Thrift.Socket in '..\..\src\Thrift.Socket.pas',
+  Thrift.Transport in '..\..\src\Thrift.Transport.pas',
+  Thrift.Protocol in '..\..\src\Thrift.Protocol.pas',
+  Thrift.Protocol.JSON in '..\..\src\Thrift.Protocol.JSON.pas',
+  Thrift.Collections in '..\..\src\Thrift.Collections.pas',
+  Thrift.Server in '..\..\src\Thrift.Server.pas',
+  Thrift.Console in '..\..\src\Thrift.Console.pas',
+  Thrift.Utils in '..\..\src\Thrift.Utils.pas',
+  Thrift.TypeRegistry in '..\..\src\Thrift.TypeRegistry.pas',
+  Thrift.Stream in '..\..\src\Thrift.Stream.pas';
+
+const
+  REQUEST_EXT  = '.request';
+  RESPONSE_EXT = '.response';
+
+function CreatePing : IPing;
+var list : IThriftList<IPong>;
+    set_ : IHashSet<string>;
+begin
+  result := TPingImpl.Create;
+  result.Version1  := Skiptest.Two.TConstants.SKIPTESTSERVICE_VERSION;
+  result.BoolVal   := TRUE;
+  result.ByteVal   := 2;
+  result.DbVal     := 3;
+  result.I16Val    := 4;
+  result.I32Val    := 5;
+  result.I64Val    := 6;
+  result.StrVal    := 'seven';
+
+  result.StructVal := TPongImpl.Create;
+  result.StructVal.Version1 := -1;
+  result.StructVal.Version2 := -2;
+
+  list := TThriftListImpl<IPong>.Create;
+  list.Add( result.StructVal);
+  list.Add( result.StructVal);
+
+  set_ := THashSetImpl<string>.Create;
+  set_.Add( 'one');
+  set_.Add( 'uno');
+  set_.Add( 'eins');
+  set_.Add( 'een');
+
+  result.MapVal := TThriftDictionaryImpl< IThriftList<IPong>, IHashSet<string>>.Create;
+  result.MapVal.Add( list, set_);
+end;
+
+
+type
+  TDummyServer = class( TInterfacedObject, TSkipTestService.Iface)
+  protected
+    // TSkipTestService.Iface
+    function PingPong(const ping: IPing; const pong: IPong): IPing;
+  end;
+
+
+function TDummyServer.PingPong(const ping: IPing; const pong: IPong): IPing;
+// TSkipTestService.Iface
+begin
+  Writeln('- performing request from version '+IntToStr(ping.Version1)+' client');
+  result := CreatePing;
+end;
+
+
+function CreateProtocol( protfact : IProtocolFactory; stm : TStream; aForInput : Boolean) : IProtocol;
+var adapt  : IThriftStream;
+    trans  : ITransport;
+begin
+  adapt  := TThriftStreamAdapterDelphi.Create( stm, FALSE);
+  if aForInput
+  then trans := TStreamTransportImpl.Create( adapt, nil)
+  else trans := TStreamTransportImpl.Create( nil, adapt);
+  result := protfact.GetProtocol( trans);
+end;
+
+
+procedure CreateRequest( protfact : IProtocolFactory; fname : string);
+var stm    : TFileStream;
+    ping   : IPing;
+    proto  : IProtocol;
+    client : TSkipTestService.TClient;   // we need access to send/recv_pingpong()
+    cliRef : IUnknown;                   // holds the refcount
+begin
+  Writeln('- creating new request');
+  stm := TFileStream.Create( fname+REQUEST_EXT+'.tmp', fmCreate);
+  try
+    ping := CreatePing;
+
+    // save request data
+    proto  := CreateProtocol( protfact, stm, FALSE);
+    client := TSkipTestService.TClient.Create( nil, proto);
+    cliRef := client as IUnknown;
+    client.send_PingPong( ping, ping.StructVal);
+
+  finally
+    client := nil;  // not Free!
+    cliRef := nil;
+    stm.Free;
+    if client = nil then {warning suppressed};
+  end;
+
+  DeleteFile( fname+REQUEST_EXT);
+  RenameFile( fname+REQUEST_EXT+'.tmp', fname+REQUEST_EXT);
+end;
+
+
+procedure ReadResponse( protfact : IProtocolFactory; fname : string);
+var stm    : TFileStream;
+    ping   : IPing;
+    proto  : IProtocol;
+    client : TSkipTestService.TClient;   // we need access to send/recv_pingpong()
+    cliRef : IUnknown;                   // holds the refcount
+begin
+  Writeln('- reading response');
+  stm := TFileStream.Create( fname+RESPONSE_EXT, fmOpenRead);
+  try
+    // save request data
+    proto  := CreateProtocol( protfact, stm, TRUE);
+    client := TSkipTestService.TClient.Create( proto, nil);
+    cliRef := client as IUnknown;
+    ping   := client.recv_PingPong;
+
+  finally
+    client := nil;  // not Free!
+    cliRef := nil;
+    stm.Free;
+    if client = nil then {warning suppressed};
+  end;
+end;
+
+
+procedure ProcessFile( protfact : IProtocolFactory; fname : string);
+var stmIn, stmOut   : TFileStream;
+    protIn, protOut : IProtocol;
+    server : IProcessor;
+begin
+  Writeln('- processing request');
+  stmOut := nil;
+  stmIn  := TFileStream.Create( fname+REQUEST_EXT, fmOpenRead);
+  try
+    stmOut := TFileStream.Create( fname+RESPONSE_EXT+'.tmp', fmCreate);
+
+    // process request and write response data
+    protIn  := CreateProtocol( protfact, stmIn,  TRUE);
+    protOut := CreateProtocol( protfact, stmOut, FALSE);
+
+    server := TSkipTestService.TProcessorImpl.Create( TDummyServer.Create);
+    server.Process( protIn, protOut);
+
+  finally
+    server := nil;  // not Free!
+    stmIn.Free;
+    stmOut.Free;
+    if server = nil then {warning suppressed};
+  end;
+
+  DeleteFile( fname+RESPONSE_EXT);
+  RenameFile( fname+RESPONSE_EXT+'.tmp', fname+RESPONSE_EXT);
+end;
+
+
+procedure Test( protfact : IProtocolFactory; fname : string);
+begin
+  // try to read an existing request
+  if FileExists( fname + REQUEST_EXT) then begin
+    ProcessFile( protfact, fname);
+    ReadResponse( protfact, fname);
+  end;
+
+  // create a new request and try to process
+  CreateRequest( protfact, fname);
+  ProcessFile( protfact, fname);
+  ReadResponse( protfact, fname);
+end;
+
+
+const
+  FILE_BINARY = 'pingpong.bin';
+  FILE_JSON   = 'pingpong.json';
+begin
+  try
+    Writeln( 'Delphi SkipTest '+IntToStr(TConstants.SKIPTESTSERVICE_VERSION)+' using '+Thrift.Version);
+
+    Writeln;
+    Writeln('Binary protocol');
+    Test( TBinaryProtocolImpl.TFactory.Create, FILE_BINARY);
+
+    Writeln;
+    Writeln('JSON protocol');
+    Test( TJSONProtocolImpl.TFactory.Create,   FILE_JSON);
+
+    Writeln;
+    Writeln('Test completed without errors.');
+    Writeln;
+    Write('Press ENTER to close ...');  Readln;
+  except
+    on E: Exception do
+      Writeln(E.ClassName, ': ', E.Message);
+  end;
+end.
+

vendor/git.apache.org/thrift.git/lib/delphi/test/typeregistry/TestTypeRegistry.dpr

@@ -0,0 +1,90 @@
+(*
+ * 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.
+ *)
+
+program TestTypeRegistry;
+
+{$APPTYPE CONSOLE}
+
+uses
+  Classes, Windows, SysUtils, Generics.Collections, TypInfo,
+  Thrift in '..\..\src\Thrift.pas',
+  Thrift.Transport in '..\..\src\Thrift.Transport.pas',
+  Thrift.Socket in '..\..\src\Thrift.Socket.pas',
+  Thrift.Protocol in '..\..\src\Thrift.Protocol.pas',
+  Thrift.Protocol.JSON in '..\..\src\Thrift.Protocol.JSON.pas',
+  Thrift.Collections in '..\..\src\Thrift.Collections.pas',
+  Thrift.Server in '..\..\src\Thrift.Server.pas',
+  Thrift.Console in '..\..\src\Thrift.Console.pas',
+  Thrift.Utils in '..\..\src\Thrift.Utils.pas',
+  Thrift.Serializer in '..\..\src\Thrift.Serializer.pas',
+  Thrift.Stream in '..\..\src\Thrift.Stream.pas',
+  Thrift.TypeRegistry in '..\..\src\Thrift.TypeRegistry.pas',
+  DebugProtoTest;
+
+type
+  Tester<T : IInterface> = class
+  public
+    class procedure Test;
+  end;
+
+class procedure Tester<T>.Test;
+var instance : T;
+    name : string;
+begin
+  instance := TypeRegistry.Construct<T>;
+  name := GetTypeName(TypeInfo(T));
+  if instance <> nil
+  then Writeln( name, ' = ok')
+  else begin
+    Writeln( name, ' = failed');
+    raise Exception.Create( 'Test with '+name+' failed!');
+  end;
+end;
+
+begin
+  Writeln('Testing ...');
+  Tester<IDoubles>.Test;
+  Tester<IOneOfEach>.Test;
+  Tester<IBonk>.Test;
+  Tester<INesting>.Test;
+  Tester<IHolyMoley>.Test;
+  Tester<IBackwards>.Test;
+  Tester<IEmpty>.Test;
+  Tester<IWrapper>.Test;
+  Tester<IRandomStuff>.Test;
+  Tester<IBase64>.Test;
+  Tester<ICompactProtoTestStruct>.Test;
+  Tester<ISingleMapTestStruct>.Test;
+  Tester<IBlowUp>.Test;
+  Tester<IReverseOrderStruct>.Test;
+  Tester<IStructWithSomeEnum>.Test;
+  Tester<ITestUnion>.Test;
+  Tester<ITestUnionMinusStringField>.Test;
+  Tester<IComparableUnion>.Test;
+  Tester<IStructWithAUnion>.Test;
+  Tester<IPrimitiveThenStruct>.Test;
+  Tester<IStructWithASomemap>.Test;
+  Tester<IBigFieldIdStruct>.Test;
+  Tester<IBreaksRubyCompactProtocol>.Test;
+  Tester<ITupleProtocolTestStruct>.Test;
+  Writeln('Completed.');
+
+
+end.
+