You are viewing a plain text version of this content. The canonical link for it is here.
Posted to commits@thrift.apache.org by je...@apache.org on 2016/04/14 23:24:46 UTC
[2/2] thrift git commit: THRIFT-3788 Compatibility improvements and
Win64 support Client: Delphi Patch: Jens Geyer
THRIFT-3788 Compatibility improvements and Win64 support
Client: Delphi
Patch: Jens Geyer
Revised previous patch.
Project: http://git-wip-us.apache.org/repos/asf/thrift/repo
Commit: http://git-wip-us.apache.org/repos/asf/thrift/commit/9f7f11e7
Tree: http://git-wip-us.apache.org/repos/asf/thrift/tree/9f7f11e7
Diff: http://git-wip-us.apache.org/repos/asf/thrift/diff/9f7f11e7
Branch: refs/heads/master
Commit: 9f7f11e73ba2622397b3586468628032b1d26688
Parents: 4f5229e
Author: Jens Geyer <je...@apache.org>
Authored: Thu Apr 14 21:37:11 2016 +0200
Committer: Jens Geyer <je...@apache.org>
Committed: Thu Apr 14 23:20:52 2016 +0200
----------------------------------------------------------------------
lib/delphi/src/Thrift.Console.pas | 18 +-
lib/delphi/src/Thrift.Defines.inc | 50 ++++++
lib/delphi/src/Thrift.Serializer.pas | 12 +-
lib/delphi/src/Thrift.Server.pas | 12 +-
lib/delphi/src/Thrift.Stream.pas | 76 ++++-----
lib/delphi/src/Thrift.Transport.Pipes.pas | 56 +++----
lib/delphi/src/Thrift.Transport.pas | 224 +++++++++++--------------
lib/delphi/src/Thrift.Utils.pas | 49 +++---
lib/delphi/test/TestClient.pas | 14 +-
lib/delphi/test/TestServer.pas | 7 +-
lib/delphi/test/client.dpr | 6 +-
lib/delphi/test/server.dpr | 6 +-
12 files changed, 267 insertions(+), 263 deletions(-)
----------------------------------------------------------------------
http://git-wip-us.apache.org/repos/asf/thrift/blob/9f7f11e7/lib/delphi/src/Thrift.Console.pas
----------------------------------------------------------------------
diff --git a/lib/delphi/src/Thrift.Console.pas b/lib/delphi/src/Thrift.Console.pas
index a52eeb9..1dbb309 100644
--- a/lib/delphi/src/Thrift.Console.pas
+++ b/lib/delphi/src/Thrift.Console.pas
@@ -21,8 +21,7 @@ unit Thrift.Console;
interface
-uses
- StdCtrls;
+uses Classes;
type
TThriftConsole = class
@@ -34,13 +33,13 @@ type
TGUIConsole = class( TThriftConsole )
private
FLineBreak : Boolean;
- FMemo : TMemo;
+ FMemo : TStrings;
procedure InternalWrite( const S: string; bWriteLine: Boolean);
public
procedure Write( const S: string); override;
procedure WriteLine( const S: string); override;
- constructor Create( AMemo: TMemo);
+ constructor Create( AMemo: TStrings);
end;
function Console: TThriftConsole;
@@ -82,7 +81,7 @@ end;
{ TGUIConsole }
-constructor TGUIConsole.Create( AMemo: TMemo);
+constructor TGUIConsole.Create( AMemo: TStrings);
begin
inherited Create;
FMemo := AMemo;
@@ -95,15 +94,15 @@ var
begin
if FLineBreak then
begin
- FMemo.Lines.Add( S );
+ FMemo.Add( S );
end else
begin
- idx := FMemo.Lines.Count - 1;
+ idx := FMemo.Count - 1;
if idx < 0 then
begin
- FMemo.Lines.Add( S );
+ FMemo.Add( S );
end;
- FMemo.Lines[idx] := FMemo.Lines[idx] + S;
+ FMemo[idx] := FMemo[idx] + S;
end;
FLineBreak := bWriteLine;
end;
@@ -131,3 +130,4 @@ end;
end.
+
http://git-wip-us.apache.org/repos/asf/thrift/blob/9f7f11e7/lib/delphi/src/Thrift.Defines.inc
----------------------------------------------------------------------
diff --git a/lib/delphi/src/Thrift.Defines.inc b/lib/delphi/src/Thrift.Defines.inc
new file mode 100644
index 0000000..499ccae
--- /dev/null
+++ b/lib/delphi/src/Thrift.Defines.inc
@@ -0,0 +1,50 @@
+(*
+ * Licensed to the Apache Software Foundation (ASF) under one
+ * or more contributor license agreements. See the NOTICE file
+ * distributed with this work for additional information
+ * regarding copyright ownership. The ASF licenses this file
+ * to you under the Apache License, Version 2.0 (the
+ * "License"); you may not use this file except in compliance
+ * with the License. You may obtain a copy of the License at
+ *
+ * http://www.apache.org/licenses/LICENSE-2.0
+ *
+ * Unless required by applicable law or agreed to in writing,
+ * software distributed under the License is distributed on an
+ * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+ * KIND, either express or implied. See the License for the
+ * specific language governing permissions and limitations
+ * under the License.
+ *)
+
+
+// Good lists of Delphi version numbers
+// https://github.com/project-jedi/jedi/blob/master/jedi.inc
+// http://docwiki.embarcadero.com/RADStudio/Seattle/en/Compiler_Versions
+
+
+// start with most backwards compatible defaults
+
+{$DEFINE OLD_UNIT_NAMES}
+{$DEFINE OLD_SOCKETS} // TODO: add socket support for CompilerVersion >= 28.0
+{$UNDEF HAVE_CLASS_CTOR}
+
+
+// enable features as they are available
+
+{$IF CompilerVersion >= 21.0} // Delphi 2010
+ {$DEFINE HAVE_CLASS_CTOR}
+{$IFEND}
+
+{$IF CompilerVersion >= 23.0} // Delphi XE2
+ {$UNDEF OLD_UNIT_NAMES}
+{$IFEND}
+
+{$IF CompilerVersion >= 28.0} // Delphi XE7
+ {$UNDEF OLD_SOCKETS}
+{$IFEND}
+
+
+// EOF
+
+
http://git-wip-us.apache.org/repos/asf/thrift/blob/9f7f11e7/lib/delphi/src/Thrift.Serializer.pas
----------------------------------------------------------------------
diff --git a/lib/delphi/src/Thrift.Serializer.pas b/lib/delphi/src/Thrift.Serializer.pas
index b4d6e6d..5f2905a 100644
--- a/lib/delphi/src/Thrift.Serializer.pas
+++ b/lib/delphi/src/Thrift.Serializer.pas
@@ -18,18 +18,16 @@
*)
unit Thrift.Serializer;
-{$IF CompilerVersion >= 23.0}
- {$LEGACYIFEND ON}
-{$IFEND}
+{$I Thrift.Defines.inc}
interface
uses
- {$IF CompilerVersion < 23.0}
- Classes, Windows, SysUtils,
+ {$IFDEF OLD_UNIT_NAMES}
+ Classes, Windows, SysUtils,
{$ELSE}
- System.Classes, Winapi.Windows, System.SysUtils,
- {$IFEND}
+ System.Classes, Winapi.Windows, System.SysUtils,
+ {$ENDIF}
Thrift.Protocol,
Thrift.Transport,
Thrift.Stream;
http://git-wip-us.apache.org/repos/asf/thrift/blob/9f7f11e7/lib/delphi/src/Thrift.Server.pas
----------------------------------------------------------------------
diff --git a/lib/delphi/src/Thrift.Server.pas b/lib/delphi/src/Thrift.Server.pas
index 8d95ed2..6521444 100644
--- a/lib/delphi/src/Thrift.Server.pas
+++ b/lib/delphi/src/Thrift.Server.pas
@@ -19,19 +19,17 @@
unit Thrift.Server;
+{$I Thrift.Defines.inc}
{$I-} // prevent annoying errors with default log delegate and no console
-{$IF CompilerVersion >= 23.0}
- {$LEGACYIFEND ON}
-{$IFEND}
interface
uses
- {$IF CompilerVersion < 23.0}
- Windows, SysUtils,
+ {$IFDEF OLD_UNIT_NAMES}
+ Windows, SysUtils,
{$ELSE}
- Winapi.Windows, System.SysUtils,
- {$IFEND}
+ Winapi.Windows, System.SysUtils,
+ {$ENDIF}
Thrift,
Thrift.Protocol,
Thrift.Transport;
http://git-wip-us.apache.org/repos/asf/thrift/blob/9f7f11e7/lib/delphi/src/Thrift.Stream.pas
----------------------------------------------------------------------
diff --git a/lib/delphi/src/Thrift.Stream.pas b/lib/delphi/src/Thrift.Stream.pas
index d78afe6..7c448d8 100644
--- a/lib/delphi/src/Thrift.Stream.pas
+++ b/lib/delphi/src/Thrift.Stream.pas
@@ -19,9 +19,7 @@
unit Thrift.Stream;
-{$IF CompilerVersion >= 23.0}
- {$LEGACYIFEND ON}
-{$IFEND}
+{$I Thrift.Defines.inc}
interface
@@ -30,11 +28,11 @@ uses
SysUtils,
SysConst,
RTLConsts,
- {$IF CompilerVersion < 23.0}
- ActiveX,
+ {$IFDEF OLD_UNIT_NAMES}
+ ActiveX,
{$ELSE}
- Winapi.ActiveX,
- {$IFEND}
+ Winapi.ActiveX,
+ {$ENDIF}
Thrift.Utils;
type
@@ -112,10 +110,8 @@ end;
procedure TThriftStreamAdapterCOM.Flush;
begin
- if IsOpen then
- begin
- if FStream <> nil then
- begin
+ if IsOpen then begin
+ if FStream <> nil then begin
FStream.Commit( STGC_DEFAULT );
end;
end;
@@ -128,17 +124,15 @@ end;
procedure TThriftStreamAdapterCOM.Open;
begin
-
+ // nothing to do
end;
function TThriftStreamAdapterCOM.Read( var buffer: TBytes; offset: Integer; count: Integer): Integer;
begin
inherited;
Result := 0;
- if FStream <> nil then
- begin
- if count > 0 then
- begin
+ if FStream <> nil then begin
+ if count > 0 then begin
FStream.Read( @buffer[offset], count, @Result);
end;
end;
@@ -153,34 +147,27 @@ var
begin
FillChar( statstg, SizeOf( statstg), 0);
len := 0;
- if IsOpen then
- begin
- if Succeeded( FStream.Stat( statstg, STATFLAG_NONAME )) then
- begin
+ if IsOpen then begin
+ if Succeeded( FStream.Stat( statstg, STATFLAG_NONAME )) then begin
len := statstg.cbSize;
end;
end;
SetLength( Result, len );
- if len > 0 then
- begin
- if Succeeded( FStream.Seek( 0, STREAM_SEEK_SET, NewPos) ) then
- begin
+ if len > 0 then begin
+ if Succeeded( FStream.Seek( 0, STREAM_SEEK_SET, NewPos) ) then begin
FStream.Read( @Result[0], len, @cbRead);
end;
end;
end;
procedure TThriftStreamAdapterCOM.Write( const buffer: TBytes; offset: Integer; count: Integer);
-var
- nWritten : Integer;
+var nWritten : Integer;
begin
inherited;
- if IsOpen then
- begin
- if count > 0 then
- begin
+ if IsOpen then begin
+ if count > 0 then begin
FStream.Write( @buffer[0], count, @nWritten);
end;
end;
@@ -193,22 +180,18 @@ procedure TThriftStreamImpl.CheckSizeAndOffset(const buffer: TBytes; offset,
var
len : Integer;
begin
- if count > 0 then
- begin
+ if count > 0 then begin
len := Length( buffer );
- if (offset < 0) or ( offset >= len) then
- begin
+ if (offset < 0) or ( offset >= len) then begin
raise ERangeError.Create( SBitsIndexError );
end;
- if count > len then
- begin
+ if count > len then begin
raise ERangeError.Create( SBitsIndexError );
end;
end;
end;
-function TThriftStreamImpl.Read(var buffer: TBytes; offset,
- count: Integer): Integer;
+function TThriftStreamImpl.Read(var buffer: TBytes; offset, count: Integer): Integer;
begin
Result := 0;
CheckSizeAndOffset( buffer, offset, count );
@@ -237,16 +220,15 @@ end;
destructor TThriftStreamAdapterDelphi.Destroy;
begin
- if FOwnsStream then
- begin
- FStream.Free;
- end;
+ if FOwnsStream
+ then Close;
+
inherited;
end;
procedure TThriftStreamAdapterDelphi.Flush;
begin
-
+ // nothing to do
end;
function TThriftStreamAdapterDelphi.IsOpen: Boolean;
@@ -256,7 +238,7 @@ end;
procedure TThriftStreamAdapterDelphi.Open;
begin
-
+ // nothing to do
end;
function TThriftStreamAdapterDelphi.Read(var buffer: TBytes; offset,
@@ -264,8 +246,7 @@ function TThriftStreamAdapterDelphi.Read(var buffer: TBytes; offset,
begin
inherited;
Result := 0;
- if count > 0 then
- begin
+ if count > 0 then begin
Result := FStream.Read( Pointer(@buffer[offset])^, count)
end;
end;
@@ -299,8 +280,7 @@ procedure TThriftStreamAdapterDelphi.Write(const buffer: TBytes; offset,
count: Integer);
begin
inherited;
- if count > 0 then
- begin
+ if count > 0 then begin
FStream.Write( Pointer(@buffer[offset])^, count)
end;
end;
http://git-wip-us.apache.org/repos/asf/thrift/blob/9f7f11e7/lib/delphi/src/Thrift.Transport.Pipes.pas
----------------------------------------------------------------------
diff --git a/lib/delphi/src/Thrift.Transport.Pipes.pas b/lib/delphi/src/Thrift.Transport.Pipes.pas
index 9e62341..a11bdc1 100644
--- a/lib/delphi/src/Thrift.Transport.Pipes.pas
+++ b/lib/delphi/src/Thrift.Transport.Pipes.pas
@@ -19,18 +19,16 @@
unit Thrift.Transport.Pipes;
{$WARN SYMBOL_PLATFORM OFF}
-{$IF CompilerVersion >= 23.0}
- {$LEGACYIFEND ON}
-{$IFEND}
+{$I Thrift.Defines.inc}
interface
uses
-{$IF CompilerVersion < 23.0}
+ {$IFDEF OLD_UNIT_NAMES}
Windows, SysUtils, Math, AccCtrl, AclAPI, SyncObjs,
-{$ELSE}
+ {$ELSE}
Winapi.Windows, System.SysUtils, System.Math, Winapi.AccCtrl, Winapi.AclAPI, System.SyncObjs,
-{$IFEND}
+ {$ENDIF}
Thrift.Transport,
Thrift.Utils,
Thrift.Stream;
@@ -903,14 +901,9 @@ end;
function TNamedPipeServerTransportImpl.Handle : THandle;
-{$IFDEF WIN64}
-var
- Hndl: Integer;
-{$ENDIF}
begin
{$IFDEF WIN64}
- Hndl := Integer(FHandle);
- result := THandle( InterlockedExchangeAdd( Hndl, 0));
+ result := THandle( InterlockedExchangeAdd64( Int64(FHandle), 0));
{$ELSE}
result := THandle( InterlockedExchangeAdd( Integer(FHandle), 0));
{$ENDIF}
@@ -958,29 +951,22 @@ begin
sa.bInheritHandle := FALSE;
// Create an instance of the named pipe
-{$IF CompilerVersion < 23.0}
- result := Windows.CreateNamedPipe( PChar( FPipeName), // pipe name
- PIPE_ACCESS_DUPLEX or // read/write access
- FILE_FLAG_OVERLAPPED, // async mode
- PIPE_TYPE_BYTE or // byte type pipe
- PIPE_READMODE_BYTE, // byte read mode
- FMaxConns, // max. instances
- FBufSize, // output buffer size
- FBufSize, // input buffer size
- FTimeout, // time-out, see MSDN
- @sa); // default security attribute
-{$ELSE}
- result := Winapi.Windows.CreateNamedPipe( PChar( FPipeName), // pipe name
- PIPE_ACCESS_DUPLEX or // read/write access
- FILE_FLAG_OVERLAPPED, // async mode
- PIPE_TYPE_BYTE or // byte type pipe
- PIPE_READMODE_BYTE, // byte read mode
- FMaxConns, // max. instances
- FBufSize, // output buffer size
- FBufSize, // input buffer size
- FTimeout, // time-out, see MSDN
- @sa); // default security attribute
-{$IFEND}
+ {$IFDEF OLD_UNIT_NAMES}
+ result := Windows.CreateNamedPipe(
+ {$ELSE}
+ result := Winapi.Windows.CreateNamedPipe(
+ {$ENDIF}
+ PChar( FPipeName), // pipe name
+ PIPE_ACCESS_DUPLEX or // read/write access
+ FILE_FLAG_OVERLAPPED, // async mode
+ PIPE_TYPE_BYTE or // byte type pipe
+ PIPE_READMODE_BYTE, // byte read mode
+ FMaxConns, // max. instances
+ FBufSize, // output buffer size
+ FBufSize, // input buffer size
+ FTimeout, // time-out, see MSDN
+ @sa // default security attribute
+ );
if( result <> INVALID_HANDLE_VALUE)
then InterlockedExchangePointer( Pointer(FHandle), Pointer(result))
http://git-wip-us.apache.org/repos/asf/thrift/blob/9f7f11e7/lib/delphi/src/Thrift.Transport.pas
----------------------------------------------------------------------
diff --git a/lib/delphi/src/Thrift.Transport.pas b/lib/delphi/src/Thrift.Transport.pas
index c0f3111..e005d4f 100644
--- a/lib/delphi/src/Thrift.Transport.pas
+++ b/lib/delphi/src/Thrift.Transport.pas
@@ -16,18 +16,10 @@
* specific language governing permissions and limitations
* under the License.
*)
+unit Thrift.Transport;
+{$I Thrift.Defines.inc}
{$SCOPEDENUMS ON}
-{$IF CompilerVersion >= 23.0}
- {$LEGACYIFEND ON}
-{$IFEND}
-
-{$IF CompilerVersion < 28.0}
- {$DEFINE OLD_SOCKETS} // TODO: add socket support for CompilerVersion >= 28.0
-{$IFEND}
-
-
-unit Thrift.Transport;
interface
@@ -36,16 +28,16 @@ uses
SysUtils,
Math,
Generics.Collections,
-{$IF CompilerVersion < 23.0}
- ActiveX, msxml, WinSock, Sockets,
-{$ELSE}
- Winapi.ActiveX, Winapi.msxml, Winapi.WinSock,
- {$IF CompilerVersion < 28.0}
- Web.Win.Sockets,
+ {$IFDEF OLD_UNIT_NAMES}
+ ActiveX, msxml, WinSock, Sockets,
{$ELSE}
- System.Win.ScktComp,
- {$IFEND}
-{$IFEND}
+ Winapi.ActiveX, Winapi.msxml, Winapi.WinSock,
+ {$IFDEF OLD_SOCKETS}
+ Web.Win.Sockets,
+ {$ELSE}
+ System.Win.ScktComp,
+ {$ENDIF}
+ {$ENDIF}
Thrift.Collections,
Thrift.Utils,
Thrift.Stream;
@@ -333,9 +325,10 @@ type
function GetTransport( const ATrans: ITransport): ITransport; override;
end;
-{$IF CompilerVersion >= 21.0}
+ {$IFDEF HAVE_CLASS_CTOR}
class constructor Create;
-{$IFEND}
+ {$ENDIF}
+
constructor Create; overload;
constructor Create( const ATrans: ITransport); overload;
destructor Destroy; override;
@@ -349,9 +342,9 @@ type
procedure Flush; override;
end;
-{$IF CompilerVersion < 21.0}
+{$IFNDEF HAVE_CLASS_CTOR}
procedure TFramedTransportImpl_Initialize;
-{$IFEND}
+{$ENDIF}
const
DEFAULT_THRIFT_TIMEOUT = 5 * 1000; // ms
@@ -363,7 +356,7 @@ implementation
procedure TTransportImpl.Flush;
begin
-
+ // nothing to do
end;
function TTransportImpl.Peek: Boolean;
@@ -377,14 +370,11 @@ var
ret : Integer;
begin
got := 0;
- while ( got < len) do
- begin
+ while got < len do begin
ret := Read( buf, off + got, len - got);
- if ( ret <= 0 ) then
- begin
- raise TTransportException.Create( 'Cannot read, Remote side has closed' );
- end;
- got := got + ret;
+ if ret > 0
+ then Inc( got, ret)
+ else raise TTransportException.Create( 'Cannot read, Remote side has closed' );
end;
Result := got;
end;
@@ -414,19 +404,18 @@ function THTTPClientImpl.CreateRequest: IXMLHTTPRequest;
var
pair : TPair<string,string>;
begin
-{$IF CompilerVersion >= 21.0}
+ {$IF CompilerVersion >= 21.0}
Result := CoXMLHTTP.Create;
-{$ELSE}
+ {$ELSE}
Result := CoXMLHTTPRequest.Create;
-{$IFEND}
+ {$IFEND}
Result.open('POST', FUri, False, '', '');
Result.setRequestHeader( 'Content-Type', 'application/x-thrift');
Result.setRequestHeader( 'Accept', 'application/x-thrift');
Result.setRequestHeader( 'User-Agent', 'Delphi/IHTTPClient');
- for pair in FCustomHeaders do
- begin
+ for pair in FCustomHeaders do begin
Result.setRequestHeader( pair.Key, pair.Value );
end;
end;
@@ -469,7 +458,7 @@ end;
procedure THTTPClientImpl.Open;
begin
-
+ // nothing to do
end;
function THTTPClientImpl.Read( var buf: TBytes; off, len: Integer): Integer;
@@ -500,8 +489,7 @@ begin
try
a := FOutputStream.ToArray;
len := Length(a);
- if len > 0 then
- begin
+ if len > 0 then begin
ms.WriteBuffer( Pointer(@a[0])^, len);
end;
ms.Position := 0;
@@ -574,11 +562,11 @@ begin
FOwnsServer := True;
FServer := TThriftTcpServer.Create( nil );
FServer.BlockMode := bmBlocking;
-{$IF CompilerVersion >= 21.0}
+ {$IF CompilerVersion >= 21.0}
FServer.LocalPort := AnsiString( IntToStr( FPort));
-{$ELSE}
+ {$ELSE}
FServer.LocalPort := IntToStr( FPort);
-{$IFEND}
+ {$IFEND}
end;
destructor TServerSocketImpl.Destroy;
@@ -640,10 +628,8 @@ begin
try
FServer.Active := True;
except
- on E: Exception do
- begin
- raise TTransportException.Create('Could not accept on listening socket: ' + E.Message);
- end;
+ on E: Exception
+ do raise TTransportException.Create('Could not accept on listening socket: ' + E.Message);
end;
end;
end;
@@ -778,11 +764,9 @@ var
buf : TBytes;
len : Integer;
begin
- if IsOpen then
- begin
+ if IsOpen then begin
len := FWriteBuffer.Size;
- if len > 0 then
- begin
+ if len > 0 then begin
SetLength( buf, len );
FWriteBuffer.Position := 0;
FWriteBuffer.Read( Pointer(@buf[0])^, len );
@@ -801,7 +785,7 @@ end;
procedure TBufferedStreamImpl.Open;
begin
-
+ // nothing to do
end;
function TBufferedStreamImpl.Read( var buffer: TBytes; offset: Integer; count: Integer): Integer;
@@ -811,12 +795,11 @@ var
begin
inherited;
Result := 0;
- if IsOpen then
- begin
+
+ if IsOpen then begin
while count > 0 do begin
- if FReadBuffer.Position >= FReadBuffer.Size then
- begin
+ if FReadBuffer.Position >= FReadBuffer.Size then begin
FReadBuffer.Clear;
SetLength( tempbuf, FBufSize);
nRead := FStream.Read( tempbuf, 0, FBufSize );
@@ -826,8 +809,7 @@ begin
FReadBuffer.Position := 0;
end;
- if FReadBuffer.Position < FReadBuffer.Size then
- begin
+ if FReadBuffer.Position < FReadBuffer.Size then begin
nRead := Min( FReadBuffer.Size - FReadBuffer.Position, count);
Inc( Result, FReadBuffer.Read( Pointer(@buffer[offset])^, nRead));
Dec( count, nRead);
@@ -838,20 +820,17 @@ begin
end;
function TBufferedStreamImpl.ToArray: TBytes;
-var
- len : Integer;
+var len : Integer;
begin
len := 0;
- if IsOpen then
- begin
+ if IsOpen then begin
len := FReadBuffer.Size;
end;
SetLength( Result, len);
- if len > 0 then
- begin
+ if len > 0 then begin
FReadBuffer.Position := 0;
FReadBuffer.Read( Pointer(@Result[0])^, len );
end;
@@ -860,13 +839,10 @@ end;
procedure TBufferedStreamImpl.Write( const buffer: TBytes; offset: Integer; count: Integer);
begin
inherited;
- if count > 0 then
- begin
- if IsOpen then
- begin
+ if count > 0 then begin
+ if IsOpen then begin
FWriteBuffer.Write( Pointer(@buffer[offset])^, count );
- if FWriteBuffer.Size > FBufSize then
- begin
+ if FWriteBuffer.Size > FBufSize then begin
Flush;
end;
end;
@@ -958,8 +934,7 @@ begin
FTransport.Close;
end;
-constructor TBufferedTransportImpl.Create( const ATransport: IStreamTransport;
- ABufSize: Integer);
+constructor TBufferedTransportImpl.Create( const ATransport: IStreamTransport; ABufSize: Integer);
begin
inherited Create;
FTransport := ATransport;
@@ -969,8 +944,7 @@ end;
procedure TBufferedTransportImpl.Flush;
begin
- if FOutputBuffer <> nil then
- begin
+ if FOutputBuffer <> nil then begin
FOutputBuffer.Flush;
end;
end;
@@ -987,12 +961,10 @@ end;
procedure TBufferedTransportImpl.InitBuffers;
begin
- if FTransport.InputStream <> nil then
- begin
+ if FTransport.InputStream <> nil then begin
FInputBuffer := TBufferedStreamImpl.Create( FTransport.InputStream, FBufSize );
end;
- if FTransport.OutputStream <> nil then
- begin
+ if FTransport.OutputStream <> nil then begin
FOutputBuffer := TBufferedStreamImpl.Create( FTransport.OutputStream, FBufSize );
end;
end;
@@ -1005,36 +977,34 @@ end;
function TBufferedTransportImpl.Read(var buf: TBytes; off, len: Integer): Integer;
begin
Result := 0;
- if FInputBuffer <> nil then
- begin
+ if FInputBuffer <> nil then begin
Result := FInputBuffer.Read( buf, off, len );
end;
end;
procedure TBufferedTransportImpl.Write(const buf: TBytes; off, len: Integer);
begin
- if FOutputBuffer <> nil then
- begin
+ if FOutputBuffer <> nil then begin
FOutputBuffer.Write( buf, off, len );
end;
end;
{ TFramedTransportImpl }
-{$IF CompilerVersion < 21.0}
+{$IFDEF HAVE_CLASS_CTOR}
+class constructor TFramedTransportImpl.Create;
+begin
+ SetLength( FHeader_Dummy, FHeaderSize);
+ FillChar( FHeader_Dummy[0], Length( FHeader_Dummy) * SizeOf( Byte ), 0);
+end;
+{$ELSE}
procedure TFramedTransportImpl_Initialize;
begin
SetLength( TFramedTransportImpl.FHeader_Dummy, TFramedTransportImpl.FHeaderSize);
FillChar( TFramedTransportImpl.FHeader_Dummy[0],
Length( TFramedTransportImpl.FHeader_Dummy) * SizeOf( Byte ), 0);
end;
-{$ELSE}
-class constructor TFramedTransportImpl.Create;
-begin
- SetLength( FHeader_Dummy, FHeaderSize);
- FillChar( FHeader_Dummy[0], Length( FHeader_Dummy) * SizeOf( Byte ), 0);
-end;
-{$IFEND}
+{$ENDIF}
constructor TFramedTransportImpl.Create;
begin
@@ -1070,8 +1040,7 @@ var
begin
len := FWriteBuffer.Size;
SetLength( buf, len);
- if len > 0 then
- begin
+ if len > 0 then begin
System.Move( FWriteBuffer.Memory^, buf[0], len );
end;
@@ -1118,13 +1087,12 @@ function TFramedTransportImpl.Read(var buf: TBytes; off, len: Integer): Integer;
var
got : Integer;
begin
- if FReadBuffer <> nil then
- 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
+
+ if got > 0 then begin
Result := got;
Exit;
end;
@@ -1221,54 +1189,55 @@ begin
socket := FTcpClient.Handle;
- if Assigned(ReadReady) then
- begin
+ if Assigned(ReadReady) then begin
ReadFdsptr := @ReadFds;
FD_ZERO(ReadFds);
FD_SET(socket, ReadFds);
end
- else
+ else begin
ReadFdsptr := nil;
+ end;
- if Assigned(WriteReady) then
- begin
+ if Assigned(WriteReady) then begin
WriteFdsptr := @WriteFds;
FD_ZERO(WriteFds);
FD_SET(socket, WriteFds);
end
- else
+ else begin
WriteFdsptr := nil;
+ end;
- if Assigned(ExceptFlag) then
- begin
+ if Assigned(ExceptFlag) then begin
ExceptFdsptr := @ExceptFds;
FD_ZERO(ExceptFds);
FD_SET(socket, ExceptFds);
end
- else
+ else begin
ExceptFdsptr := nil;
+ end;
- if TimeOut >= 0 then
- begin
+ if TimeOut >= 0 then begin
tv.tv_sec := TimeOut div 1000;
tv.tv_usec := 1000 * (TimeOut mod 1000);
Timeptr := @tv;
end
- else
+ else begin
Timeptr := nil; // wait forever
+ end;
wsaError := 0;
try
-{$IFDEF MSWINDOWS}
- {$IF CompilerVersion < 23.0}
- result := WinSock.select(socket + 1, ReadFdsptr, WriteFdsptr, ExceptFdsptr, Timeptr);
- {$ELSE}
- result := Winapi.WinSock.select(socket + 1, ReadFdsptr, WriteFdsptr, ExceptFdsptr, Timeptr);
- {$IFEND}
-{$ENDIF}
-{$IFDEF LINUX}
- result := Libc.select(socket + 1, ReadFdsptr, WriteFdsptr, ExceptFdsptr, Timeptr);
-{$ENDIF}
+ {$IFDEF MSWINDOWS}
+ {$IFDEF OLD_UNIT_NAMES}
+ result := WinSock.select( socket + 1, ReadFdsptr, WriteFdsptr, ExceptFdsptr, Timeptr);
+ {$ELSE}
+ result := Winapi.WinSock.select( socket + 1, ReadFdsptr, WriteFdsptr, ExceptFdsptr, Timeptr);
+ {$ENDIF}
+ {$ENDIF}
+ {$IFDEF LINUX}
+ result := Libc.select( socket + 1, ReadFdsptr, WriteFdsptr, ExceptFdsptr, Timeptr);
+ {$ENDIF}
+
if result = SOCKET_ERROR
then wsaError := WSAGetLastError;
@@ -1277,9 +1246,11 @@ begin
end;
if Assigned(ReadReady) then
- ReadReady^ := FD_ISSET(socket, ReadFds);
+ ReadReady^ := FD_ISSET(socket, ReadFds);
+
if Assigned(WriteReady) then
WriteReady^ := FD_ISSET(socket, WriteFds);
+
if Assigned(ExceptFlag) then
ExceptFlag^ := FD_ISSET(socket, ExceptFds);
end;
@@ -1289,6 +1260,8 @@ function TTcpSocketStreamImpl.WaitForData( TimeOut : Integer; pBuf : Pointer;
var wsaError, bytesReady : Integer): TWaitForData;
var bCanRead, bError : Boolean;
retval : Integer;
+const
+ MSG_PEEK = {$IFDEF OLD_UNIT_NAMES} WinSock.MSG_PEEK {$ELSE} Winapi.WinSock.MSG_PEEK {$ENDIF};
begin
bytesReady := 0;
@@ -1304,11 +1277,8 @@ begin
// recv() returns the number of bytes received, or -1 if an error occurred.
// The return value will be 0 when the peer has performed an orderly shutdown.
-{$IF CompilerVersion < 23.0}
- retval := recv( FTcpClient.Handle, pBuf^, DesiredBytes, WinSock.MSG_PEEK);
-{$ELSE}
- retval := recv( FTcpClient.Handle, pBuf^, DesiredBytes, Winapi.WinSock.MSG_PEEK);
-{$IFEND}
+
+ retval := recv( FTcpClient.Handle, pBuf^, DesiredBytes, MSG_PEEK);
if retval <= 0
then Exit( TWaitForData.wfd_Error);
@@ -1371,15 +1341,13 @@ var
len : Integer;
begin
len := 0;
- if IsOpen then
- begin
+ if IsOpen then begin
len := FTcpClient.BytesReceived;
end;
SetLength( Result, len );
- if len > 0 then
- begin
+ if len > 0 then begin
FTcpClient.ReceiveBuf( Pointer(@Result[0])^, len);
end;
end;
@@ -1401,8 +1369,10 @@ begin
if retval = SOCKET_ERROR
then raise TTransportException.Create( TTransportException.TExceptionType.Unknown,
SysErrorMessage(Cardinal(wsaError)));
+
if (retval = 0)
then raise TTransportException.Create( TTransportException.TExceptionType.TimedOut);
+
if bError or not bCanWrite
then raise TTransportException.Create( TTransportException.TExceptionType.Unknown);
http://git-wip-us.apache.org/repos/asf/thrift/blob/9f7f11e7/lib/delphi/src/Thrift.Utils.pas
----------------------------------------------------------------------
diff --git a/lib/delphi/src/Thrift.Utils.pas b/lib/delphi/src/Thrift.Utils.pas
index 962ef54..a0bf144 100644
--- a/lib/delphi/src/Thrift.Utils.pas
+++ b/lib/delphi/src/Thrift.Utils.pas
@@ -21,16 +21,14 @@ unit Thrift.Utils;
interface
-{$IF CompilerVersion >= 23.0}
- {$LEGACYIFEND ON}
-{$IFEND}
+{$I Thrift.Defines.inc}
uses
-{$IF CompilerVersion < 23.0}
+ {$IFDEF OLD_UNIT_NAMES}
Classes, Windows, SysUtils, Character, SyncObjs;
-{$ELSE}
+ {$ELSE}
System.Classes, Winapi.Windows, System.SysUtils, System.Character, System.SyncObjs;
-{$IFEND}
+ {$ENDIF}
type
IOverlappedHelper = interface
@@ -71,6 +69,9 @@ type
end;
+function InterlockedCompareExchange64( var Target : Int64; Exchange, Comparand : Int64) : Int64; stdcall;
+function InterlockedExchangeAdd64( var Addend : Int64; Value : Int64) : Int64; stdcall;
+
implementation
@@ -204,32 +205,40 @@ end;
class function CharUtils.IsHighSurrogate( const c : Char) : Boolean;
begin
- {$IF RTLVersion >= 28.0} // XE7+
- result := c.IsHighSurrogate();
+ {$IF CompilerVersion < 23.0}
+ result := Character.IsHighSurrogate( c);
{$ELSE}
- {$IF CompilerVersion < 23.0}
- result := Character.IsHighSurrogate( c);
- {$ELSE}
- result := c.IsHighSurrogate;
- {$IFEND}
+ result := c.IsHighSurrogate();
{$IFEND}
end;
class function CharUtils.IsLowSurrogate( const c : Char) : Boolean;
begin
- {$IF RTLVersion >= 28.0} // XE7+
- result := c.IsLowSurrogate();
+ {$IF CompilerVersion < 23.0}
+ result := Character.IsLowSurrogate( c);
{$ELSE}
- {$IF CompilerVersion < 23.0}
- result := Character.IsLowSurrogate( c);
- {$ELSE}
- result := c.IsLowSurrogate;
- {$IFEND}
+ result := c.IsLowSurrogate;
{$IFEND}
end;
+// natively available since stone age
+function InterlockedCompareExchange64;
+external KERNEL32 name 'InterlockedCompareExchange64';
+
+
+// natively available >= Vista
+// implemented this way since there are still some people running Windows XP :-(
+function InterlockedExchangeAdd64( var Addend : Int64; Value : Int64) : Int64; stdcall;
+var old : Int64;
+begin
+ repeat
+ Old := Addend;
+ until (InterlockedCompareExchange64( Addend, Old + Value, Old) = Old);
+ result := Old;
+end;
+
end.
http://git-wip-us.apache.org/repos/asf/thrift/blob/9f7f11e7/lib/delphi/test/TestClient.pas
----------------------------------------------------------------------
diff --git a/lib/delphi/test/TestClient.pas b/lib/delphi/test/TestClient.pas
index 1980dcd..3be3218 100644
--- a/lib/delphi/test/TestClient.pas
+++ b/lib/delphi/test/TestClient.pas
@@ -19,6 +19,8 @@
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
@@ -306,7 +308,11 @@ begin
case endpoint of
trns_Sockets: begin
Console.WriteLine('Using sockets ('+host+' port '+IntToStr(port)+')');
+ {$IFDEF OLD_SOCKETS}
streamtrans := TSocketImpl.Create( host, port );
+ {$ELSE}
+ raise Exception.Create(ENDPOINT_TRANSPORTS[endpoint]+' transport not implemented');
+ {$ENDIF}
end;
trns_Http: begin
@@ -438,9 +444,10 @@ var
arg3 : IThriftDictionary<SmallInt, string>;
arg4 : TNumberz;
arg5 : Int64;
+ {$IFDEF PerfTest}
StartTick : Cardinal;
k : Integer;
- proc : TThreadProcedure;
+ {$ENDIF}
hello, goodbye : IXtruct;
crazy : IInsanity;
looney : IInsanity;
@@ -950,7 +957,7 @@ begin
// call time
{$IFDEF PerfTest}
StartTestGroup( 'Test Calltime()');
- StartTick := GetTIckCount;
+ StartTick := GetTickCount;
for k := 0 to 1000 - 1 do
begin
client.testVoid();
@@ -1172,7 +1179,8 @@ begin
// We have a failed test!
// -> issue DebugBreak ONLY if a debugger is attached,
// -> unhandled DebugBreaks would cause Windows to terminate the app otherwise
- if IsDebuggerPresent then asm int 3 end;
+ if IsDebuggerPresent
+ then {$IFDEF CPUX64} DebugBreak {$ELSE} asm int 3 end {$ENDIF};
end;
end;
http://git-wip-us.apache.org/repos/asf/thrift/blob/9f7f11e7/lib/delphi/test/TestServer.pas
----------------------------------------------------------------------
diff --git a/lib/delphi/test/TestServer.pas b/lib/delphi/test/TestServer.pas
index 018282c..e3576dd 100644
--- a/lib/delphi/test/TestServer.pas
+++ b/lib/delphi/test/TestServer.pas
@@ -19,6 +19,7 @@
unit TestServer;
+{$I ../src/Thrift.Defines.inc}
{$WARN SYMBOL_PLATFORM OFF}
{.$DEFINE RunEndless} // activate to interactively stress-test the server stop routines via Ctrl+C
@@ -657,11 +658,15 @@ begin
trns_Sockets : begin
Console.WriteLine('- sockets (port '+IntToStr(port)+')');
if (trns_Buffered in layered) then Console.WriteLine('- buffered');
+ {$IFDEF OLD_SOCKETS}
servertrans := TServerSocketImpl.Create( Port, 0, (trns_Buffered in layered));
+ {$ELSE}
+ raise Exception.Create(ENDPOINT_TRANSPORTS[endpoint]+' server transport not implemented');
+ {$ENDIF}
end;
trns_Http : begin
- raise Exception.Create('HTTP server transport not implemented');
+ raise Exception.Create(ENDPOINT_TRANSPORTS[endpoint]+' server transport not implemented');
end;
trns_NamedPipes : begin
http://git-wip-us.apache.org/repos/asf/thrift/blob/9f7f11e7/lib/delphi/test/client.dpr
----------------------------------------------------------------------
diff --git a/lib/delphi/test/client.dpr b/lib/delphi/test/client.dpr
index 69e44c2..1297aaa 100644
--- a/lib/delphi/test/client.dpr
+++ b/lib/delphi/test/client.dpr
@@ -44,19 +44,19 @@ var
args : array of string;
i : Integer;
arg : string;
- s : string;
begin
try
Writeln( 'Delphi TestClient '+Thrift.Version);
nParamCount := ParamCount;
SetLength( args, nParamCount);
- for i := 1 to nParamCount do
- begin
+ for i := 1 to nParamCount do begin
arg := ParamStr( i );
args[i-1] := arg;
end;
+
ExitCode := TTestClient.Execute( args);
+
except
on E: EAbort do begin
ExitCode := $FF;
http://git-wip-us.apache.org/repos/asf/thrift/blob/9f7f11e7/lib/delphi/test/server.dpr
----------------------------------------------------------------------
diff --git a/lib/delphi/test/server.dpr b/lib/delphi/test/server.dpr
index d532e34..4d623f3 100644
--- a/lib/delphi/test/server.dpr
+++ b/lib/delphi/test/server.dpr
@@ -44,19 +44,19 @@ var
args : array of string;
i : Integer;
arg : string;
- s : string;
begin
try
Writeln( 'Delphi TestServer '+Thrift.Version);
nParamCount := ParamCount;
SetLength( args, nParamCount);
- for i := 1 to nParamCount do
- begin
+ for i := 1 to nParamCount do begin
arg := ParamStr( i );
args[i-1] := arg;
end;
+
TTestServer.Execute( args );
+
except
on E: EAbort do begin
ExitCode := $FF;