ridv/gorealis-v2
1
0
Fork 0
Code Issues Pull requests Projects Releases 13 Packages Wiki Activity Actions

Upgrading dependency to Thrift 0.12.0

Browse source
This commit is contained in:
Renan DelValle 2018-11-27 18:03:50 -08:00
parent 3e4590dcc0
commit 356978cb42
No known key found for this signature in database
GPG key ID: C240AD6D6F443EC9
1302 changed files with 101701 additions and 26784 deletions
Download patch file Download diff file Expand all files Collapse all files

156
vendor/git.apache.org/thrift.git/lib/delphi/DelphiThrift.groupproj generated vendored Normal file
View file

@ -0,0 +1,156 @@
 <Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{6BD327A5-7688-4263-B6A8-B15207CF4EC5}</ProjectGuid>
</PropertyGroup>
<ItemGroup>
<Projects Include="test\client.dproj">
<Dependencies/>
</Projects>
<Projects Include="test\server.dproj">
<Dependencies/>
</Projects>
<Projects Include="test\multiplexed\Multiplex.Test.Client.dproj">
<Dependencies/>
</Projects>
<Projects Include="test\multiplexed\Multiplex.Test.Server.dproj">
<Dependencies/>
</Projects>
<Projects Include="test\serializer\TestSerializer.dproj">
<Dependencies/>
</Projects>
<Projects Include="test\skip\skiptest_version1.dproj">
<Dependencies/>
</Projects>
<Projects Include="test\skip\skiptest_version2.dproj">
<Dependencies/>
</Projects>
<Projects Include="test\typeregistry\TestTypeRegistry.dproj">
<Dependencies/>
</Projects>
<Projects Include="..\..\tutorial\delphi\DelphiServer\DelphiServer.dproj">
<Dependencies/>
</Projects>
<Projects Include="..\..\tutorial\delphi\DelphiClient\DelphiClient.dproj">
<Dependencies/>
</Projects>
<Projects Include="test\keywords\ReservedKeywords.dproj">
<Dependencies/>
</Projects>
</ItemGroup>
<ProjectExtensions>
<Borland.Personality>Default.Personality.12</Borland.Personality>
<Borland.ProjectType/>
<BorlandProject>
<Default.Personality/>
</BorlandProject>
</ProjectExtensions>
<Target Name="client">
<MSBuild Projects="test\client.dproj"/>
</Target>
<Target Name="client:Clean">
<MSBuild Projects="test\client.dproj" Targets="Clean"/>
</Target>
<Target Name="client:Make">
<MSBuild Projects="test\client.dproj" Targets="Make"/>
</Target>
<Target Name="server">
<MSBuild Projects="test\server.dproj"/>
</Target>
<Target Name="server:Clean">
<MSBuild Projects="test\server.dproj" Targets="Clean"/>
</Target>
<Target Name="server:Make">
<MSBuild Projects="test\server.dproj" Targets="Make"/>
</Target>
<Target Name="Multiplex_Test_Client">
<MSBuild Projects="test\multiplexed\Multiplex.Test.Client.dproj"/>
</Target>
<Target Name="Multiplex_Test_Client:Clean">
<MSBuild Projects="test\multiplexed\Multiplex.Test.Client.dproj" Targets="Clean"/>
</Target>
<Target Name="Multiplex_Test_Client:Make">
<MSBuild Projects="test\multiplexed\Multiplex.Test.Client.dproj" Targets="Make"/>
</Target>
<Target Name="Multiplex_Test_Server">
<MSBuild Projects="test\multiplexed\Multiplex.Test.Server.dproj"/>
</Target>
<Target Name="Multiplex_Test_Server:Clean">
<MSBuild Projects="test\multiplexed\Multiplex.Test.Server.dproj" Targets="Clean"/>
</Target>
<Target Name="Multiplex_Test_Server:Make">
<MSBuild Projects="test\multiplexed\Multiplex.Test.Server.dproj" Targets="Make"/>
</Target>
<Target Name="TestSerializer">
<MSBuild Projects="test\serializer\TestSerializer.dproj"/>
</Target>
<Target Name="TestSerializer:Clean">
<MSBuild Projects="test\serializer\TestSerializer.dproj" Targets="Clean"/>
</Target>
<Target Name="TestSerializer:Make">
<MSBuild Projects="test\serializer\TestSerializer.dproj" Targets="Make"/>
</Target>
<Target Name="skiptest_version1">
<MSBuild Projects="test\skip\skiptest_version1.dproj"/>
</Target>
<Target Name="skiptest_version1:Clean">
<MSBuild Projects="test\skip\skiptest_version1.dproj" Targets="Clean"/>
</Target>
<Target Name="skiptest_version1:Make">
<MSBuild Projects="test\skip\skiptest_version1.dproj" Targets="Make"/>
</Target>
<Target Name="skiptest_version2">
<MSBuild Projects="test\skip\skiptest_version2.dproj"/>
</Target>
<Target Name="skiptest_version2:Clean">
<MSBuild Projects="test\skip\skiptest_version2.dproj" Targets="Clean"/>
</Target>
<Target Name="skiptest_version2:Make">
<MSBuild Projects="test\skip\skiptest_version2.dproj" Targets="Make"/>
</Target>
<Target Name="TestTypeRegistry">
<MSBuild Projects="test\typeregistry\TestTypeRegistry.dproj"/>
</Target>
<Target Name="TestTypeRegistry:Clean">
<MSBuild Projects="test\typeregistry\TestTypeRegistry.dproj" Targets="Clean"/>
</Target>
<Target Name="TestTypeRegistry:Make">
<MSBuild Projects="test\typeregistry\TestTypeRegistry.dproj" Targets="Make"/>
</Target>
<Target Name="DelphiServer">
<MSBuild Projects="..\..\tutorial\delphi\DelphiServer\DelphiServer.dproj"/>
</Target>
<Target Name="DelphiServer:Clean">
<MSBuild Projects="..\..\tutorial\delphi\DelphiServer\DelphiServer.dproj" Targets="Clean"/>
</Target>
<Target Name="DelphiServer:Make">
<MSBuild Projects="..\..\tutorial\delphi\DelphiServer\DelphiServer.dproj" Targets="Make"/>
</Target>
<Target Name="DelphiClient">
<MSBuild Projects="..\..\tutorial\delphi\DelphiClient\DelphiClient.dproj"/>
</Target>
<Target Name="DelphiClient:Clean">
<MSBuild Projects="..\..\tutorial\delphi\DelphiClient\DelphiClient.dproj" Targets="Clean"/>
</Target>
<Target Name="DelphiClient:Make">
<MSBuild Projects="..\..\tutorial\delphi\DelphiClient\DelphiClient.dproj" Targets="Make"/>
</Target>
<Target Name="ReservedKeywords">
<MSBuild Projects="test\keywords\ReservedKeywords.dproj"/>
</Target>
<Target Name="ReservedKeywords:Clean">
<MSBuild Projects="test\keywords\ReservedKeywords.dproj" Targets="Clean"/>
</Target>
<Target Name="ReservedKeywords:Make">
<MSBuild Projects="test\keywords\ReservedKeywords.dproj" Targets="Make"/>
</Target>
<Target Name="Build">
<CallTarget Targets="client;server;Multiplex_Test_Client;Multiplex_Test_Server;TestSerializer;skiptest_version1;skiptest_version2;TestTypeRegistry;DelphiServer;DelphiClient;ReservedKeywords"/>
</Target>
<Target Name="Clean">
<CallTarget Targets="client:Clean;server:Clean;Multiplex_Test_Client:Clean;Multiplex_Test_Server:Clean;TestSerializer:Clean;skiptest_version1:Clean;skiptest_version2:Clean;TestTypeRegistry:Clean;DelphiServer:Clean;DelphiClient:Clean;ReservedKeywords:Clean"/>
</Target>
<Target Name="Make">
<CallTarget Targets="client:Make;server:Make;Multiplex_Test_Client:Make;Multiplex_Test_Server:Make;TestSerializer:Make;skiptest_version1:Make;skiptest_version2:Make;TestTypeRegistry:Make;DelphiServer:Make;DelphiClient:Make;ReservedKeywords:Make"/>
</Target>
<Import Condition="Exists('$(BDS)\Bin\CodeGear.Group.Targets')" Project="$(BDS)\Bin\CodeGear.Group.Targets"/>
</Project>

62
vendor/git.apache.org/thrift.git/lib/delphi/src/Thrift.Exception.pas generated vendored Normal file
View file

@ -0,0 +1,62 @@
(*
* 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.
*)
{$SCOPEDENUMS ON}
unit Thrift.Exception;
interface
uses
Classes, SysUtils;
type
// base class for all Thrift 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;
end.

75
vendor/git.apache.org/thrift.git/lib/delphi/src/Thrift.Processor.Multiplex.pas generated vendored
View file

@ -53,11 +53,11 @@ uses
type
IMultiplexedProcessor = interface( IProcessor)
['{810FF32D-22A2-4D58-B129-B0590703ECEC}']
['{807F9D19-6CF4-4789-840E-93E87A12EB63}']
// 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);
procedure RegisterProcessor( const serviceName : String; const processor : IProcessor; const asDefault : Boolean = FALSE);
end;
@ -68,16 +68,17 @@ type
// the standard format, without the service name prepended to TMessage.name.
TStoredMessageProtocol = class( TProtocolDecorator)
private
FMessageBegin : IMessage;
FMessageBegin : TThriftMessage;
public
constructor Create( const protocol : IProtocol; const aMsgBegin : IMessage);
function ReadMessageBegin: IMessage; override;
constructor Create( const protocol : IProtocol; const aMsgBegin : TThriftMessage);
function ReadMessageBegin: TThriftMessage; override;
end;
private
FServiceProcessorMap : TDictionary<String, IProcessor>;
FDefaultProcessor : IProcessor;
procedure Error( const oprot : IProtocol; const msg : IMessage;
procedure Error( const oprot : IProtocol; const msg : TThriftMessage;
extype : TApplicationExceptionSpecializedClass; const etxt : string);
public
@ -87,7 +88,7 @@ type
// 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);
procedure RegisterProcessor( const serviceName : String; const processor : IProcessor; const asDefault : Boolean = FALSE);
{ This implementation of process performs the following steps:
- Read the beginning of the message.
@ -105,14 +106,14 @@ type
implementation
constructor TMultiplexedProcessorImpl.TStoredMessageProtocol.Create( const protocol : IProtocol; const aMsgBegin : IMessage);
constructor TMultiplexedProcessorImpl.TStoredMessageProtocol.Create( const protocol : IProtocol; const aMsgBegin : TThriftMessage);
begin
inherited Create( protocol);
FMessageBegin := aMsgBegin;
end;
function TMultiplexedProcessorImpl.TStoredMessageProtocol.ReadMessageBegin: IMessage;
function TMultiplexedProcessorImpl.TStoredMessageProtocol.ReadMessageBegin: TThriftMessage;
begin
result := FMessageBegin;
end;
@ -135,21 +136,27 @@ begin
end;
procedure TMultiplexedProcessorImpl.RegisterProcessor( const serviceName : String; const processor : IProcessor);
procedure TMultiplexedProcessorImpl.RegisterProcessor( const serviceName : String; const processor : IProcessor; const asDefault : Boolean);
begin
FServiceProcessorMap.Add( serviceName, processor);
if asDefault then begin
if FDefaultProcessor = nil
then FDefaultProcessor := processor
else raise TApplicationExceptionInternalError.Create('Only one default service allowed');
end;
end;
procedure TMultiplexedProcessorImpl.Error( const oprot : IProtocol; const msg : IMessage;
procedure TMultiplexedProcessorImpl.Error( const oprot : IProtocol; const msg : TThriftMessage;
extype : TApplicationExceptionSpecializedClass;
const etxt : string);
var appex : TApplicationException;
newMsg : IMessage;
newMsg : TThriftMessage;
begin
appex := extype.Create(etxt);
try
newMsg := TMessageImpl.Create( msg.Name, TMessageType.Exception, msg.SeqID);
Init( newMsg, msg.Name, TMessageType.Exception, msg.SeqID);
oprot.WriteMessageBegin(newMsg);
appex.Write(oprot);
@ -163,7 +170,7 @@ end;
function TMultiplexedProcessorImpl.Process(const iprot, oprot : IProtocol; const events : IProcessorEvents = nil): Boolean;
var msg, newMsg : IMessage;
var msg, newMsg : TThriftMessage;
idx : Integer;
sService : string;
processor : IProcessor;
@ -184,28 +191,37 @@ begin
end;
// Extract the service name
// use FDefaultProcessor as fallback if there is no separator
idx := Pos( TMultiplexedProtocol.SEPARATOR, msg.Name);
if idx < 1 then begin
if idx > 0 then begin
// 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));
Init( newMsg, Copy( msg.Name, idx, MAXINT), msg.Type_, msg.SeqID);
end
else if FDefaultProcessor <> nil then begin
processor := FDefaultProcessor;
newMsg := msg; // no need to change
end
else 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);
@ -213,4 +229,3 @@ end;
end.

110
vendor/git.apache.org/thrift.git/lib/delphi/src/Thrift.Protocol.Compact.pas generated vendored
View file

@ -123,7 +123,7 @@ type
// If we encounter a boolean field begin, save the TField here so it can
// have the value incorporated.
private booleanField_ : IField;
private booleanField_ : TThriftField;
// If we Read a field header, and it's a boolean field, save the boolean
// value here so that ReadBool can use it.
@ -148,21 +148,21 @@ type
private
// The workhorse of WriteFieldBegin. It has the option of doing a 'type override'
// of the type header. This is used specifically in the boolean field case.
procedure WriteFieldBeginInternal( const field : IField; typeOverride : Byte);
procedure WriteFieldBeginInternal( const field : TThriftField; typeOverride : Byte);
public
procedure WriteMessageBegin( const msg: IMessage); override;
procedure WriteMessageBegin( const msg: TThriftMessage); override;
procedure WriteMessageEnd; override;
procedure WriteStructBegin( const struc: IStruct); override;
procedure WriteStructBegin( const struc: TThriftStruct); override;
procedure WriteStructEnd; override;
procedure WriteFieldBegin( const field: IField); override;
procedure WriteFieldBegin( const field: TThriftField); override;
procedure WriteFieldEnd; override;
procedure WriteFieldStop; override;
procedure WriteMapBegin( const map: IMap); override;
procedure WriteMapBegin( const map: TThriftMap); override;
procedure WriteMapEnd; override;
procedure WriteListBegin( const list: IList); override;
procedure WriteListBegin( const list: TThriftList); override;
procedure WriteListEnd(); override;
procedure WriteSetBegin( const set_: ISet ); override;
procedure WriteSetBegin( const set_: TThriftSet ); override;
procedure WriteSetEnd(); override;
procedure WriteBool( b: Boolean); override;
procedure WriteByte( b: ShortInt); override;
@ -194,17 +194,17 @@ type
class procedure fixedLongToBytes( const n : Int64; var buf : TBytes);
public
function ReadMessageBegin: IMessage; override;
function ReadMessageBegin: TThriftMessage; override;
procedure ReadMessageEnd(); override;
function ReadStructBegin: IStruct; override;
function ReadStructBegin: TThriftStruct; override;
procedure ReadStructEnd; override;
function ReadFieldBegin: IField; override;
function ReadFieldBegin: TThriftField; override;
procedure ReadFieldEnd(); override;
function ReadMapBegin: IMap; override;
function ReadMapBegin: TThriftMap; override;
procedure ReadMapEnd(); override;
function ReadListBegin: IList; override;
function ReadListBegin: TThriftList; override;
procedure ReadListEnd(); override;
function ReadSetBegin: ISet; override;
function ReadSetBegin: TThriftSet; override;
procedure ReadSetEnd(); override;
function ReadBool: Boolean; override;
function ReadByte: ShortInt; override;
@ -273,7 +273,7 @@ begin
lastFieldId_ := 0;
lastField_ := TStack<Integer>.Create;
booleanField_ := nil;
Init( booleanField_, '', TType.Stop, 0);
boolValue_ := unused;
end;
@ -293,7 +293,7 @@ procedure TCompactProtocolImpl.Reset;
begin
lastField_.Clear();
lastFieldId_ := 0;
booleanField_ := nil;
Init( booleanField_, '', TType.Stop, 0);
boolValue_ := unused;
end;
@ -301,11 +301,8 @@ end;
// Writes a byte without any possibility of all that field header nonsense.
// Used internally by other writing methods that know they need to Write a byte.
procedure TCompactProtocolImpl.WriteByteDirect( const b : Byte);
var data : TBytes;
begin
SetLength( data, 1);
data[0] := b;
Transport.Write( data);
Transport.Write( @b, SizeOf(b));
end;
@ -344,7 +341,7 @@ end;
// Write a message header to the wire. Compact Protocol messages contain the
// protocol version so we can migrate forwards in the future if need be.
procedure TCompactProtocolImpl.WriteMessageBegin( const msg: IMessage);
procedure TCompactProtocolImpl.WriteMessageBegin( const msg: TThriftMessage);
var versionAndType : Byte;
begin
Reset;
@ -362,7 +359,7 @@ end;
// Write a struct begin. This doesn't actually put anything on the wire. We use it as an
// opportunity to put special placeholder markers on the field stack so we can get the
// field id deltas correct.
procedure TCompactProtocolImpl.WriteStructBegin( const struc: IStruct);
procedure TCompactProtocolImpl.WriteStructBegin( const struc: TThriftStruct);
begin
lastField_.Push(lastFieldId_);
lastFieldId_ := 0;
@ -380,7 +377,7 @@ end;
// Write a field header containing the field id and field type. If the difference between the
// current field id and the last one is small (< 15), then the field id will be encoded in
// the 4 MSB as a delta. Otherwise, the field id will follow the type header as a zigzag varint.
procedure TCompactProtocolImpl.WriteFieldBegin( const field: IField);
procedure TCompactProtocolImpl.WriteFieldBegin( const field: TThriftField);
begin
case field.Type_ of
TType.Bool_ : booleanField_ := field; // we want to possibly include the value, so we'll wait.
@ -392,7 +389,7 @@ end;
// The workhorse of WriteFieldBegin. It has the option of doing a 'type override'
// of the type header. This is used specifically in the boolean field case.
procedure TCompactProtocolImpl.WriteFieldBeginInternal( const field : IField; typeOverride : Byte);
procedure TCompactProtocolImpl.WriteFieldBeginInternal( const field : TThriftField; typeOverride : Byte);
var typeToWrite : Byte;
begin
// if there's a type override, use that.
@ -425,7 +422,7 @@ end;
// Write a map header. If the map is empty, omit the key and value type
// headers, as we don't need any additional information to skip it.
procedure TCompactProtocolImpl.WriteMapBegin( const map: IMap);
procedure TCompactProtocolImpl.WriteMapBegin( const map: TThriftMap);
var key, val : Byte;
begin
if (map.Count = 0)
@ -440,14 +437,14 @@ end;
// Write a list header.
procedure TCompactProtocolImpl.WriteListBegin( const list: IList);
procedure TCompactProtocolImpl.WriteListBegin( const list: TThriftList);
begin
WriteCollectionBegin( list.ElementType, list.Count);
end;
// Write a set header.
procedure TCompactProtocolImpl.WriteSetBegin( const set_: ISet );
procedure TCompactProtocolImpl.WriteSetBegin( const set_: TThriftSet );
begin
WriteCollectionBegin( set_.ElementType, set_.Count);
end;
@ -464,10 +461,10 @@ begin
then bt := Types.BOOLEAN_TRUE
else bt := Types.BOOLEAN_FALSE;
if booleanField_ <> nil then begin
if booleanField_.Type_ = TType.Bool_ then begin
// we haven't written the field header yet
WriteFieldBeginInternal( booleanField_, Byte(bt));
booleanField_ := nil;
booleanField_.Type_ := TType.Stop;
end
else begin
// we're not part of a field, so just Write the value.
@ -642,7 +639,7 @@ end;
// Read a message header.
function TCompactProtocolImpl.ReadMessageBegin : IMessage;
function TCompactProtocolImpl.ReadMessageBegin : TThriftMessage;
var protocolId, versionAndType, version, type_ : Byte;
seqid : Integer;
msgNm : String;
@ -663,17 +660,17 @@ begin
type_ := Byte( (versionAndType shr TYPE_SHIFT_AMOUNT) and TYPE_BITS);
seqid := Integer( ReadVarint32);
msgNm := ReadString;
result := TMessageImpl.Create( msgNm, TMessageType(type_), seqid);
Init( result, msgNm, TMessageType(type_), seqid);
end;
// Read a struct begin. There's nothing on the wire for this, but it is our
// opportunity to push a new struct begin marker onto the field stack.
function TCompactProtocolImpl.ReadStructBegin: IStruct;
function TCompactProtocolImpl.ReadStructBegin: TThriftStruct;
begin
lastField_.Push( lastFieldId_);
lastFieldId_ := 0;
result := TStructImpl.Create('');
Init( result);
end;
@ -687,7 +684,7 @@ end;
// Read a field header off the wire.
function TCompactProtocolImpl.ReadFieldBegin: IField;
function TCompactProtocolImpl.ReadFieldBegin: TThriftField;
var type_ : Byte;
fieldId, modifier : ShortInt;
begin
@ -695,7 +692,7 @@ begin
// if it's a stop, then we can return immediately, as the struct is over.
if type_ = Byte(Types.STOP) then begin
result := TFieldImpl.Create( '', TType.Stop, 0);
Init( result, '', TType.Stop, 0);
Exit;
end;
@ -705,7 +702,7 @@ begin
then fieldId := ReadI16 // not a delta. look ahead for the zigzag varint field id.
else fieldId := ShortInt( lastFieldId_ + modifier); // add the delta to the last Read field id.
result := TFieldImpl.Create( '', getTType(Byte(type_ and $0F)), fieldId);
Init( result, '', getTType(Byte(type_ and $0F)), fieldId);
// if this happens to be a boolean field, the value is encoded in the type
// save the boolean value in a special instance variable.
@ -723,7 +720,7 @@ end;
// Read a map header off the wire. If the size is zero, skip Reading the key
// and value type. This means that 0-length maps will yield TMaps without the
// "correct" types.
function TCompactProtocolImpl.ReadMapBegin: IMap;
function TCompactProtocolImpl.ReadMapBegin: TThriftMap;
var size : Integer;
keyAndValueType : Byte;
key, val : TType;
@ -735,7 +732,7 @@ begin
key := getTType( Byte( keyAndValueType shr 4));
val := getTType( Byte( keyAndValueType and $F));
result := TMapImpl.Create( key, val, size);
Init( result, key, val, size);
ASSERT( (result.KeyType = key) and (result.ValueType = val));
end;
@ -744,7 +741,7 @@ end;
// be packed into the element type header. If it's a longer list, the 4 MSB
// of the element type header will be $F, and a varint will follow with the
// true size.
function TCompactProtocolImpl.ReadListBegin: IList;
function TCompactProtocolImpl.ReadListBegin: TThriftList;
var size_and_type : Byte;
size : Integer;
type_ : TType;
@ -756,7 +753,7 @@ begin
then size := Integer( ReadVarint32);
type_ := getTType( size_and_type);
result := TListImpl.Create( type_, size);
Init( result, type_, size);
end;
@ -764,7 +761,7 @@ end;
// be packed into the element type header. If it's a longer set, the 4 MSB
// of the element type header will be $F, and a varint will follow with the
// true size.
function TCompactProtocolImpl.ReadSetBegin: ISet;
function TCompactProtocolImpl.ReadSetBegin: TThriftSet;
var size_and_type : Byte;
size : Integer;
type_ : TType;
@ -776,7 +773,7 @@ begin
then size := Integer( ReadVarint32);
type_ := getTType( size_and_type);
result := TSetImpl.Create( type_, size);
Init( result, type_, size);
end;
@ -797,11 +794,8 @@ end;
// Read a single byte off the wire. Nothing interesting here.
function TCompactProtocolImpl.ReadByte: ShortInt;
var data : TBytes;
begin
SetLength( data, 1);
Transport.ReadAll( data, 0, 1);
result := ShortInt(data[0]);
Transport.ReadAll( @result, SizeOf(result), 0, 1);
end;
@ -1094,11 +1088,29 @@ end;
{$ENDIF}
{$IFDEF Debug}
procedure UnitTest;
var w : WORD;
const FPU_CW_DENORMALIZED = $0002;
begin
w := Get8087CW;
try
Set8087CW( w or FPU_CW_DENORMALIZED);
TestDoubleToInt64Bits;
TestZigZag;
TestLongBytes;
finally
Set8087CW( w);
end;
end;
{$ENDIF}
initialization
{$IFDEF Debug}
TestDoubleToInt64Bits;
TestZigZag;
TestLongBytes;
UnitTest;
{$ENDIF}
end.

72
vendor/git.apache.org/thrift.git/lib/delphi/src/Thrift.Protocol.JSON.pas generated vendored
View file

@ -103,7 +103,7 @@ type
private
FHasData : Boolean;
FData : TBytes;
FData : Byte;
public
// Return and consume the next byte to be Read, either taking it from the
@ -169,18 +169,18 @@ type
public
// IProtocol
procedure WriteMessageBegin( const aMsg : IMessage); override;
procedure WriteMessageBegin( const aMsg : TThriftMessage); override;
procedure WriteMessageEnd; override;
procedure WriteStructBegin( const struc: IStruct); override;
procedure WriteStructBegin( const struc: TThriftStruct); override;
procedure WriteStructEnd; override;
procedure WriteFieldBegin( const field: IField); override;
procedure WriteFieldBegin( const field: TThriftField); override;
procedure WriteFieldEnd; override;
procedure WriteFieldStop; override;
procedure WriteMapBegin( const map: IMap); override;
procedure WriteMapBegin( const map: TThriftMap); override;
procedure WriteMapEnd; override;
procedure WriteListBegin( const list: IList); override;
procedure WriteListBegin( const list: TThriftList); override;
procedure WriteListEnd(); override;
procedure WriteSetBegin( const set_: ISet ); override;
procedure WriteSetBegin( const set_: TThriftSet ); override;
procedure WriteSetEnd(); override;
procedure WriteBool( b: Boolean); override;
procedure WriteByte( b: ShortInt); override;
@ -191,17 +191,17 @@ type
procedure WriteString( const s: string ); override;
procedure WriteBinary( const b: TBytes); override;
//
function ReadMessageBegin: IMessage; override;
function ReadMessageBegin: TThriftMessage; override;
procedure ReadMessageEnd(); override;
function ReadStructBegin: IStruct; override;
function ReadStructBegin: TThriftStruct; override;
procedure ReadStructEnd; override;
function ReadFieldBegin: IField; override;
function ReadFieldBegin: TThriftField; override;
procedure ReadFieldEnd(); override;
function ReadMapBegin: IMap; override;
function ReadMapBegin: TThriftMap; override;
procedure ReadMapEnd(); override;
function ReadListBegin: IList; override;
function ReadListBegin: TThriftList; override;
procedure ReadListEnd(); override;
function ReadSetBegin: ISet; override;
function ReadSetBegin: TThriftSet; override;
procedure ReadSetEnd(); override;
function ReadBool: Boolean; override;
function ReadByte: ShortInt; override;
@ -437,21 +437,19 @@ begin
if FHasData
then FHasData := FALSE
else begin
SetLength( FData, 1);
IJSONProtocol(FProto).Transport.ReadAll( FData, 0, 1);
IJSONProtocol(FProto).Transport.ReadAll( @FData, SizeOf(FData), 0, 1);
end;
result := FData[0];
result := FData;
end;
function TJSONProtocolImpl.TLookaheadReader.Peek : Byte;
begin
if not FHasData then begin
SetLength( FData, 1);
IJSONProtocol(FProto).Transport.ReadAll( FData, 0, 1);
IJSONProtocol(FProto).Transport.ReadAll( @FData, SizeOf(FData), 0, 1);
FHasData := TRUE;
end;
result := FData[0];
result := FData;
end;
@ -681,7 +679,7 @@ begin
end;
procedure TJSONProtocolImpl.WriteMessageBegin( const aMsg : IMessage);
procedure TJSONProtocolImpl.WriteMessageBegin( const aMsg : TThriftMessage);
begin
ResetContextStack; // THRIFT-1473
@ -700,7 +698,7 @@ begin
end;
procedure TJSONProtocolImpl.WriteStructBegin( const struc: IStruct);
procedure TJSONProtocolImpl.WriteStructBegin( const struc: TThriftStruct);
begin
WriteJSONObjectStart;
end;
@ -712,7 +710,7 @@ begin
end;
procedure TJSONProtocolImpl.WriteFieldBegin( const field : IField);
procedure TJSONProtocolImpl.WriteFieldBegin( const field : TThriftField);
begin
WriteJSONInteger(field.ID);
WriteJSONObjectStart;
@ -731,7 +729,7 @@ begin
// nothing to do
end;
procedure TJSONProtocolImpl.WriteMapBegin( const map: IMap);
procedure TJSONProtocolImpl.WriteMapBegin( const map: TThriftMap);
begin
WriteJSONArrayStart;
WriteJSONString( GetTypeNameForTypeID( map.KeyType));
@ -748,7 +746,7 @@ begin
end;
procedure TJSONProtocolImpl.WriteListBegin( const list: IList);
procedure TJSONProtocolImpl.WriteListBegin( const list: TThriftList);
begin
WriteJSONArrayStart;
WriteJSONString( GetTypeNameForTypeID( list.ElementType));
@ -762,7 +760,7 @@ begin
end;
procedure TJSONProtocolImpl.WriteSetBegin( const set_: ISet);
procedure TJSONProtocolImpl.WriteSetBegin( const set_: TThriftSet);
begin
WriteJSONArrayStart;
WriteJSONString( GetTypeNameForTypeID( set_.ElementType));
@ -1051,11 +1049,11 @@ begin
end;
function TJSONProtocolImpl.ReadMessageBegin: IMessage;
function TJSONProtocolImpl.ReadMessageBegin: TThriftMessage;
begin
ResetContextStack; // THRIFT-1473
result := TMessageImpl.Create;
Init( result);
ReadJSONArrayStart;
if ReadJSONInteger <> VERSION
@ -1073,10 +1071,10 @@ begin
end;
function TJSONProtocolImpl.ReadStructBegin : IStruct ;
function TJSONProtocolImpl.ReadStructBegin : TThriftStruct ;
begin
ReadJSONObjectStart;
result := TStructImpl.Create('');
Init( result);
end;
@ -1086,11 +1084,11 @@ begin
end;
function TJSONProtocolImpl.ReadFieldBegin : IField;
function TJSONProtocolImpl.ReadFieldBegin : TThriftField;
var ch : Byte;
str : string;
begin
result := TFieldImpl.Create;
Init( result);
ch := FReader.Peek;
if ch = RBRACE[0]
then result.Type_ := TType.Stop
@ -1110,10 +1108,10 @@ begin
end;
function TJSONProtocolImpl.ReadMapBegin : IMap;
function TJSONProtocolImpl.ReadMapBegin : TThriftMap;
var str : string;
begin
result := TMapImpl.Create;
Init( result);
ReadJSONArrayStart;
str := SysUtils.TEncoding.UTF8.GetString( ReadJSONString(FALSE));
@ -1134,10 +1132,10 @@ begin
end;
function TJSONProtocolImpl.ReadListBegin : IList;
function TJSONProtocolImpl.ReadListBegin : TThriftList;
var str : string;
begin
result := TListImpl.Create;
Init( result);
ReadJSONArrayStart;
str := SysUtils.TEncoding.UTF8.GetString( ReadJSONString(FALSE));
@ -1152,10 +1150,10 @@ begin
end;
function TJSONProtocolImpl.ReadSetBegin : ISet;
function TJSONProtocolImpl.ReadSetBegin : TThriftSet;
var str : string;
begin
result := TSetImpl.Create;
Init( result);
ReadJSONArrayStart;
str := SysUtils.TEncoding.UTF8.GetString( ReadJSONString(FALSE));

8
vendor/git.apache.org/thrift.git/lib/delphi/src/Thrift.Protocol.Multiplex.pas generated vendored
View file

@ -71,7 +71,7 @@ type
{ Prepends the service name to the function name, separated by SEPARATOR.
Args: The original message.
}
procedure WriteMessageBegin( const msg: IMessage); override;
procedure WriteMessageBegin( const msg: TThriftMessage); override;
end;
@ -86,14 +86,14 @@ begin
end;
procedure TMultiplexedProtocol.WriteMessageBegin( const msg: IMessage);
procedure TMultiplexedProtocol.WriteMessageBegin( const msg: TThriftMessage);
// Prepends the service name to the function name, separated by TMultiplexedProtocol.SEPARATOR.
var newMsg : IMessage;
var newMsg : TThriftMessage;
begin
case msg.Type_ of
TMessageType.Call,
TMessageType.Oneway : begin
newMsg := TMessageImpl.Create( FServiceName + SEPARATOR + msg.Name, msg.Type_, msg.SeqID);
Init( newMsg, FServiceName + SEPARATOR + msg.Name, msg.Type_, msg.SeqID);
inherited WriteMessageBegin( newMsg);
end;

757
vendor/git.apache.org/thrift.git/lib/delphi/src/Thrift.Protocol.pas generated vendored
View file

File diff suppressed because it is too large Load diff

93
vendor/git.apache.org/thrift.git/lib/delphi/src/Thrift.Stream.pas generated vendored
View file

@ -38,9 +38,11 @@ uses
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;
['{2A77D916-7446-46C1-8545-0AEC0008DBCA}']
procedure Write( const buffer: TBytes; offset: Integer; count: Integer); overload;
procedure Write( const pBuf : Pointer; offset: Integer; count: Integer); overload;
function Read( var buffer: TBytes; offset: Integer; count: Integer): Integer; overload;
function Read( const pBuf : Pointer; const buflen : Integer; offset: Integer; count: Integer): Integer; overload;
procedure Open;
procedure Close;
procedure Flush;
@ -50,10 +52,12 @@ type
TThriftStreamImpl = class( TInterfacedObject, IThriftStream)
private
procedure CheckSizeAndOffset( const buffer: TBytes; offset: Integer; count: Integer);
procedure CheckSizeAndOffset( const pBuf : Pointer; const buflen : Integer; offset: Integer; count: Integer); overload;
protected
procedure Write( const buffer: TBytes; offset: Integer; count: Integer); virtual;
function Read( var buffer: TBytes; offset: Integer; count: Integer): Integer; virtual;
procedure Write( const buffer: TBytes; offset: Integer; count: Integer); overload; inline;
procedure Write( const pBuf : Pointer; offset: Integer; count: Integer); overload; virtual;
function Read( var buffer: TBytes; offset: Integer; count: Integer): Integer; overload; inline;
function Read( const pBuf : Pointer; const buflen : Integer; offset: Integer; count: Integer): Integer; overload; virtual;
procedure Open; virtual; abstract;
procedure Close; virtual; abstract;
procedure Flush; virtual; abstract;
@ -66,8 +70,8 @@ type
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 Write( const pBuf : Pointer; offset: Integer; count: Integer); override;
function Read( const pBuf : Pointer; const buflen : Integer; offset: Integer; count: Integer): Integer; override;
procedure Open; override;
procedure Close; override;
procedure Flush; override;
@ -82,8 +86,8 @@ type
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 Write( const pBuf : Pointer; offset: Integer; count: Integer); override;
function Read( const pBuf : Pointer; const buflen : Integer; offset: Integer; count: Integer): Integer; override;
procedure Open; override;
procedure Close; override;
procedure Flush; override;
@ -127,13 +131,20 @@ begin
// nothing to do
end;
function TThriftStreamAdapterCOM.Read( var buffer: TBytes; offset: Integer; count: Integer): Integer;
function TThriftStreamAdapterCOM.Read( const pBuf : Pointer; const buflen : Integer; offset: Integer; count: Integer): Integer;
var pTmp : PByte;
begin
inherited;
if count >= buflen-offset
then count := buflen-offset;
Result := 0;
if FStream <> nil then begin
if count > 0 then begin
FStream.Read( @buffer[offset], count, @Result);
pTmp := pBuf;
Inc( pTmp, offset);
FStream.Read( pTmp, count, @Result);
end;
end;
end;
@ -162,44 +173,56 @@ begin
end;
end;
procedure TThriftStreamAdapterCOM.Write( const buffer: TBytes; offset: Integer; count: Integer);
procedure TThriftStreamAdapterCOM.Write( const pBuf: Pointer; offset: Integer; count: Integer);
var nWritten : Integer;
pTmp : PByte;
begin
inherited;
if IsOpen then begin
if count > 0 then begin
FStream.Write( @buffer[0], count, @nWritten);
pTmp := pBuf;
Inc( pTmp, offset);
FStream.Write( pTmp, count, @nWritten);
end;
end;
end;
{ TThriftStreamImpl }
procedure TThriftStreamImpl.CheckSizeAndOffset(const buffer: TBytes; offset,
count: Integer);
var
len : Integer;
procedure TThriftStreamImpl.CheckSizeAndOffset( const pBuf : Pointer; const buflen : Integer; offset: Integer; count: Integer);
begin
if count > 0 then begin
len := Length( buffer );
if (offset < 0) or ( offset >= len) then begin
if (offset < 0) or ( offset >= buflen) then begin
raise ERangeError.Create( SBitsIndexError );
end;
if count > len then begin
if count > buflen then begin
raise ERangeError.Create( SBitsIndexError );
end;
end;
end;
function TThriftStreamImpl.Read(var buffer: TBytes; offset, count: Integer): Integer;
begin
if Length(buffer) > 0
then Result := Read( @buffer[0], Length(buffer), offset, count)
else Result := 0;
end;
function TThriftStreamImpl.Read( const pBuf : Pointer; const buflen : Integer; offset: Integer; count: Integer): Integer;
begin
Result := 0;
CheckSizeAndOffset( buffer, offset, count );
CheckSizeAndOffset( pBuf, buflen, offset, count );
end;
procedure TThriftStreamImpl.Write(const buffer: TBytes; offset, count: Integer);
begin
CheckSizeAndOffset( buffer, offset, count );
if Length(buffer) > 0
then Write( @buffer[0], offset, count);
end;
procedure TThriftStreamImpl.Write( const pBuf : Pointer; offset: Integer; count: Integer);
begin
CheckSizeAndOffset( pBuf, offset+count, offset, count);
end;
{ TThriftStreamAdapterDelphi }
@ -241,14 +264,20 @@ begin
// nothing to do
end;
function TThriftStreamAdapterDelphi.Read(var buffer: TBytes; offset,
count: Integer): Integer;
function TThriftStreamAdapterDelphi.Read(const pBuf : Pointer; const buflen : Integer; offset, count: Integer): Integer;
var pTmp : PByte;
begin
inherited;
Result := 0;
if count >= buflen-offset
then count := buflen-offset;
if count > 0 then begin
Result := FStream.Read( Pointer(@buffer[offset])^, count)
end;
pTmp := pBuf;
Inc( pTmp, offset);
Result := FStream.Read( pTmp^, count)
end
else Result := 0;
end;
function TThriftStreamAdapterDelphi.ToArray: TBytes;
@ -276,12 +305,14 @@ begin
end
end;
procedure TThriftStreamAdapterDelphi.Write(const buffer: TBytes; offset,
count: Integer);
procedure TThriftStreamAdapterDelphi.Write(const pBuf : Pointer; offset, count: Integer);
var pTmp : PByte;
begin
inherited;
if count > 0 then begin
FStream.Write( Pointer(@buffer[offset])^, count)
pTmp := pBuf;
Inc( pTmp, offset);
FStream.Write( pTmp^, count)
end;
end;

217
vendor/git.apache.org/thrift.git/lib/delphi/src/Thrift.Transport.Pipes.pas generated vendored
View file

@ -48,16 +48,16 @@ type
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 Write( const pBuf : Pointer; offset, count : Integer); override;
function Read( const pBuf : Pointer; const buflen : Integer; 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 ReadDirect( const pBuf : Pointer; const buflen : Integer; offset: Integer; count: Integer): Integer; overload;
function ReadOverlapped( const pBuf : Pointer; const buflen : Integer; offset: Integer; count: Integer): Integer; overload;
procedure WriteDirect( const pBuf : Pointer; offset: Integer; count: Integer); overload;
procedure WriteOverlapped( const pBuf : Pointer; offset: Integer; count: Integer); overload;
function IsOpen: Boolean; override;
function ToArray: TBytes; override;
@ -310,37 +310,98 @@ begin
end;
procedure TPipeStreamBase.Write(const buffer: TBytes; offset, count: Integer);
procedure TPipeStreamBase.Write( const pBuf : Pointer; offset, count : Integer);
begin
if FOverlapped
then WriteOverlapped( buffer, offset, count)
else WriteDirect( buffer, offset, count);
then WriteOverlapped( pBuf, offset, count)
else WriteDirect( pBuf, offset, count);
end;
function TPipeStreamBase.Read( var buffer: TBytes; offset, count: Integer): Integer;
function TPipeStreamBase.Read( const pBuf : Pointer; const buflen : Integer; offset: Integer; count: Integer): Integer;
begin
if FOverlapped
then result := ReadOverlapped( buffer, offset, count)
else result := ReadDirect( buffer, offset, count);
then result := ReadOverlapped( pBuf, buflen, offset, count)
else result := ReadDirect( pBuf, buflen, offset, count);
end;
procedure TPipeStreamBase.WriteDirect(const buffer: TBytes; offset, count: Integer);
var cbWritten : DWORD;
procedure TPipeStreamBase.WriteDirect( const pBuf : Pointer; offset: Integer; count: Integer);
var cbWritten, nBytes : DWORD;
pData : PByte;
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');
// if necessary, send the data in chunks
// there's a system limit around 0x10000 bytes that we hit otherwise
// MSDN: "Pipe write operations across a network are limited to 65,535 bytes per write. For more information regarding pipes, see the Remarks section."
nBytes := Min( 15*4096, count); // 16 would exceed the limit
pData := pBuf;
Inc( pData, offset);
while nBytes > 0 do begin
if not WriteFile( FPipe, pData^, nBytes, cbWritten, nil)
then raise TTransportExceptionNotOpen.Create('Write to pipe failed');
Inc( pData, cbWritten);
Dec( count, cbWritten);
nBytes := Min( nBytes, count);
end;
end;
function TPipeStreamBase.ReadDirect( var buffer: TBytes; offset, count: Integer): Integer;
var cbRead, dwErr : DWORD;
procedure TPipeStreamBase.WriteOverlapped( const pBuf : Pointer; offset: Integer; count: Integer);
var cbWritten, dwWait, dwError, nBytes : DWORD;
overlapped : IOverlappedHelper;
pData : PByte;
begin
if not IsOpen
then raise TTransportExceptionNotOpen.Create('Called write on non-open pipe');
// if necessary, send the data in chunks
// there's a system limit around 0x10000 bytes that we hit otherwise
// MSDN: "Pipe write operations across a network are limited to 65,535 bytes per write. For more information regarding pipes, see the Remarks section."
nBytes := Min( 15*4096, count); // 16 would exceed the limit
pData := pBuf;
Inc( pData, offset);
while nBytes > 0 do begin
overlapped := TOverlappedHelperImpl.Create;
if not WriteFile( FPipe, pData^, nBytes, cbWritten, overlapped.OverlappedPtr)
then begin
dwError := GetLastError;
case dwError of
ERROR_IO_PENDING : begin
dwWait := overlapped.WaitFor(FTimeout);
if (dwWait = WAIT_TIMEOUT) then begin
CancelIo( FPipe); // prevents possible AV on invalid overlapped ptr
raise TTransportExceptionTimedOut.Create('Pipe write timed out');
end;
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(nBytes) = cbWritten);
Inc( pData, cbWritten);
Dec( count, cbWritten);
nBytes := Min( nBytes, count);
end;
end;
function TPipeStreamBase.ReadDirect( const pBuf : Pointer; const buflen : Integer; offset: Integer; count: Integer): Integer;
var cbRead, dwErr, nRemaining : DWORD;
bytes, retries : LongInt;
bOk : Boolean;
pData : PByte;
const INTERVAL = 10; // ms
begin
if not IsOpen
@ -373,81 +434,68 @@ begin
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;
result := 0;
nRemaining := count;
pData := pBuf;
Inc( pData, offset);
while nRemaining > 0 do begin
// read the data (or block INFINITE-ly)
bOk := ReadFile( FPipe, pData^, nRemaining, cbRead, nil);
if (not bOk) and (GetLastError() <> ERROR_MORE_DATA)
then Break; // No more data, possibly because client disconnected.
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;
Dec( nRemaining, cbRead);
Inc( pData, cbRead);
Inc( result, cbRead);
end;
ASSERT( DWORD(count) = cbWritten);
end;
function TPipeStreamBase.ReadOverlapped( var buffer: TBytes; offset, count: Integer): Integer;
var cbRead, dwWait, dwError : DWORD;
function TPipeStreamBase.ReadOverlapped( const pBuf : Pointer; const buflen : Integer; offset: Integer; count: Integer): Integer;
var cbRead, dwWait, dwError, nRemaining : DWORD;
bOk : Boolean;
overlapped : IOverlappedHelper;
pData : PByte;
begin
if not IsOpen
then raise TTransportExceptionNotOpen.Create('Called read on non-open pipe');
overlapped := TOverlappedHelperImpl.Create;
result := 0;
nRemaining := count;
pData := pBuf;
Inc( pData, offset);
while nRemaining > 0 do begin
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);
// read the data
bOk := ReadFile( FPipe, pData^, nRemaining, 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_TIMEOUT) then begin
CancelIo( FPipe); // prevents possible AV on invalid overlapped ptr
raise TTransportExceptionTimedOut.Create('Pipe read timed out');
end;
if (dwWait <> WAIT_OBJECT_0)
or not GetOverlappedResult( FPipe, overlapped.Overlapped, cbRead, TRUE)
then raise TTransportExceptionUnknown.Create('Pipe read error');
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;
else
raise TTransportExceptionUnknown.Create(SysErrorMessage(dwError));
end;
end;
ASSERT( cbRead > 0); // see TTransportImpl.ReadAll()
ASSERT( cbRead = DWORD(count));
result := cbRead;
ASSERT( cbRead > 0); // see TTransportImpl.ReadAll()
ASSERT( cbRead <= DWORD(nRemaining));
Dec( nRemaining, cbRead);
Inc( pData, cbRead);
Inc( result, cbRead);
end;
end;
@ -768,8 +816,6 @@ 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));
@ -779,12 +825,14 @@ begin
sa.lpSecurityDescriptor := sd;
sa.bInheritHandle := TRUE; //allow passing handle to child
if not CreatePipe( hCAR, hPipeW, @sa, FBufSize) then begin //create stdin pipe
Result := CreatePipe( hCAR, hPipeW, @sa, FBufSize); //create stdin pipe
if not Result 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
Result := CreatePipe( hPipe, hCAW, @sa, FBufSize); //create stdout pipe
if not Result then begin //create stdout pipe
CloseHandle( hCAR);
CloseHandle( hPipeW);
raise TTransportExceptionNotOpen.Create('TServerPipe CreatePipe (anon) failed, '+SysErrorMessage(GetLastError));
@ -795,9 +843,6 @@ begin
FClientAnonWrite := hCAW;
FReadHandle := hPipe;
FWriteHandle := hPipeW;
result := TRUE;
finally
if sd <> nil then LocalFree( Cardinal(sd));
end;
@ -835,8 +880,10 @@ begin
CreateNamedPipe;
while not FConnected do begin
if QueryStopServer
then Abort;
if QueryStopServer then begin
InternalClose;
Abort;
end;
if Assigned(fnAccepting)
then fnAccepting();

367
vendor/git.apache.org/thrift.git/lib/delphi/src/Thrift.Transport.pas generated vendored
View file

@ -39,21 +39,26 @@ uses
{$ENDIF}
{$ENDIF}
Thrift.Collections,
Thrift.Exception,
Thrift.Utils,
Thrift.Stream;
type
ITransport = interface
['{A4A9FC37-D620-44DC-AD21-662D16364CE4}']
['{DB84961E-8BB3-4532-99E1-A8C7AC2300F7}']
function GetIsOpen: Boolean;
property IsOpen: Boolean read GetIsOpen;
function Peek: Boolean;
procedure Open;
procedure Close;
function Read(var buf: TBytes; off: Integer; len: Integer): Integer;
function ReadAll(var buf: TBytes; off: Integer; len: Integer): Integer;
function Read(var buf: TBytes; off: Integer; len: Integer): Integer; overload;
function Read(const pBuf : Pointer; const buflen : Integer; off: Integer; len: Integer): Integer; overload;
function ReadAll(var buf: TBytes; off: Integer; len: Integer): Integer; overload;
function ReadAll(const pBuf : Pointer; const buflen : Integer; off: Integer; len: Integer): Integer; overload;
procedure Write( const buf: TBytes); overload;
procedure Write( const buf: TBytes; off: Integer; len: Integer); overload;
procedure Write( const pBuf : Pointer; off, len : Integer); overload;
procedure Write( const pBuf : Pointer; len : Integer); overload;
procedure Flush;
end;
@ -64,14 +69,18 @@ type
function Peek: Boolean; virtual;
procedure Open(); virtual; abstract;
procedure Close(); virtual; abstract;
function Read(var buf: TBytes; off: Integer; len: Integer): Integer; virtual; abstract;
function ReadAll(var buf: TBytes; off: Integer; len: Integer): Integer; virtual;
procedure Write( const buf: TBytes); overload; virtual;
procedure Write( const buf: TBytes; off: Integer; len: Integer); overload; virtual; abstract;
function Read(var buf: TBytes; off: Integer; len: Integer): Integer; overload; inline;
function Read(const pBuf : Pointer; const buflen : Integer; off: Integer; len: Integer): Integer; overload; virtual; abstract;
function ReadAll(var buf: TBytes; off: Integer; len: Integer): Integer; overload; inline;
function ReadAll(const pBuf : Pointer; const buflen : Integer; off: Integer; len: Integer): Integer; overload; virtual;
procedure Write( const buf: TBytes); overload; inline;
procedure Write( const buf: TBytes; off: Integer; len: Integer); overload; inline;
procedure Write( const pBuf : Pointer; len : Integer); overload; inline;
procedure Write( const pBuf : Pointer; off, len : Integer); overload; virtual; abstract;
procedure Flush; virtual;
end;
TTransportException = class( Exception )
TTransportException = class( TException)
public
type
TExceptionType = (
@ -109,14 +118,21 @@ type
TTransportExceptionInterrupted = class (TTransportExceptionSpecialized);
IHTTPClient = interface( ITransport )
['{0F5DB8AB-710D-4338-AAC9-46B5734C5057}']
['{BA142D12-8AE6-4B50-9E33-6B7843B21D73}']
procedure SetDnsResolveTimeout(const Value: Integer);
function GetDnsResolveTimeout: Integer;
procedure SetConnectionTimeout(const Value: Integer);
function GetConnectionTimeout: Integer;
procedure SetSendTimeout(const Value: Integer);
function GetSendTimeout: Integer;
procedure SetReadTimeout(const Value: Integer);
function GetReadTimeout: Integer;
function GetCustomHeaders: IThriftDictionary<string,string>;
procedure SendRequest;
property DnsResolveTimeout: Integer read GetDnsResolveTimeout write SetDnsResolveTimeout;
property ConnectionTimeout: Integer read GetConnectionTimeout write SetConnectionTimeout;
property SendTimeout: Integer read GetSendTimeout write SetSendTimeout;
property ReadTimeout: Integer read GetReadTimeout write SetReadTimeout;
property CustomHeaders: IThriftDictionary<string,string> read GetCustomHeaders;
end;
@ -126,7 +142,9 @@ type
FUri : string;
FInputStream : IThriftStream;
FOutputStream : IThriftStream;
FDnsResolveTimeout : Integer;
FConnectionTimeout : Integer;
FSendTimeout : Integer;
FReadTimeout : Integer;
FCustomHeaders : IThriftDictionary<string,string>;
@ -135,17 +153,24 @@ type
function GetIsOpen: Boolean; override;
procedure Open(); override;
procedure Close(); override;
function Read( var buf: TBytes; off: Integer; len: Integer): Integer; override;
procedure Write( const buf: TBytes; off: Integer; len: Integer); override;
function Read( const pBuf : Pointer; const buflen : Integer; off: Integer; len: Integer): Integer; override;
procedure Write( const pBuf : Pointer; off, len : Integer); override;
procedure Flush; override;
procedure SetDnsResolveTimeout(const Value: Integer);
function GetDnsResolveTimeout: Integer;
procedure SetConnectionTimeout(const Value: Integer);
function GetConnectionTimeout: Integer;
procedure SetSendTimeout(const Value: Integer);
function GetSendTimeout: Integer;
procedure SetReadTimeout(const Value: Integer);
function GetReadTimeout: Integer;
function GetCustomHeaders: IThriftDictionary<string,string>;
procedure SendRequest;
property DnsResolveTimeout: Integer read GetDnsResolveTimeout write SetDnsResolveTimeout;
property ConnectionTimeout: Integer read GetConnectionTimeout write SetConnectionTimeout;
property SendTimeout: Integer read GetSendTimeout write SetSendTimeout;
property ReadTimeout: Integer read GetReadTimeout write SetReadTimeout;
property CustomHeaders: IThriftDictionary<string,string> read GetCustomHeaders;
public
@ -193,8 +218,8 @@ type
SLEEP_TIME = 200;
{$ENDIF}
protected
procedure Write( const buffer: TBytes; offset: Integer; count: Integer); override;
function Read( var buffer: TBytes; offset: Integer; count: Integer): Integer; override;
procedure Write( const pBuf : Pointer; offset, count: Integer); override;
function Read( const pBuf : Pointer; const buflen : Integer; offset: Integer; count: Integer): Integer; override;
procedure Open; override;
procedure Close; override;
procedure Flush; override;
@ -233,8 +258,8 @@ type
procedure Open; override;
procedure Close; override;
procedure Flush; override;
function Read(var buf: TBytes; off: Integer; len: Integer): Integer; override;
procedure Write( const buf: TBytes; off: Integer; len: Integer); override;
function Read( const pBuf : Pointer; const buflen : Integer; off: Integer; len: Integer): Integer; override;
procedure Write( const pBuf : Pointer; off, len : Integer); override;
constructor Create( const AInputStream : IThriftStream; const AOutputStream : IThriftStream);
destructor Destroy; override;
end;
@ -246,8 +271,8 @@ type
FReadBuffer : TMemoryStream;
FWriteBuffer : TMemoryStream;
protected
procedure Write( const buffer: TBytes; offset: Integer; count: Integer); override;
function Read( var buffer: TBytes; offset: Integer; count: Integer): Integer; override;
procedure Write( const pBuf : Pointer; offset: Integer; count: Integer); override;
function Read( const pBuf : Pointer; const buflen : Integer; offset: Integer; count: Integer): Integer; override;
procedure Open; override;
procedure Close; override;
procedure Flush; override;
@ -299,8 +324,8 @@ type
public
procedure Open(); override;
procedure Close(); override;
function Read(var buf: TBytes; off: Integer; len: Integer): Integer; override;
procedure Write( const buf: TBytes; off: Integer; len: Integer); override;
function Read( const pBuf : Pointer; const buflen : Integer; off: Integer; len: Integer): Integer; override;
procedure Write( const pBuf : Pointer; off, len : Integer); override;
constructor Create( const ATransport : IStreamTransport ); overload;
constructor Create( const ATransport : IStreamTransport; ABufSize: Integer); overload;
property UnderlyingTransport: ITransport read GetUnderlyingTransport;
@ -377,8 +402,8 @@ type
function GetIsOpen: Boolean; override;
procedure Close(); override;
function Read(var buf: TBytes; off: Integer; len: Integer): Integer; override;
procedure Write( const buf: TBytes; off: Integer; len: Integer); override;
function Read( const pBuf : Pointer; const buflen : Integer; off: Integer; len: Integer): Integer; override;
procedure Write( const pBuf : Pointer; off, len : Integer); override;
procedure Flush; override;
end;
@ -404,38 +429,62 @@ begin
Result := IsOpen;
end;
function TTransportImpl.ReadAll( var buf: TBytes; off, len: Integer): Integer;
var
got : Integer;
ret : Integer;
function TTransportImpl.Read(var buf: TBytes; off: Integer; len: Integer): Integer;
begin
got := 0;
while got < len do begin
ret := Read( buf, off + got, len - got);
if ret > 0
then Inc( got, ret)
else raise TTransportExceptionNotOpen.Create( 'Cannot read, Remote side has closed' );
end;
Result := got;
if Length(buf) > 0
then result := Read( @buf[0], Length(buf), off, len)
else result := 0;
end;
function TTransportImpl.ReadAll(var buf: TBytes; off: Integer; len: Integer): Integer;
begin
if Length(buf) > 0
then result := ReadAll( @buf[0], Length(buf), off, len)
else result := 0;
end;
procedure TTransportImpl.Write( const buf: TBytes);
begin
Self.Write( buf, 0, Length(buf) );
if Length(buf) > 0
then Write( @buf[0], 0, Length(buf));
end;
procedure TTransportImpl.Write( const buf: TBytes; off: Integer; len: Integer);
begin
if Length(buf) > 0
then Write( @buf[0], off, len);
end;
function TTransportImpl.ReadAll(const pBuf : Pointer; const buflen : Integer; off: Integer; len: Integer): Integer;
var ret : Integer;
begin
result := 0;
while result < len do begin
ret := Read( pBuf, buflen, off + result, len - result);
if ret > 0
then Inc( result, ret)
else raise TTransportExceptionNotOpen.Create( 'Cannot read, Remote side has closed' );
end;
end;
procedure TTransportImpl.Write( const pBuf : Pointer; len : Integer);
begin
Self.Write( pBuf, 0, len);
end;
{ THTTPClientImpl }
procedure THTTPClientImpl.Close;
begin
FInputStream := nil;
FOutputStream := nil;
end;
constructor THTTPClientImpl.Create(const AUri: string);
begin
inherited Create;
FUri := AUri;
// defaults according to MSDN
FDnsResolveTimeout := 0; // no timeout
FConnectionTimeout := 60 * 1000;
FSendTimeout := 30 * 1000;
FReadTimeout := 30 * 1000;
FCustomHeaders := TThriftDictionaryImpl<string,string>.Create;
FOutputStream := TThriftStreamAdapterDelphi.Create( TMemoryStream.Create, True);
end;
@ -443,13 +492,18 @@ end;
function THTTPClientImpl.CreateRequest: IXMLHTTPRequest;
var
pair : TPair<string,string>;
srvHttp : IServerXMLHTTPRequest;
begin
{$IF CompilerVersion >= 21.0}
Result := CoXMLHTTP.Create;
Result := CoServerXMLHTTP.Create;
{$ELSE}
Result := CoXMLHTTPRequest.Create;
{$IFEND}
// setting a timeout value to 0 (zero) means "no timeout" for that setting
if Supports( result, IServerXMLHTTPRequest, srvHttp)
then srvHttp.setTimeouts( DnsResolveTimeout, ConnectionTimeout, SendTimeout, ReadTimeout);
Result.open('POST', FUri, False, '', '');
Result.setRequestHeader( 'Content-Type', 'application/x-thrift');
Result.setRequestHeader( 'Accept', 'application/x-thrift');
@ -466,14 +520,14 @@ begin
inherited;
end;
procedure THTTPClientImpl.Flush;
function THTTPClientImpl.GetDnsResolveTimeout: Integer;
begin
try
SendRequest;
finally
FOutputStream := nil;
FOutputStream := TThriftStreamAdapterDelphi.Create( TMemoryStream.Create, True);
end;
Result := FDnsResolveTimeout;
end;
procedure THTTPClientImpl.SetDnsResolveTimeout(const Value: Integer);
begin
FDnsResolveTimeout := Value;
end;
function THTTPClientImpl.GetConnectionTimeout: Integer;
@ -481,6 +535,31 @@ begin
Result := FConnectionTimeout;
end;
procedure THTTPClientImpl.SetConnectionTimeout(const Value: Integer);
begin
FConnectionTimeout := Value;
end;
function THTTPClientImpl.GetSendTimeout: Integer;
begin
Result := FSendTimeout;
end;
procedure THTTPClientImpl.SetSendTimeout(const Value: Integer);
begin
FSendTimeout := Value;
end;
function THTTPClientImpl.GetReadTimeout: Integer;
begin
Result := FReadTimeout;
end;
procedure THTTPClientImpl.SetReadTimeout(const Value: Integer);
begin
FReadTimeout := Value;
end;
function THTTPClientImpl.GetCustomHeaders: IThriftDictionary<string,string>;
begin
Result := FCustomHeaders;
@ -491,24 +570,36 @@ begin
Result := True;
end;
function THTTPClientImpl.GetReadTimeout: Integer;
begin
Result := FReadTimeout;
end;
procedure THTTPClientImpl.Open;
begin
// nothing to do
FOutputStream := TThriftStreamAdapterDelphi.Create( TMemoryStream.Create, True);
end;
function THTTPClientImpl.Read( var buf: TBytes; off, len: Integer): Integer;
procedure THTTPClientImpl.Close;
begin
FInputStream := nil;
FOutputStream := nil;
end;
procedure THTTPClientImpl.Flush;
begin
try
SendRequest;
finally
FOutputStream := nil;
FOutputStream := TThriftStreamAdapterDelphi.Create( TMemoryStream.Create, True);
ASSERT( FOutputStream <> nil);
end;
end;
function THTTPClientImpl.Read( const pBuf : Pointer; const buflen : Integer; off: Integer; len: Integer): Integer;
begin
if FInputStream = nil then begin
raise TTransportExceptionNotOpen.Create('No request has been sent');
end;
try
Result := FInputStream.Read( buf, off, len )
Result := FInputStream.Read( pBuf, buflen, off, len)
except
on E: Exception
do raise TTransportExceptionUnknown.Create(E.Message);
@ -540,19 +631,9 @@ begin
end;
end;
procedure THTTPClientImpl.SetConnectionTimeout(const Value: Integer);
procedure THTTPClientImpl.Write( const pBuf : Pointer; off, len : Integer);
begin
FConnectionTimeout := Value;
end;
procedure THTTPClientImpl.SetReadTimeout(const Value: Integer);
begin
FReadTimeout := Value
end;
procedure THTTPClientImpl.Write( const buf: TBytes; off, len: Integer);
begin
FOutputStream.Write( buf, off, len);
FOutputStream.Write( pBuf, off, len);
end;
{ TTransportException }
@ -811,8 +892,13 @@ end;
procedure TSocketImpl.Close;
begin
inherited Close;
FInputStream := nil;
FOutputStream := nil;
if FOwnsClient
then FreeAndNil( FClient);
then FreeAndNil( FClient)
else FClient := nil;
end;
function TSocketImpl.GetIsOpen: Boolean;
@ -923,22 +1009,24 @@ function TBufferedStreamImpl.IsOpen: Boolean;
begin
Result := (FWriteBuffer <> nil)
and (FReadBuffer <> nil)
and (FStream <> nil);
and (FStream <> nil)
and FStream.IsOpen;
end;
procedure TBufferedStreamImpl.Open;
begin
// nothing to do
FStream.Open;
end;
function TBufferedStreamImpl.Read( var buffer: TBytes; offset: Integer; count: Integer): Integer;
function TBufferedStreamImpl.Read( const pBuf : Pointer; const buflen : Integer; offset: Integer; count: Integer): Integer;
var
nRead : Integer;
tempbuf : TBytes;
pTmp : PByte;
begin
inherited;
Result := 0;
if IsOpen then begin
while count > 0 do begin
@ -953,8 +1041,10 @@ begin
end;
if FReadBuffer.Position < FReadBuffer.Size then begin
nRead := Min( FReadBuffer.Size - FReadBuffer.Position, count);
Inc( Result, FReadBuffer.Read( Pointer(@buffer[offset])^, nRead));
nRead := Min( FReadBuffer.Size - FReadBuffer.Position, count);
pTmp := pBuf;
Inc( pTmp, offset);
Inc( Result, FReadBuffer.Read( pTmp^, nRead));
Dec( count, nRead);
Inc( offset, nRead);
end;
@ -979,12 +1069,15 @@ begin
end;
end;
procedure TBufferedStreamImpl.Write( const buffer: TBytes; offset: Integer; count: Integer);
procedure TBufferedStreamImpl.Write( const pBuf : Pointer; offset: Integer; count: Integer);
var pTmp : PByte;
begin
inherited;
if count > 0 then begin
if IsOpen then begin
FWriteBuffer.Write( Pointer(@buffer[offset])^, count );
pTmp := pBuf;
Inc( pTmp, offset);
FWriteBuffer.Write( pTmp^, count );
if FWriteBuffer.Size > FBufSize then begin
Flush;
end;
@ -994,12 +1087,6 @@ end;
{ TStreamTransportImpl }
procedure TStreamTransportImpl.Close;
begin
FInputStream := nil;
FOutputStream := nil;
end;
constructor TStreamTransportImpl.Create( const AInputStream : IThriftStream; const AOutputStream : IThriftStream);
begin
inherited Create;
@ -1014,6 +1101,12 @@ begin
inherited;
end;
procedure TStreamTransportImpl.Close;
begin
FInputStream := nil;
FOutputStream := nil;
end;
procedure TStreamTransportImpl.Flush;
begin
if FOutputStream = nil then begin
@ -1035,7 +1128,7 @@ end;
function TStreamTransportImpl.GetOutputStream: IThriftStream;
begin
Result := FInputStream;
Result := FOutputStream;
end;
procedure TStreamTransportImpl.Open;
@ -1043,22 +1136,22 @@ begin
end;
function TStreamTransportImpl.Read(var buf: TBytes; off, len: Integer): Integer;
function TStreamTransportImpl.Read( const pBuf : Pointer; const buflen : Integer; off: Integer; len: Integer): Integer;
begin
if FInputStream = nil then begin
raise TTransportExceptionNotOpen.Create('Cannot read from null inputstream' );
end;
Result := FInputStream.Read( buf, off, len );
Result := FInputStream.Read( pBuf,buflen, off, len );
end;
procedure TStreamTransportImpl.Write(const buf: TBytes; off, len: Integer);
procedure TStreamTransportImpl.Write( const pBuf : Pointer; off, len : Integer);
begin
if FOutputStream = nil then begin
raise TTransportExceptionNotOpen.Create('Cannot write to null outputstream' );
end;
FOutputStream.Write( buf, off, len );
FOutputStream.Write( pBuf, off, len );
end;
{ TBufferedTransportImpl }
@ -1069,11 +1162,6 @@ begin
Create( ATransport, 1024 );
end;
procedure TBufferedTransportImpl.Close;
begin
FTransport.Close;
end;
constructor TBufferedTransportImpl.Create( const ATransport: IStreamTransport; ABufSize: Integer);
begin
inherited Create;
@ -1082,6 +1170,13 @@ begin
InitBuffers;
end;
procedure TBufferedTransportImpl.Close;
begin
FTransport.Close;
FInputBuffer := nil;
FOutputBuffer := nil;
end;
procedure TBufferedTransportImpl.Flush;
begin
if FOutputBuffer <> nil then begin
@ -1111,21 +1206,22 @@ end;
procedure TBufferedTransportImpl.Open;
begin
FTransport.Open
FTransport.Open;
InitBuffers; // we need to get the buffers to match FTransport substreams again
end;
function TBufferedTransportImpl.Read(var buf: TBytes; off, len: Integer): Integer;
function TBufferedTransportImpl.Read( const pBuf : Pointer; const buflen : Integer; off: Integer; len: Integer): Integer;
begin
Result := 0;
if FInputBuffer <> nil then begin
Result := FInputBuffer.Read( buf, off, len );
Result := FInputBuffer.Read( pBuf,buflen, off, len );
end;
end;
procedure TBufferedTransportImpl.Write(const buf: TBytes; off, len: Integer);
procedure TBufferedTransportImpl.Write( const pBuf : Pointer; off, len : Integer);
begin
if FOutputBuffer <> nil then begin
FOutputBuffer.Write( buf, off, len );
FOutputBuffer.Write( pBuf, off, len );
end;
end;
@ -1222,24 +1318,25 @@ begin
FTransport.Open;
end;
function TFramedTransportImpl.Read(var buf: TBytes; off, len: Integer): Integer;
var
got : Integer;
function TFramedTransportImpl.Read( const pBuf : Pointer; const buflen : Integer; off: Integer; len: Integer): Integer;
var pTmp : PByte;
begin
if FReadBuffer <> nil then begin
if len > 0
then got := FReadBuffer.Read( Pointer(@buf[off])^, len )
else got := 0;
if got > 0 then begin
Result := got;
if len > (buflen-off)
then len := buflen-off;
pTmp := pBuf;
Inc( pTmp, off);
if (FReadBuffer <> nil) and (len > 0) then begin
result := FReadBuffer.Read( pTmp^, len);
if result > 0 then begin
Exit;
end;
end;
ReadFrame;
if len > 0
then Result := FReadBuffer.Read( Pointer(@buf[off])^, len)
then Result := FReadBuffer.Read( pTmp^, len)
else Result := 0;
end;
@ -1260,14 +1357,20 @@ begin
FTransport.ReadAll( buff, 0, size );
FReadBuffer.Free;
FReadBuffer := TMemoryStream.Create;
FReadBuffer.Write( Pointer(@buff[0])^, size );
if Length(buff) > 0
then FReadBuffer.Write( Pointer(@buff[0])^, size );
FReadBuffer.Position := 0;
end;
procedure TFramedTransportImpl.Write(const buf: TBytes; off, len: Integer);
procedure TFramedTransportImpl.Write( const pBuf : Pointer; off, len : Integer);
var pTmp : PByte;
begin
if len > 0
then FWriteBuffer.Write( Pointer(@buf[off])^, len );
if len > 0 then begin
pTmp := pBuf;
Inc( pTmp, off);
FWriteBuffer.Write( pTmp^, len );
end;
end;
{ TFramedTransport.TFactory }
@ -1447,13 +1550,13 @@ end;
{$ENDIF}
{$IFDEF OLD_SOCKETS}
function TTcpSocketStreamImpl.Read(var buffer: TBytes; offset, count: Integer): Integer;
function TTcpSocketStreamImpl.Read( const pBuf : Pointer; const buflen : Integer; offset: Integer; count: Integer): Integer;
// old sockets version
var wfd : TWaitForData;
wsaError,
msecs : Integer;
nBytes : Integer;
pDest : PByte;
pTmp : PByte;
begin
inherited;
@ -1462,11 +1565,12 @@ begin
else msecs := DEFAULT_THRIFT_TIMEOUT;
result := 0;
pDest := Pointer(@buffer[offset]);
pTmp := pBuf;
Inc( pTmp, offset);
while count > 0 do begin
while TRUE do begin
wfd := WaitForData( msecs, pDest, count, wsaError, nBytes);
wfd := WaitForData( msecs, pTmp, count, wsaError, nBytes);
case wfd of
TWaitForData.wfd_Error : Exit;
TWaitForData.wfd_HaveData : Break;
@ -1490,8 +1594,8 @@ begin
msecs := Max( msecs, 200);
ASSERT( nBytes <= count);
nBytes := FTcpClient.ReceiveBuf( pDest^, nBytes);
Inc( pDest, nBytes);
nBytes := FTcpClient.ReceiveBuf( pTmp^, nBytes);
Inc( pTmp, nBytes);
Dec( count, nBytes);
Inc( result, nBytes);
end;
@ -1513,10 +1617,11 @@ begin
end;
end;
procedure TTcpSocketStreamImpl.Write(const buffer: TBytes; offset, count: Integer);
procedure TTcpSocketStreamImpl.Write( const pBuf : Pointer; offset, count: Integer);
// old sockets version
var bCanWrite, bError : Boolean;
retval, wsaError : Integer;
pTmp : PByte;
begin
inherited;
@ -1537,24 +1642,27 @@ begin
if bError or not bCanWrite
then raise TTransportExceptionUnknown.Create('unknown error');
FTcpClient.SendBuf( Pointer(@buffer[offset])^, count);
pTmp := pBuf;
Inc( pTmp, offset);
FTcpClient.SendBuf( pTmp^, count);
end;
{$ELSE}
function TTcpSocketStreamImpl.Read(var buffer: TBytes; offset, count: Integer): Integer;
function TTcpSocketStreamImpl.Read( const pBuf : Pointer; const buflen : Integer; offset: Integer; count: Integer): Integer;
// new sockets version
var nBytes : Integer;
pDest : PByte;
pTmp : PByte;
begin
inherited;
result := 0;
pDest := Pointer(@buffer[offset]);
pTmp := pBuf;
Inc( pTmp, offset);
while count > 0 do begin
nBytes := FTcpClient.Read(pDest^, count);
nBytes := FTcpClient.Read( pTmp^, count);
if nBytes = 0 then Exit;
Inc( pDest, nBytes);
Inc( pTmp, nBytes);
Dec( count, nBytes);
Inc( result, nBytes);
end;
@ -1579,15 +1687,18 @@ begin
SetLength(Result, Length(Result) - 1024 + len);
end;
procedure TTcpSocketStreamImpl.Write(const buffer: TBytes; offset, count: Integer);
procedure TTcpSocketStreamImpl.Write( const pBuf : Pointer; offset, count: Integer);
// new sockets version
var pTmp : PByte;
begin
inherited;
if not FTcpClient.IsOpen
then raise TTransportExceptionNotOpen.Create('not open');
FTcpClient.Write(buffer[offset], count);
pTmp := pBuf;
Inc( pTmp, offset);
FTcpClient.Write( pTmp^, count);
end;
{$ENDIF}

41
vendor/git.apache.org/thrift.git/lib/delphi/src/Thrift.Utils.pas generated vendored
View file

@ -69,8 +69,9 @@ type
end;
function InterlockedCompareExchange64( var Target : Int64; Exchange, Comparand : Int64) : Int64; stdcall;
function InterlockedExchangeAdd64( var Addend : Int64; Value : Int64) : Int64; stdcall;
{$IFDEF Win64}
function InterlockedExchangeAdd64( var Addend : Int64; Value : Int64) : Int64;
{$ENDIF}
implementation
@ -205,8 +206,12 @@ end;
class function CharUtils.IsHighSurrogate( const c : Char) : Boolean;
begin
{$IF CompilerVersion < 23.0}
result := Character.IsHighSurrogate( c);
{$IF CompilerVersion < 25.0}
{$IFDEF OLD_UNIT_NAMES}
result := Character.IsHighSurrogate(c);
{$ELSE}
result := System.Character.IsHighSurrogate(c);
{$ENDIF}
{$ELSE}
result := c.IsHighSurrogate();
{$IFEND}
@ -215,22 +220,31 @@ end;
class function CharUtils.IsLowSurrogate( const c : Char) : Boolean;
begin
{$IF CompilerVersion < 23.0}
result := Character.IsLowSurrogate( c);
{$IF CompilerVersion < 25.0}
{$IFDEF OLD_UNIT_NAMES}
result := Character.IsLowSurrogate(c);
{$ELSE}
result := System.Character.IsLowSurrogate(c);
{$ENDIF}
{$ELSE}
result := c.IsLowSurrogate;
result := c.IsLowSurrogate();
{$IFEND}
end;
// natively available since stone age
function InterlockedCompareExchange64;
external KERNEL32 name 'InterlockedCompareExchange64';
{$IFDEF Win64}
function InterlockedCompareExchange64( var Target : Int64; Exchange, Comparand : Int64) : Int64; inline;
begin
{$IFDEF OLD_UNIT_NAMES}
result := Windows.InterlockedCompareExchange64( Target, Exchange, Comparand);
{$ELSE}
result := WinApi.Windows.InterlockedCompareExchange64( Target, Exchange, Comparand);
{$ENDIF}
end;
// natively available >= Vista
// implemented this way since there are still some people running Windows XP :-(
function InterlockedExchangeAdd64( var Addend : Int64; Value : Int64) : Int64; stdcall;
function InterlockedExchangeAdd64( var Addend : Int64; Value : Int64) : Int64;
var old : Int64;
begin
repeat
@ -239,6 +253,7 @@ begin
result := Old;
end;
{$ENDIF}
end.

45
vendor/git.apache.org/thrift.git/lib/delphi/src/Thrift.pas generated vendored
View file

@ -22,15 +22,19 @@ unit Thrift;
interface
uses
SysUtils, Thrift.Protocol;
SysUtils,
Thrift.Exception,
Thrift.Protocol;
const
Version = '0.10.0';
Version = '1.0.0-dev';
type
TException = Thrift.Exception.TException; // compatibility alias
TApplicationExceptionSpecializedClass = class of TApplicationExceptionSpecialized;
TApplicationException = class( SysUtils.Exception )
TApplicationException = class( TException)
public
type
{$SCOPEDENUMS ON}
@ -83,31 +87,9 @@ type
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;
@ -172,10 +154,10 @@ end;
class function TApplicationException.Read( const iprot: IProtocol): TApplicationException;
var
field : IField;
field : TThriftField;
msg : string;
typ : TExceptionType;
struc : IStruct;
struc : TThriftStruct;
begin
msg := '';
typ := TExceptionType.Unknown;
@ -220,12 +202,11 @@ end;
procedure TApplicationException.Write( const oprot: IProtocol);
var
struc : IStruct;
field : IField;
struc : TThriftStruct;
field : TThriftField;
begin
struc := TStructImpl.Create( 'TApplicationException' );
field := TFieldImpl.Create;
Init(struc, 'TApplicationException');
Init(field);
oprot.WriteStructBegin( struc );
if Message <> '' then

9
vendor/git.apache.org/thrift.git/lib/delphi/src/Thrift.Console.pas → vendor/git.apache.org/thrift.git/lib/delphi/test/ConsoleHelper.pas generated vendored
View file

@ -17,7 +17,7 @@
* under the License.
*)
unit Thrift.Console;
unit ConsoleHelper;
interface
@ -99,10 +99,9 @@ begin
begin
idx := FMemo.Count - 1;
if idx < 0 then
begin
FMemo.Add( S );
end;
FMemo[idx] := FMemo[idx] + S;
FMemo.Add( S )
else
FMemo[idx] := FMemo[idx] + S;
end;
FLineBreak := bWriteLine;
end;

519
vendor/git.apache.org/thrift.git/lib/delphi/test/TestClient.pas generated vendored
View file

@ -22,15 +22,22 @@ unit TestClient;
{$I ../src/Thrift.Defines.inc}
{.$DEFINE StressTest} // activate to stress-test the server with frequent connects/disconnects
{.$DEFINE PerfTest} // activate to activate the performance test
{.$DEFINE PerfTest} // activate the performance test
{$DEFINE Exceptions} // activate the exceptions test (or disable while debugging)
{$if CompilerVersion >= 28}
{$DEFINE SupportsAsync}
{$ifend}
interface
uses
Windows, SysUtils, Classes, Math,
Windows, SysUtils, Classes, Math, ComObj, ActiveX,
{$IFDEF SupportsAsync} System.Threading, {$ENDIF}
DateUtils,
Generics.Collections,
TestConstants,
ConsoleHelper,
Thrift,
Thrift.Protocol.Compact,
Thrift.Protocol.JSON,
@ -39,8 +46,8 @@ uses
Thrift.Transport,
Thrift.Stream,
Thrift.Test,
Thrift.Collections,
Thrift.Console;
Thrift.Utils,
Thrift.Collections;
type
TThreadConsole = class
@ -52,6 +59,17 @@ type
constructor Create( AThread: TThread);
end;
TTestSetup = record
protType : TKnownProtocol;
endpoint : TEndpointTransport;
layered : TLayeredTransports;
useSSL : Boolean; // include where appropriate (TLayeredTransport?)
host : string;
port : Integer;
sPipeName : string;
hAnonRead, hAnonWrite : THandle;
end;
TClientThread = class( TThread )
private type
TTestGroup = (
@ -64,7 +82,15 @@ type
);
TTestGroups = set of TTestGroup;
TTestSize = (
Empty, // Edge case: the zero-length empty binary
Normal, // Fairly small array of usual size (256 bytes)
ByteArrayTest, // THRIFT-4454 Large writes/reads may cause range check errors in debug mode
PipeWriteLimit // THRIFT-4372 Pipe write operations across a network are limited to 65,535 bytes per write.
);
private
FSetup : TTestSetup;
FTransport : ITransport;
FProtocol : IProtocol;
FNumIteration : Integer;
@ -83,15 +109,25 @@ type
function CalculateExitCode : Byte;
procedure ClientTest;
{$IFDEF SupportsAsync}
procedure ClientAsyncTest;
{$ENDIF}
procedure InitializeProtocolTransportStack;
procedure ShutdownProtocolTransportStack;
procedure JSONProtocolReadWriteTest;
function PrepareBinaryData( aRandomDist : Boolean = FALSE) : TBytes;
function PrepareBinaryData( aRandomDist : Boolean; aSize : TTestSize) : TBytes;
{$IFDEF StressTest}
procedure StressTest(const client : TThriftTest.Iface);
{$ENDIF}
{$IFDEF Win64}
procedure UseInterlockedExchangeAdd64;
{$ENDIF}
protected
procedure Execute; override;
public
constructor Create( const ATransport: ITransport; const AProtocol : IProtocol; ANumIteration: Integer);
constructor Create( const aSetup : TTestSetup; const aNumIteration: Integer);
destructor Destroy; override;
end;
@ -172,38 +208,27 @@ end;
class function TTestClient.Execute(const args: array of string) : Byte;
var
i : Integer;
host : string;
port : Integer;
sPipeName : string;
hAnonRead, hAnonWrite : THandle;
threadExitCode : Byte;
s : string;
threads : array of TThread;
dtStart : TDateTime;
test : Integer;
thread : TThread;
trans : ITransport;
prot : IProtocol;
streamtrans : IStreamTransport;
http : IHTTPClient;
protType : TKnownProtocol;
endpoint : TEndpointTransport;
layered : TLayeredTransports;
UseSSL : Boolean; // include where appropriate (TLayeredTransport?)
const
// pipe timeouts to be used
DEBUG_TIMEOUT = 30 * 1000;
RELEASE_TIMEOUT = DEFAULT_THRIFT_TIMEOUT;
TIMEOUT = RELEASE_TIMEOUT;
setup : TTestSetup;
begin
protType := prot_Binary;
endpoint := trns_Sockets;
layered := [];
UseSSL := FALSE;
host := 'localhost';
port := 9090;
sPipeName := '';
hAnonRead := INVALID_HANDLE_VALUE;
hAnonWrite := INVALID_HANDLE_VALUE;
// init record
with setup do begin
protType := prot_Binary;
endpoint := trns_Sockets;
layered := [];
useSSL := FALSE;
host := 'localhost';
port := 9090;
sPipeName := '';
hAnonRead := INVALID_HANDLE_VALUE;
hAnonWrite := INVALID_HANDLE_VALUE;
end;
try
i := 0;
while ( i < Length(args) ) do begin
@ -218,15 +243,15 @@ begin
end
else if s = '--host' then begin
// --host arg (=localhost) Host to connect
host := args[i];
setup.host := args[i];
Inc( i);
end
else if s = '--port' then begin
// --port arg (=9090) Port number to connect
s := args[i];
Inc( i);
port := StrToIntDef(s,0);
if port <= 0 then InvalidArgs;
setup.port := StrToIntDef(s,0);
if setup.port <= 0 then InvalidArgs;
end
else if s = '--domain-socket' then begin
// --domain-socket arg Domain Socket (e.g. /tmp/ThriftTest.thrift), instead of host and port
@ -234,27 +259,29 @@ begin
end
else if s = '--named-pipe' then begin
// --named-pipe arg Windows Named Pipe (e.g. MyThriftPipe)
endpoint := trns_NamedPipes;
sPipeName := args[i];
setup.endpoint := trns_NamedPipes;
setup.sPipeName := args[i];
Inc( i);
Console.WriteLine('Using named pipe ('+setup.sPipeName+')');
end
else if s = '--anon-pipes' then begin
// --anon-pipes hRead hWrite Windows Anonymous Pipes pair (handles)
endpoint := trns_AnonPipes;
hAnonRead := THandle( StrToIntDef( args[i], Integer(INVALID_HANDLE_VALUE)));
setup.endpoint := trns_AnonPipes;
setup.hAnonRead := THandle( StrToIntDef( args[i], Integer(INVALID_HANDLE_VALUE)));
Inc( i);
hAnonWrite := THandle( StrToIntDef( args[i], Integer(INVALID_HANDLE_VALUE)));
setup.hAnonWrite := THandle( StrToIntDef( args[i], Integer(INVALID_HANDLE_VALUE)));
Inc( i);
Console.WriteLine('Using anonymous pipes ('+IntToStr(Integer(setup.hAnonRead))+' and '+IntToStr(Integer(setup.hAnonWrite))+')');
end
else if s = '--transport' then begin
// --transport arg (=sockets) Transport: buffered, framed, http, evhttp
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 = 'evhttp' then endpoint := trns_AnonPipes
if s = 'buffered' then Include( setup.layered, trns_Buffered)
else if s = 'framed' then Include( setup.layered, trns_Framed)
else if s = 'http' then setup.endpoint := trns_Http
else if s = 'evhttp' then setup.endpoint := trns_EvHttp
else InvalidArgs;
end
else if s = '--protocol' then begin
@ -262,14 +289,14 @@ begin
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
if s = 'binary' then setup.protType := prot_Binary
else if s = 'compact' then setup.protType := prot_Compact
else if s = 'json' then setup.protType := prot_JSON
else InvalidArgs;
end
else if s = '--ssl' then begin
// --ssl Encrypted Transport using SSL
UseSSL := TRUE;
setup.useSSL := TRUE;
end
else if (s = '-n') or (s = '--testloops') then begin
@ -295,7 +322,7 @@ begin
// In the anonymous pipes mode the client is launched by the test server
// -> behave nicely and allow for attaching a debugger to this process
if (endpoint = trns_AnonPipes) and not IsDebuggerPresent
if (setup.endpoint = trns_AnonPipes) and not IsDebuggerPresent
then MessageBox( 0, 'Attach Debugger and/or click OK to continue.',
'Thrift TestClient (Delphi)',
MB_OK or MB_ICONEXCLAMATION);
@ -303,78 +330,30 @@ begin
SetLength( threads, FNumThread);
dtStart := Now;
for test := 0 to FNumThread - 1 do
begin
case endpoint of
trns_Sockets: begin
Console.WriteLine('Using sockets ('+host+' port '+IntToStr(port)+')');
streamtrans := TSocketImpl.Create( host, port );
end;
// layered transports are not really meant to be stacked upon each other
if (trns_Framed in setup.layered) then begin
Console.WriteLine('Using framed transport');
end
else if (trns_Buffered in setup.layered) then begin
Console.WriteLine('Using buffered transport');
end;
trns_Http: begin
Console.WriteLine('Using HTTPClient');
http := THTTPClientImpl.Create( host);
trans := http;
end;
Console.WriteLine(THRIFT_PROTOCOLS[setup.protType]+' protocol');
trns_EvHttp: begin
raise Exception.Create(ENDPOINT_TRANSPORTS[endpoint]+' transport not implemented');
end;
trns_NamedPipes: begin
Console.WriteLine('Using named pipe ('+sPipeName+')');
streamtrans := TNamedPipeTransportClientEndImpl.Create( sPipeName, 0, nil, TIMEOUT, TIMEOUT);
end;
trns_AnonPipes: begin
Console.WriteLine('Using anonymous pipes ('+IntToStr(Integer(hAnonRead))+' and '+IntToStr(Integer(hAnonWrite))+')');
streamtrans := TAnonymousPipeTransportImpl.Create( hAnonRead, hAnonWrite, FALSE);
end;
else
raise Exception.Create('Unhandled endpoint transport');
end;
trans := streamtrans;
ASSERT( trans <> nil);
if (trns_Buffered in layered) then begin
trans := TBufferedTransportImpl.Create( streamtrans, 32); // small buffer to test read()
Console.WriteLine('Using buffered transport');
end;
if (trns_Framed in layered) then begin
trans := TFramedTransportImpl.Create( trans );
Console.WriteLine('Using framed transport');
end;
if UseSSL then begin
raise Exception.Create('SSL not implemented');
end;
// create protocol instance, default to BinaryProtocol
case protType of
prot_Binary : prot := TBinaryProtocolImpl.Create( trans, BINARY_STRICT_READ, BINARY_STRICT_WRITE);
prot_JSON : prot := TJSONProtocolImpl.Create( trans);
prot_Compact : prot := TCompactProtocolImpl.Create( trans);
else
raise Exception.Create('Unhandled protocol');
end;
ASSERT( trans <> nil);
Console.WriteLine(THRIFT_PROTOCOLS[protType]+' protocol');
thread := TClientThread.Create( trans, prot, FNumIteration);
for test := 0 to FNumThread - 1 do begin
thread := TClientThread.Create( setup, FNumIteration);
threads[test] := thread;
thread.Start;
end;
result := 0;
for test := 0 to FNumThread - 1 do begin
result := result or threads[test].WaitFor;
threadExitCode := threads[test].WaitFor;
result := result or threadExitCode;
threads[test].Free;
threads[test] := nil;
end;
for test := 0 to FNumThread - 1
do threads[test].Free;
Console.Write('Total time: ' + IntToStr( MilliSecondsBetween(Now, dtStart)));
except
@ -449,7 +428,8 @@ var
looney : IInsanity;
first_map : IThriftDictionary<TNumberz, IInsanity>;
second_map : IThriftDictionary<TNumberz, IInsanity>;
pair : TPair<TNumberz, TUserId>;
testsize : TTestSize;
begin
client := TThriftTest.TClient.Create( FProtocol);
FTransport.Open;
@ -458,6 +438,7 @@ begin
StressTest( client);
{$ENDIF StressTest}
{$IFDEF Exceptions}
// in-depth exception test
// (1) do we get an exception at all?
// (2) do we get the right exception?
@ -474,7 +455,7 @@ begin
Console.WriteLine( ' = ' + IntToStr(e.ErrorCode) + ', ' + e.Message_ );
end;
on e:TTransportException do Expect( FALSE, 'Unexpected : "'+e.ToString+'"');
on e:Exception do Expect( FALSE, 'Unexpected exception type "'+e.ClassName+'"');
on e:Exception do Expect( FALSE, 'Unexpected exception "'+e.ClassName+'": '+e.Message);
end;
// case 2: exception type NOT declared in IDL at the function call
@ -489,8 +470,8 @@ begin
on e:TApplicationException do begin
Console.WriteLine( e.ClassName+' = '+e.Message); // this is what we get
end;
on e:TException do Expect( FALSE, 'Unexpected exception type "'+e.ClassName+'"');
on e:Exception do Expect( FALSE, 'Unexpected exception type "'+e.ClassName+'"');
on e:TException do Expect( FALSE, 'Unexpected exception "'+e.ClassName+'": '+e.Message);
on e:Exception do Expect( FALSE, 'Unexpected exception "'+e.ClassName+'": '+e.Message);
end;
@ -504,8 +485,9 @@ begin
Expect( TRUE, 'testException(''something''): must not trow an exception');
except
on e:TTransportException do Expect( FALSE, 'Unexpected : "'+e.ToString+'"');
on e:Exception do Expect( FALSE, 'Unexpected exception "'+e.ClassName+'"');
on e:Exception do Expect( FALSE, 'Unexpected exception "'+e.ClassName+'": '+e.Message);
end;
{$ENDIF Exceptions}
// simple things
@ -521,6 +503,9 @@ begin
s := client.testString('Test');
Expect( s = 'Test', 'testString(''Test'') = "'+s+'"');
s := client.testString(''); // empty string
Expect( s = '', 'testString('''') = "'+s+'"');
s := client.testString(HUGE_TEST_STRING);
Expect( length(s) = length(HUGE_TEST_STRING),
'testString( length(HUGE_TEST_STRING) = '+IntToStr(Length(HUGE_TEST_STRING))+') '
@ -536,16 +521,19 @@ begin
i64 := client.testI64(-34359738368);
Expect( i64 = -34359738368, 'testI64(-34359738368) = ' + IntToStr( i64));
binOut := PrepareBinaryData( TRUE);
Console.WriteLine('testBinary('+BytesToHex(binOut)+')');
try
binIn := client.testBinary(binOut);
Expect( Length(binOut) = Length(binIn), 'testBinary(): length '+IntToStr(Length(binOut))+' = '+IntToStr(Length(binIn)));
i32 := Min( Length(binOut), Length(binIn));
Expect( CompareMem( binOut, binIn, i32), 'testBinary('+BytesToHex(binOut)+') = '+BytesToHex(binIn));
except
on e:TApplicationException do Console.WriteLine('testBinary(): '+e.Message);
on e:Exception do Expect( FALSE, 'testBinary(): Unexpected exception "'+e.ClassName+'": '+e.Message);
// random binary small
for testsize := Low(TTestSize) to High(TTestSize) do begin
binOut := PrepareBinaryData( TRUE, testsize);
Console.WriteLine('testBinary('+BytesToHex(binOut)+')');
try
binIn := client.testBinary(binOut);
Expect( Length(binOut) = Length(binIn), 'testBinary(): length '+IntToStr(Length(binOut))+' = '+IntToStr(Length(binIn)));
i32 := Min( Length(binOut), Length(binIn));
Expect( CompareMem( binOut, binIn, i32), 'testBinary('+BytesToHex(binOut)+') = '+BytesToHex(binIn));
except
on e:TApplicationException do Console.WriteLine('testBinary(): '+e.Message);
on e:Exception do Expect( FALSE, 'testBinary(): Unexpected exception "'+e.ClassName+'": '+e.Message);
end;
end;
Console.WriteLine('testDouble(5.325098235)');
@ -772,9 +760,9 @@ begin
insane.UserMap.AddOrSetValue( TNumberz.FIVE, 5000);
truck := TXtructImpl.Create;
truck.String_thing := 'Truck';
truck.Byte_thing := 8;
truck.I32_thing := 8;
truck.I64_thing := 8;
truck.Byte_thing := -8; // byte is signed
truck.I32_thing := 32;
truck.I64_thing := 64;
insane.Xtructs := TThriftListImpl<IXtruct>.Create;
insane.Xtructs.Add( truck );
whoa := client.testInsanity( insane );
@ -823,6 +811,18 @@ begin
end;
Console.WriteLine('}');
(**
* So you think you've got this all worked, out eh?
*
* Creates a the returned map with these values and prints it out:
* { 1 => { 2 => argument,
* 3 => argument,
* },
* 2 => { 6 => <empty Insanity struct>, },
* }
* @return map<UserId, map<Numberz,Insanity>> - a map with the above values
*)
// verify result data
Expect( whoa.Count = 2, 'whoa.Count = '+IntToStr(whoa.Count));
//
@ -843,31 +843,20 @@ begin
Expect( crazy.__isset_UserMap, 'crazy.__isset_UserMap = '+BoolToString(crazy.__isset_UserMap));
Expect( crazy.__isset_Xtructs, 'crazy.__isset_Xtructs = '+BoolToString(crazy.__isset_Xtructs));
Expect( crazy.UserMap.Count = 2, 'crazy.UserMap.Count = '+IntToStr(crazy.UserMap.Count));
Expect( crazy.UserMap[TNumberz.FIVE] = 5, 'crazy.UserMap[TNumberz.FIVE] = '+IntToStr(crazy.UserMap[TNumberz.FIVE]));
Expect( crazy.UserMap[TNumberz.EIGHT] = 8, 'crazy.UserMap[TNumberz.EIGHT] = '+IntToStr(crazy.UserMap[TNumberz.EIGHT]));
Expect( crazy.UserMap.Count = insane.UserMap.Count, 'crazy.UserMap.Count = '+IntToStr(crazy.UserMap.Count));
for pair in insane.UserMap do begin
Expect( crazy.UserMap[pair.Key] = pair.Value, 'crazy.UserMap['+IntToStr(Ord(pair.key))+'] = '+IntToStr(crazy.UserMap[pair.Key]));
end;
Expect( crazy.Xtructs.Count = 2, 'crazy.Xtructs.Count = '+IntToStr(crazy.Xtructs.Count));
goodbye := crazy.Xtructs[0]; // lists are ordered, so we are allowed to assume this order
hello := crazy.Xtructs[1];
Expect( goodbye.String_thing = 'Goodbye4', 'goodbye.String_thing = "'+goodbye.String_thing+'"');
Expect( goodbye.Byte_thing = 4, 'goodbye.Byte_thing = '+IntToStr(goodbye.Byte_thing));
Expect( goodbye.I32_thing = 4, 'goodbye.I32_thing = '+IntToStr(goodbye.I32_thing));
Expect( goodbye.I64_thing = 4, 'goodbye.I64_thing = '+IntToStr(goodbye.I64_thing));
Expect( goodbye.__isset_String_thing, 'goodbye.__isset_String_thing = '+BoolToString(goodbye.__isset_String_thing));
Expect( goodbye.__isset_Byte_thing, 'goodbye.__isset_Byte_thing = '+BoolToString(goodbye.__isset_Byte_thing));
Expect( goodbye.__isset_I32_thing, 'goodbye.__isset_I32_thing = '+BoolToString(goodbye.__isset_I32_thing));
Expect( goodbye.__isset_I64_thing, 'goodbye.__isset_I64_thing = '+BoolToString(goodbye.__isset_I64_thing));
Expect( hello.String_thing = 'Hello2', 'hello.String_thing = "'+hello.String_thing+'"');
Expect( hello.Byte_thing = 2, 'hello.Byte_thing = '+IntToStr(hello.Byte_thing));
Expect( hello.I32_thing = 2, 'hello.I32_thing = '+IntToStr(hello.I32_thing));
Expect( hello.I64_thing = 2, 'hello.I64_thing = '+IntToStr(hello.I64_thing));
Expect( hello.__isset_String_thing, 'hello.__isset_String_thing = '+BoolToString(hello.__isset_String_thing));
Expect( hello.__isset_Byte_thing, 'hello.__isset_Byte_thing = '+BoolToString(hello.__isset_Byte_thing));
Expect( hello.__isset_I32_thing, 'hello.__isset_I32_thing = '+BoolToString(hello.__isset_I32_thing));
Expect( hello.__isset_I64_thing, 'hello.__isset_I64_thing = '+BoolToString(hello.__isset_I64_thing));
Expect( crazy.Xtructs.Count = insane.Xtructs.Count, 'crazy.Xtructs.Count = '+IntToStr(crazy.Xtructs.Count));
for arg0 := 0 to insane.Xtructs.Count-1 do begin
hello := insane.Xtructs[arg0];
goodbye := crazy.Xtructs[arg0];
Expect( goodbye.String_thing = hello.String_thing, 'goodbye.String_thing = '+goodbye.String_thing);
Expect( goodbye.Byte_thing = hello.Byte_thing, 'goodbye.Byte_thing = '+IntToStr(goodbye.Byte_thing));
Expect( goodbye.I32_thing = hello.I32_thing, 'goodbye.I32_thing = '+IntToStr(goodbye.I32_thing));
Expect( goodbye.I64_thing = hello.I64_thing, 'goodbye.I64_thing = '+IntToStr(goodbye.I64_thing));
end;
end;
@ -907,7 +896,7 @@ begin
Expect( not i.__isset_I64_thing, 'i.__isset_I64_thing = '+BoolToString(i.__isset_I64_thing));
}
except
on e:Exception do Expect( FALSE, 'Unexpected exception "'+e.ClassName+'"');
on e:Exception do Expect( FALSE, 'Unexpected exception "'+e.ClassName+'": '+e.Message);
end;
StartTestGroup( 'testMultiException(Xception)', test_Exceptions);
@ -921,7 +910,7 @@ begin
Expect( x.ErrorCode = 1001, 'x.ErrorCode = '+IntToStr(x.ErrorCode));
Expect( x.Message_ = 'This is an Xception', 'x.Message = "'+x.Message_+'"');
end;
on e:Exception do Expect( FALSE, 'Unexpected exception "'+e.ClassName+'"');
on e:Exception do Expect( FALSE, 'Unexpected exception "'+e.ClassName+'": '+e.Message);
end;
StartTestGroup( 'testMultiException(Xception2)', test_Exceptions);
@ -941,7 +930,7 @@ begin
Expect( not x.Struct_thing.__isset_I64_thing, 'x.Struct_thing.__isset_I64_thing = '+BoolToString(x.Struct_thing.__isset_I64_thing));
}
end;
on e:Exception do Expect( FALSE, 'Unexpected exception "'+e.ClassName+'"');
on e:Exception do Expect( FALSE, 'Unexpected exception "'+e.ClassName+'": '+e.Message);
end;
@ -966,6 +955,33 @@ begin
end;
{$IFDEF SupportsAsync}
procedure TClientThread.ClientAsyncTest;
var
client : TThriftTest.IAsync;
s : string;
i8 : ShortInt;
begin
StartTestGroup( 'Async Tests', test_Unknown);
client := TThriftTest.TClient.Create( FProtocol);
FTransport.Open;
// oneway void functions
client.testOnewayAsync(1).Wait;
Expect( TRUE, 'Test Oneway(1)'); // success := no exception
// normal functions
s := client.testStringAsync(HUGE_TEST_STRING).Value;
Expect( length(s) = length(HUGE_TEST_STRING),
'testString( length(HUGE_TEST_STRING) = '+IntToStr(Length(HUGE_TEST_STRING))+') '
+'=> length(result) = '+IntToStr(Length(s)));
i8 := client.testByte(1).Value;
Expect( i8 = 1, 'testByte(1) = ' + IntToStr( i8 ));
end;
{$ENDIF}
{$IFDEF StressTest}
procedure TClientThread.StressTest(const client : TThriftTest.Iface);
begin
@ -986,33 +1002,49 @@ end;
{$ENDIF}
function TClientThread.PrepareBinaryData( aRandomDist : Boolean = FALSE) : TBytes;
var i, nextPos : Integer;
function TClientThread.PrepareBinaryData( aRandomDist : Boolean; aSize : TTestSize) : TBytes;
var i : Integer;
begin
SetLength( result, $100);
case aSize of
Empty : SetLength( result, 0);
Normal : SetLength( result, $100);
ByteArrayTest : SetLength( result, SizeOf(TByteArray) + 128);
PipeWriteLimit : SetLength( result, 65535 + 128);
else
raise EArgumentException.Create('aSize');
end;
ASSERT( Low(result) = 0);
if Length(result) = 0 then Exit;
// linear distribution, unless random is requested
if not aRandomDist then begin
for i := Low(result) to High(result) do begin
result[i] := i;
result[i] := i mod $100;
end;
Exit;
end;
// random distribution of all 256 values
FillChar( result[0], Length(result) * SizeOf(result[0]), $0);
i := 1;
while i < Length(result) do begin
nextPos := Byte( Random($100));
if result[nextPos] = 0 then begin // unused?
result[nextPos] := i;
Inc(i);
end;
for i := Low(result) to High(result) do begin
result[i] := Byte( Random($100));
end;
end;
{$IFDEF Win64}
procedure TClientThread.UseInterlockedExchangeAdd64;
var a,b : Int64;
begin
a := 1;
b := 2;
Thrift.Utils.InterlockedExchangeAdd64( a,b);
Expect( a = 3, 'InterlockedExchangeAdd64');
end;
{$ENDIF}
procedure TClientThread.JSONProtocolReadWriteTest;
// Tests only then read/write procedures of the JSON protocol
// All tests succeed, if we can read what we wrote before
@ -1020,8 +1052,8 @@ procedure TClientThread.JSONProtocolReadWriteTest;
// other clients or servers expect as the real JSON. This is beyond the scope of this test.
var prot : IProtocol;
stm : TStringStream;
list : IList;
binary, binRead : TBytes;
list : TThriftList;
binary, binRead, emptyBinary : TBytes;
i,iErr : Integer;
const
TEST_SHORT = ShortInt( $FE);
@ -1043,7 +1075,8 @@ begin
StartTestGroup( 'JsonProtocolTest', test_Unknown);
// prepare binary data
binary := PrepareBinaryData( FALSE);
binary := PrepareBinaryData( FALSE, Normal);
SetLength( emptyBinary, 0); // empty binary data block
// output setup
prot := TJSONProtocolImpl.Create(
@ -1051,7 +1084,8 @@ begin
nil, TThriftStreamAdapterDelphi.Create( stm, FALSE)));
// write
prot.WriteListBegin( TListImpl.Create( TType.String_, 9));
Init( list, TType.String_, 9);
prot.WriteListBegin( list);
prot.WriteBool( TRUE);
prot.WriteBool( FALSE);
prot.WriteByte( TEST_SHORT);
@ -1061,6 +1095,8 @@ begin
prot.WriteDouble( TEST_DOUBLE);
prot.WriteString( TEST_STRING);
prot.WriteBinary( binary);
prot.WriteString( ''); // empty string
prot.WriteBinary( emptyBinary); // empty binary data block
prot.WriteListEnd;
// input setup
@ -1083,6 +1119,8 @@ begin
Expect( abs(prot.ReadDouble-TEST_DOUBLE) < abs(DELTA_DOUBLE), 'WriteDouble/ReadDouble');
Expect( prot.ReadString = TEST_STRING, 'WriteString/ReadString');
binRead := prot.ReadBinary;
Expect( Length(prot.ReadString) = 0, 'WriteString/ReadString (empty string)');
Expect( Length(prot.ReadBinary) = 0, 'empty WriteBinary/ReadBinary (empty data block)');
prot.ReadListEnd;
// test binary data
@ -1219,12 +1257,11 @@ begin
end;
constructor TClientThread.Create( const ATransport: ITransport; const AProtocol : IProtocol; ANumIteration: Integer);
constructor TClientThread.Create( const aSetup : TTestSetup; const aNumIteration: Integer);
begin
inherited Create( True );
FSetup := aSetup;
FNumIteration := ANumIteration;
FTransport := ATransport;
FProtocol := AProtocol;
FConsole := TThreadConsole.Create( Self );
FCurrentTest := test_Unknown;
@ -1232,6 +1269,8 @@ begin
FErrors := TStringList.Create;
FErrors.Sorted := FALSE;
FErrors.Duplicates := dupAccept;
inherited Create( TRUE);
end;
destructor TClientThread.Destroy;
@ -1244,34 +1283,136 @@ end;
procedure TClientThread.Execute;
var
i : Integer;
proc : TThreadProcedure;
begin
// perform all tests
try
{$IFDEF Win64}
UseInterlockedExchangeAdd64;
{$ENDIF}
JSONProtocolReadWriteTest;
for i := 0 to FNumIteration - 1 do
begin
ClientTest;
// must be run in the context of the thread
InitializeProtocolTransportStack;
try
for i := 0 to FNumIteration - 1 do begin
ClientTest;
{$IFDEF SupportsAsync}
ClientAsyncTest;
{$ENDIF}
end;
// report the outcome
ReportResults;
SetReturnValue( CalculateExitCode);
finally
ShutdownProtocolTransportStack;
end;
except
on e:Exception do Expect( FALSE, 'unexpected exception: "'+e.message+'"');
end;
end;
// report the outcome
ReportResults;
SetReturnValue( CalculateExitCode);
// shutdown
proc := procedure
begin
if FTransport <> nil then
begin
procedure TClientThread.InitializeProtocolTransportStack;
var
streamtrans : IStreamTransport;
http : IHTTPClient;
sUrl : string;
const
DEBUG_TIMEOUT = 30 * 1000;
RELEASE_TIMEOUT = DEFAULT_THRIFT_TIMEOUT;
PIPE_TIMEOUT = RELEASE_TIMEOUT;
HTTP_TIMEOUTS = 10 * 1000;
begin
// needed for HTTP clients as they utilize the MSXML COM components
OleCheck( CoInitialize( nil));
case FSetup.endpoint of
trns_Sockets: begin
Console.WriteLine('Using sockets ('+FSetup.host+' port '+IntToStr(FSetup.port)+')');
streamtrans := TSocketImpl.Create( FSetup.host, FSetup.port );
FTransport := streamtrans;
end;
trns_Http: begin
Console.WriteLine('Using HTTPClient');
if FSetup.useSSL
then sUrl := 'http://'
else sUrl := 'https://';
sUrl := sUrl + FSetup.host;
case FSetup.port of
80 : if FSetup.useSSL then sUrl := sUrl + ':'+ IntToStr(FSetup.port);
443 : if not FSetup.useSSL then sUrl := sUrl + ':'+ IntToStr(FSetup.port);
else
if FSetup.port > 0 then sUrl := sUrl + ':'+ IntToStr(FSetup.port);
end;
http := THTTPClientImpl.Create( sUrl);
http.DnsResolveTimeout := HTTP_TIMEOUTS;
http.ConnectionTimeout := HTTP_TIMEOUTS;
http.SendTimeout := HTTP_TIMEOUTS;
http.ReadTimeout := HTTP_TIMEOUTS;
FTransport := http;
end;
trns_EvHttp: begin
raise Exception.Create(ENDPOINT_TRANSPORTS[FSetup.endpoint]+' transport not implemented');
end;
trns_NamedPipes: begin
streamtrans := TNamedPipeTransportClientEndImpl.Create( FSetup.sPipeName, 0, nil, PIPE_TIMEOUT, PIPE_TIMEOUT);
FTransport := streamtrans;
end;
trns_AnonPipes: begin
streamtrans := TAnonymousPipeTransportImpl.Create( FSetup.hAnonRead, FSetup.hAnonWrite, FALSE);
FTransport := streamtrans;
end;
else
raise Exception.Create('Unhandled endpoint transport');
end;
ASSERT( FTransport <> nil);
// layered transports are not really meant to be stacked upon each other
if (trns_Framed in FSetup.layered) then begin
FTransport := TFramedTransportImpl.Create( FTransport);
end
else if (trns_Buffered in FSetup.layered) and (streamtrans <> nil) then begin
FTransport := TBufferedTransportImpl.Create( streamtrans, 32); // small buffer to test read()
end;
if FSetup.useSSL then begin
raise Exception.Create('SSL/TLS not implemented');
end;
// create protocol instance, default to BinaryProtocol
case FSetup.protType of
prot_Binary : FProtocol := TBinaryProtocolImpl.Create( FTransport, BINARY_STRICT_READ, BINARY_STRICT_WRITE);
prot_JSON : FProtocol := TJSONProtocolImpl.Create( FTransport);
prot_Compact : FProtocol := TCompactProtocolImpl.Create( FTransport);
else
raise Exception.Create('Unhandled protocol');
end;
ASSERT( (FTransport <> nil) and (FProtocol <> nil));
end;
procedure TClientThread.ShutdownProtocolTransportStack;
begin
try
FProtocol := nil;
if FTransport <> nil then begin
FTransport.Close;
FTransport := nil;
end;
end;
Synchronize( proc );
finally
CoUninitialize;
end;
end;

43
vendor/git.apache.org/thrift.git/lib/delphi/test/TestServer.pas generated vendored
View file

@ -29,7 +29,6 @@ interface
uses
Windows, SysUtils,
Generics.Collections,
Thrift.Console,
Thrift.Server,
Thrift.Transport,
Thrift.Transport.Pipes,
@ -42,6 +41,7 @@ uses
Thrift,
TestConstants,
TestServerEvents,
ConsoleHelper,
Contnrs;
type
@ -164,7 +164,7 @@ begin
if (arg = 'TException') then
begin
raise TException.Create('');
raise TException.Create('TException');
end;
// else do not throw anything
@ -185,44 +185,33 @@ 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);
(**
* So you think you've got this all worked, out eh?
*
* Creates a the returned map with these values and prints it out:
* { 1 => { 2 => argument,
* 3 => argument,
* },
* 2 => { 6 => <empty Insanity struct>, },
* }
* @return map<UserId, map<Numberz,Insanity>> - a map with the above values
*)
first_map := TThriftDictionaryImpl<TNumberz, IInsanity>.Create;
second_map := TThriftDictionaryImpl<TNumberz, IInsanity>.Create;
first_map.AddOrSetValue( TNumberz.TWO, crazy);
first_map.AddOrSetValue( TNumberz.THREE, crazy);
first_map.AddOrSetValue( TNumberz.TWO, argument);
first_map.AddOrSetValue( TNumberz.THREE, argument);
looney := TInsanityImpl.Create;
second_map.AddOrSetValue( TNumberz.SIX, looney);
insane := TThriftDictionaryImpl<Int64, IThriftDictionary<TNumberz, IInsanity>>.Create;

2
vendor/git.apache.org/thrift.git/lib/delphi/test/TestServerEvents.pas generated vendored
View file

@ -27,7 +27,7 @@ uses
Thrift.Protocol,
Thrift.Transport,
Thrift.Server,
Thrift.Console;
ConsoleHelper;
type
TRequestEventsImpl = class( TInterfacedObject, IRequestEvents)

2
vendor/git.apache.org/thrift.git/lib/delphi/test/client.dpr generated vendored
View file

@ -29,6 +29,7 @@ uses
Thrift in '..\src\Thrift.pas',
Thrift.Transport in '..\src\Thrift.Transport.pas',
Thrift.Socket in '..\src\Thrift.Socket.pas',
Thrift.Exception in '..\src\Thrift.Exception.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',
@ -37,7 +38,6 @@ uses
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';

36
vendor/git.apache.org/thrift.git/lib/delphi/test/codegen/ReservedKeywords.thrift → vendor/git.apache.org/thrift.git/lib/delphi/test/keywords/ReservedIncluded.thrift generated vendored
View file

@ -18,38 +18,8 @@
*/
// make sure generated code does not produce name collisions with predefined keywords
namespace delphi SysUtils
const i32 integer = 42
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
}
// EOF

15
vendor/git.apache.org/thrift.git/lib/delphi/test/keywords/ReservedKeywords.dpr generated vendored Normal file
View file

@ -0,0 +1,15 @@
program ReservedKeywords;
{$APPTYPE CONSOLE}
uses
SysUtils, System_;
begin
try
{ TODO -oUser -cConsole Main : Code hier einfügen }
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
end.

138
vendor/git.apache.org/thrift.git/lib/delphi/test/keywords/ReservedKeywords.thrift generated vendored Normal file
View file

@ -0,0 +1,138 @@
/*
* 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
namespace delphi System
include "ReservedIncluded.thrift"
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
}
struct Struct_lists {
1: list<Struct_simple> init;
2: list<Struct_simple> struc;
3: list<Struct_simple> field;
4: list<Struct_simple> field_;
5: list<Struct_simple> tracker;
6: list<Struct_simple> Self;
}
struct Struct_structs {
1: Struct_simple init;
2: Struct_simple struc;
3: Struct_simple field;
4: Struct_simple field_;
5: Struct_simple tracker;
6: Struct_simple Self;
}
struct Struct_simple {
1: bool init;
2: bool struc;
3: bool field;
4: bool field_;
5: bool tracker;
6: bool Self;
}
struct Struct_strings {
1: string init;
2: string struc;
3: string field;
4: string field_;
5: string tracker;
6: string Self;
}
struct Struct_binary {
1: binary init;
2: binary struc;
3: binary field;
4: binary field_;
5: binary tracker;
6: binary Self;
}
typedef i32 IProtocol
typedef i32 ITransport
typedef i32 IFace
typedef i32 IAsync
typedef i32 System
typedef i32 SysUtils
typedef i32 Generics
typedef i32 Thrift
struct Struct_Thrift_Names {
1: IProtocol IProtocol
2: ITransport ITransport
3: IFace IFace
4: IAsync IAsync
5: System System
6: SysUtils SysUtils
7: Generics Generics
8: Thrift Thrift
}
enum Thrift4554_Enum {
Foo = 0,
Bar = 1,
Baz = 2,
}
struct Thrift4554_Struct {
1 : optional double MinValue
2 : optional double MaxValue
3 : optional bool Integer // causes issue
4 : optional Thrift4554_Enum Foo
}
// EOF

2
vendor/git.apache.org/thrift.git/lib/delphi/test/multiplexed/Multiplex.Server.Main.pas generated vendored
View file

@ -28,7 +28,6 @@ interface
uses
Windows, SysUtils,
Generics.Collections,
Thrift.Console,
Thrift.Server,
Thrift.Transport,
Thrift.Transport.Pipes,
@ -41,6 +40,7 @@ uses
Benchmark, // in gen-delphi folder
Aggr, // in gen-delphi folder
Multiplex.Test.Common,
ConsoleHelper,
Contnrs;
type

2
vendor/git.apache.org/thrift.git/lib/delphi/test/multiplexed/Multiplex.Test.Client.dpr generated vendored
View file

@ -27,6 +27,7 @@ uses
Multiplex.Client.Main in 'Multiplex.Client.Main.pas',
Thrift in '..\..\src\Thrift.pas',
Thrift.Socket in '..\..\src\Thrift.Socket.pas',
Thrift.Exception in '..\..\src\Thrift.Exception.pas',
Thrift.Transport in '..\..\src\Thrift.Transport.pas',
Thrift.Transport.Pipes in '..\..\src\Thrift.Transport.Pipes.pas',
Thrift.Protocol in '..\..\src\Thrift.Protocol.pas',
@ -34,7 +35,6 @@ uses
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';

3
vendor/git.apache.org/thrift.git/lib/delphi/test/multiplexed/Multiplex.Test.Server.dpr generated vendored
View file

@ -24,7 +24,9 @@ program Multiplex.Test.Server;
uses
SysUtils,
Multiplex.Server.Main in 'Multiplex.Server.Main.pas',
ConsoleHelper in '..\ConsoleHelper.pas',
Thrift in '..\..\src\Thrift.pas',
Thrift.Exception in '..\..\src\Thrift.Exception.pas',
Thrift.Socket in '..\..\src\Thrift.Socket.pas',
Thrift.Transport in '..\..\src\Thrift.Transport.pas',
Thrift.Transport.Pipes in '..\..\src\Thrift.Transport.Pipes.pas',
@ -33,7 +35,6 @@ uses
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';

5
vendor/git.apache.org/thrift.git/lib/delphi/test/serializer/TestSerializer.Data.pas generated vendored
View file

@ -22,6 +22,7 @@ unit TestSerializer.Data;
interface
uses
SysUtils,
Thrift.Collections,
DebugProtoTest;
@ -194,7 +195,7 @@ begin
{$IF cDebugProtoTest_Option_AnsiStr_Binary}
result.SetBase64('base64');
{$ELSE}
not yet impl
result.SetBase64( TEncoding.UTF8.GetBytes('base64'));
{$IFEND}
// byte, i16, and i64 lists are populated by default constructor
@ -338,7 +339,7 @@ begin
{$IF cDebugProtoTest_Option_AnsiStr_Binary}
result.A_binary := AnsiString( #0#1#2#3#4#5#6#7#8);
{$ELSE}
not yet impl
result.A_binary := TEncoding.UTF8.GetBytes( #0#1#2#3#4#5#6#7#8);
{$IFEND}
end;

3
vendor/git.apache.org/thrift.git/lib/delphi/test/serializer/TestSerializer.dpr generated vendored
View file

@ -24,17 +24,18 @@ program TestSerializer;
uses
Classes, Windows, SysUtils, Generics.Collections,
Thrift in '..\..\src\Thrift.pas',
Thrift.Exception in '..\..\src\Thrift.Exception.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',
System_,
DebugProtoTest,
TestSerializer.Data;

2
vendor/git.apache.org/thrift.git/lib/delphi/test/server.dpr generated vendored
View file

@ -27,6 +27,7 @@ uses
TestServerEvents in 'TestServerEvents.pas',
Thrift.Test, // in gen-delphi folder
Thrift in '..\src\Thrift.pas',
Thrift.Exception in '..\src\Thrift.Exception.pas',
Thrift.Transport in '..\src\Thrift.Transport.pas',
Thrift.Socket in '..\src\Thrift.Socket.pas',
Thrift.Transport.Pipes in '..\src\Thrift.Transport.Pipes.pas',
@ -37,7 +38,6 @@ uses
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';

6
vendor/git.apache.org/thrift.git/lib/delphi/test/skip/skiptest_version1.dpr generated vendored
View file

@ -25,13 +25,13 @@ uses
Classes, Windows, SysUtils,
Skiptest.One,
Thrift in '..\..\src\Thrift.pas',
Thrift.Exception in '..\..\src\Thrift.Exception.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';
@ -44,7 +44,7 @@ const
function CreatePing : IPing;
begin
result := TPingImpl.Create;
result.Version1 := Skiptest.One.TConstants.SKIPTESTSERVICE_VERSION;
result.Version1 := Tskiptest_version_1Constants.SKIPTESTSERVICE_VERSION;
end;
@ -179,7 +179,7 @@ const
FILE_JSON = 'pingpong.json';
begin
try
Writeln( 'Delphi SkipTest '+IntToStr(TConstants.SKIPTESTSERVICE_VERSION)+' using '+Thrift.Version);
Writeln( 'Delphi SkipTest '+IntToStr(Tskiptest_version_1Constants.SKIPTESTSERVICE_VERSION)+' using '+Thrift.Version);
Writeln;
Writeln('Binary protocol');

6
vendor/git.apache.org/thrift.git/lib/delphi/test/skip/skiptest_version2.dpr generated vendored
View file

@ -25,13 +25,13 @@ uses
Classes, Windows, SysUtils,
Skiptest.Two,
Thrift in '..\..\src\Thrift.pas',
Thrift.Exception in '..\..\src\Thrift.Exception.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';
@ -45,7 +45,7 @@ var list : IThriftList<IPong>;
set_ : IHashSet<string>;
begin
result := TPingImpl.Create;
result.Version1 := Skiptest.Two.TConstants.SKIPTESTSERVICE_VERSION;
result.Version1 := Tskiptest_version_2Constants.SKIPTESTSERVICE_VERSION;
result.BoolVal := TRUE;
result.ByteVal := 2;
result.DbVal := 3;
@ -206,7 +206,7 @@ const
FILE_JSON = 'pingpong.json';
begin
try
Writeln( 'Delphi SkipTest '+IntToStr(TConstants.SKIPTESTSERVICE_VERSION)+' using '+Thrift.Version);
Writeln( 'Delphi SkipTest '+IntToStr(Tskiptest_version_2Constants.SKIPTESTSERVICE_VERSION)+' using '+Thrift.Version);
Writeln;
Writeln('Binary protocol');

2
vendor/git.apache.org/thrift.git/lib/delphi/test/typeregistry/TestTypeRegistry.dpr generated vendored
View file

@ -25,12 +25,12 @@ uses
Classes, Windows, SysUtils, Generics.Collections, TypInfo,
Thrift in '..\..\src\Thrift.pas',
Thrift.Transport in '..\..\src\Thrift.Transport.pas',
Thrift.Exception in '..\..\src\Thrift.Exception.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',