Thrift-1401: JSON-protocol for Delphi XE Libraries
Client: delphi
Patch: Jens Geyer
Adds support for the JSON protocol to the existing Delphi XE libraries.
git-svn-id: https://svn.apache.org/repos/asf/thrift/trunk@1200538 13f79535-47bb-0310-9956-ffa450edef68
diff --git a/lib/delphi/test/TestClient.pas b/lib/delphi/test/TestClient.pas
index b3c9017..e8edd82 100644
--- a/lib/delphi/test/TestClient.pas
+++ b/lib/delphi/test/TestClient.pas
@@ -22,12 +22,19 @@
interface
uses
- SysUtils, Classes, Thrift.Protocol, Thrift.Transport, Thrift.Test,
- Generics.Collections, Thrift.Collections, Windows, Thrift.Console,
- DateUtils;
+ Windows, SysUtils, Classes,
+ DateUtils,
+ Generics.Collections,
+ TestConstants,
+ Thrift.Protocol.JSON,
+ Thrift.Protocol,
+ Thrift.Transport,
+ Thrift.Stream,
+ Thrift.Test,
+ Thrift.Collections,
+ Thrift.Console;
type
-
TThreadConsole = class
private
FThread : TThread;
@@ -40,14 +47,19 @@
TClientThread = class( TThread )
private
FTransport : ITransport;
+ FProtocol : IProtocol;
FNumIteration : Integer;
FConsole : TThreadConsole;
+ FErrors, FSuccesses : Integer;
+ procedure Expect( aTestResult : Boolean; const aTestInfo : string);
+
procedure ClientTest;
+ procedure JSONProtocolReadWriteTest;
protected
procedure Execute; override;
public
- constructor Create(ATransport: ITransport; ANumIteration: Integer);
+ constructor Create(ATransport: ITransport; AProtocol : IProtocol; ANumIteration: Integer);
destructor Destroy; override;
end;
@@ -62,6 +74,7 @@
implementation
+
{ TTestClient }
class procedure TTestClient.Execute(const args: array of string);
@@ -79,12 +92,14 @@
test : Integer;
thread : TThread;
trans : ITransport;
+ prot : IProtocol;
streamtrans : IStreamTransport;
http : IHTTPClient;
-
+ protType, p : TKnownProtocol;
begin
bBuffered := False;;
bFramed := False;
+ protType := prot_Binary;
try
host := 'localhost';
port := 9090;
@@ -132,6 +147,18 @@
begin
Inc( i );
FNumThread := StrToInt( args[i] );
+ end else
+ if (args[i] = '-prot') then // -prot JSON|binary
+ begin
+ Inc( i );
+ s := args[i];
+ for p:= Low(TKnownProtocol) to High(TKnownProtocol) do begin
+ if SameText( s, KNOWN_PROTOCOLS[p]) then begin
+ protType := p;
+ Console.WriteLine('Using '+KNOWN_PROTOCOLS[protType]+' protocol');
+ Break;
+ end;
+ end;
end;
finally
Inc( i );
@@ -167,7 +194,17 @@
http := THTTPClientImpl.Create( url );
trans := http;
end;
- thread := TClientThread.Create( trans, FNumIteration);
+
+ // create protocol instance, default to BinaryProtocol
+ case protType of
+ prot_Binary: prot := TBinaryProtocolImpl.Create( trans);
+ prot_JSON : prot := TJSONProtocolImpl.Create( trans);
+ else
+ ASSERT( FALSE); // unhandled case!
+ prot := TBinaryProtocolImpl.Create( trans); // use default
+ end;
+
+ thread := TClientThread.Create( trans, prot, FNumIteration);
threads[test] := thread;
{$WARN SYMBOL_DEPRECATED OFF}
thread.Resume;
@@ -201,7 +238,6 @@
procedure TClientThread.ClientTest;
var
- binaryProtocol : TBinaryProtocolImpl;
client : TThriftTest.Iface;
s : string;
i8 : ShortInt;
@@ -234,7 +270,7 @@
k2_2 : TNumberz;
k3 : TNumberz;
v2 : IInsanity;
- userMap : IThriftDictionary<TNumberz, Int64>;
+ userMap : IThriftDictionary<TNumberz, Int64>;
xtructs : IThriftList<IXtruct>;
x : IXtruct;
arg0 : ShortInt;
@@ -248,8 +284,7 @@
proc : TThreadProcedure;
begin
- binaryProtocol := TBinaryProtocolImpl.Create( FTransport );
- client := TThriftTest.TClient.Create( binaryProtocol );
+ client := TThriftTest.TClient.Create( FProtocol);
try
if not FTransport.IsOpen then
begin
@@ -523,11 +558,114 @@
end;
-constructor TClientThread.Create(ATransport: ITransport; ANumIteration: Integer);
+
+procedure TClientThread.JSONProtocolReadWriteTest;
+// Tests only then read/write procedures of the JSON protocol
+// All tests succeed, if we can read what we wrote before
+// Note that passing this test does not imply, that our JSON is really compatible to what
+// 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;
+ i,iErr : Integer;
+const
+ TEST_SHORT = ShortInt( $FE);
+ TEST_SMALL = SmallInt( $FEDC);
+ TEST_LONG = LongInt( $FEDCBA98);
+ TEST_I64 = Int64( $FEDCBA9876543210);
+ TEST_DOUBLE = -1.234e-56;
+ DELTA_DOUBLE = TEST_DOUBLE * 1e-14;
+ TEST_STRING = 'abc-'#$00E4#$00f6#$00fc; // german umlauts (en-us: "funny chars")
+begin
+ stm := TStringStream.Create;
+ try
+ // prepare binary data
+ SetLength( binary, $100);
+ for i := Low(binary) to High(binary) do binary[i] := i;
+
+ // output setup
+ prot := TJSONProtocolImpl.Create(
+ TStreamTransportImpl.Create(
+ nil, TThriftStreamAdapterDelphi.Create( stm, FALSE)));
+
+ // write
+ prot.WriteListBegin( TListImpl.Create( TType.String_, 9));
+ prot.WriteBool( TRUE);
+ prot.WriteBool( FALSE);
+ prot.WriteByte( TEST_SHORT);
+ prot.WriteI16( TEST_SMALL);
+ prot.WriteI32( TEST_LONG);
+ prot.WriteI64( TEST_I64);
+ prot.WriteDouble( TEST_DOUBLE);
+ prot.WriteString( TEST_STRING);
+ prot.WriteBinary( binary);
+ prot.WriteListEnd;
+
+ // input setup
+ Expect( stm.Position = stm.Size, 'Stream position/length after write');
+ stm.Position := 0;
+ prot := TJSONProtocolImpl.Create(
+ TStreamTransportImpl.Create(
+ TThriftStreamAdapterDelphi.Create( stm, FALSE), nil));
+
+ // read and compare
+ list := prot.ReadListBegin;
+ Expect( list.ElementType = TType.String_, 'list element type');
+ Expect( list.Count = 9, 'list element count');
+ Expect( prot.ReadBool, 'WriteBool/ReadBool: TRUE');
+ Expect( not prot.ReadBool, 'WriteBool/ReadBool: FALSE');
+ Expect( prot.ReadByte = TEST_SHORT, 'WriteByte/ReadByte');
+ Expect( prot.ReadI16 = TEST_SMALL, 'WriteI16/ReadI16');
+ Expect( prot.ReadI32 = TEST_LONG, 'WriteI32/ReadI32');
+ Expect( prot.ReadI64 = TEST_I64, 'WriteI64/ReadI64');
+ Expect( abs(prot.ReadDouble-TEST_DOUBLE) < abs(DELTA_DOUBLE), 'WriteDouble/ReadDouble');
+ Expect( prot.ReadString = TEST_STRING, 'WriteString/ReadString');
+ binRead := prot.ReadBinary;
+ prot.ReadListEnd;
+
+ // test binary data
+ Expect( Length(binary) = Length(binRead), 'Binary data length check');
+ iErr := -1;
+ for i := Low(binary) to High(binary) do begin
+ if binary[i] <> binRead[i] then begin
+ iErr := i;
+ Break;
+ end;
+ end;
+ if iErr < 0
+ then Expect( TRUE, 'Binary data check ('+IntToStr(Length(binary))+' Bytes)')
+ else Expect( FALSE, 'Binary data check at offset '+IntToStr(iErr));
+
+ Expect( stm.Position = stm.Size, 'Stream position after read');
+
+ finally
+ stm.Free;
+ prot := nil; //-> Release
+ end;
+end;
+
+
+procedure TClientThread.Expect( aTestResult : Boolean; const aTestInfo : string);
+begin
+ if aTestResult then begin
+ Inc(FSuccesses);
+ Console.WriteLine( aTestInfo+' = OK');
+ end
+ else begin
+ Inc(FErrors);
+ Console.WriteLine( aTestInfo+' = FAILED');
+ ASSERT( FALSE); // we have a failed test!
+ end;
+end;
+
+
+constructor TClientThread.Create(ATransport: ITransport; AProtocol : IProtocol; ANumIteration: Integer);
begin
inherited Create( True );
FNumIteration := ANumIteration;
FTransport := ATransport;
+ FProtocol := AProtocol;
FConsole := TThreadConsole.Create( Self );
end;
@@ -545,6 +683,7 @@
for i := 0 to FNumIteration - 1 do
begin
ClientTest;
+ JSONProtocolReadWriteTest;
end;
proc := procedure
diff --git a/lib/delphi/test/TestConstants.pas b/lib/delphi/test/TestConstants.pas
new file mode 100644
index 0000000..9cb85ab
--- /dev/null
+++ b/lib/delphi/test/TestConstants.pas
@@ -0,0 +1,36 @@
+(*
+ * Licensed to the Apache Software Foundation (ASF) under one
+ * or more contributor license agreements. See the NOTICE file
+ * distributed with this work for additional information
+ * regarding copyright ownership. The ASF licenses this file
+ * to you under the Apache License, Version 2.0 (the
+ * "License"); you may not use this file except in compliance
+ * with the License. You may obtain a copy of the License at
+ *
+ * http://www.apache.org/licenses/LICENSE-2.0
+ *
+ * Unless required by applicable law or agreed to in writing,
+ * software distributed under the License is distributed on an
+ * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+ * KIND, either express or implied. See the License for the
+ * specific language governing permissions and limitations
+ * under the License.
+ *)
+
+unit TestConstants;
+
+interface
+
+type
+ TKnownProtocol = ( prot_Binary, // default binary protocol
+ prot_JSON // JSON protocol
+ );
+const
+ KNOWN_PROTOCOLS : array[TKnownProtocol] of string
+ = ('binary', 'JSON');
+
+implementation
+
+// nothing
+
+end.
diff --git a/lib/delphi/test/TestServer.pas b/lib/delphi/test/TestServer.pas
index 67cce77..ecaf80d 100644
--- a/lib/delphi/test/TestServer.pas
+++ b/lib/delphi/test/TestServer.pas
@@ -1,52 +1,55 @@
-(*
- * Licensed to the Apache Software Foundation (ASF) under one
- * or more contributor license agreements. See the NOTICE file
- * distributed with this work for additional information
- * regarding copyright ownership. The ASF licenses this file
- * to you under the Apache License, Version 2.0 (the
- * "License"); you may not use this file except in compliance
- * with the License. You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing,
- * software distributed under the License is distributed on an
- * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
- * KIND, either express or implied. See the License for the
- * specific language governing permissions and limitations
- * under the License.
- *)
-
-unit TestServer;
-
-interface
-
-uses
- SysUtils,
- Generics.Collections,
- Thrift.Console,
- Thrift.Server,
- Thrift.Transport,
- Thrift.Collections,
- Thrift.Utils,
- Thrift.Test,
- Thrift,
- Contnrs;
-
-type
- TTestServer = class
- public
- type
-
- ITestHandler = interface( TThriftTest.Iface )
- procedure SetServer( AServer : IServer );
- end;
-
- TTestHandlerImpl = class( TInterfacedObject, ITestHandler )
- private
- FServer : IServer;
- protected
- procedure testVoid();
+(*
+ * Licensed to the Apache Software Foundation (ASF) under one
+ * or more contributor license agreements. See the NOTICE file
+ * distributed with this work for additional information
+ * regarding copyright ownership. The ASF licenses this file
+ * to you under the Apache License, Version 2.0 (the
+ * "License"); you may not use this file except in compliance
+ * with the License. You may obtain a copy of the License at
+ *
+ * http://www.apache.org/licenses/LICENSE-2.0
+ *
+ * Unless required by applicable law or agreed to in writing,
+ * software distributed under the License is distributed on an
+ * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+ * KIND, either express or implied. See the License for the
+ * specific language governing permissions and limitations
+ * under the License.
+ *)
+
+unit TestServer;
+
+interface
+
+uses
+ SysUtils,
+ Generics.Collections,
+ Thrift.Console,
+ Thrift.Server,
+ Thrift.Transport,
+ Thrift.Protocol,
+ Thrift.Protocol.JSON,
+ Thrift.Collections,
+ Thrift.Utils,
+ Thrift.Test,
+ Thrift,
+ TestConstants,
+ Contnrs;
+
+type
+ TTestServer = class
+ public
+ type
+
+ ITestHandler = interface( TThriftTest.Iface )
+ procedure SetServer( AServer : IServer );
+ end;
+
+ TTestHandlerImpl = class( TInterfacedObject, ITestHandler )
+ private
+ FServer : IServer;
+ protected
+ procedure testVoid();
function testString(thing: string): string;
function testByte(thing: ShortInt): ShortInt;
function testI32(thing: Integer): Integer;
@@ -66,395 +69,421 @@
procedure testException(arg: string);
function testMultiException(arg0: string; arg1: string): IXtruct;
procedure testOneway(secondsToSleep: Integer);
-
- procedure testStop;
-
- procedure SetServer( AServer : IServer );
- end;
-
- class procedure Execute( args: array of string);
- end;
-
-implementation
-
-{ TTestServer.TTestHandlerImpl }
-
-procedure TTestServer.TTestHandlerImpl.SetServer(AServer: IServer);
-begin
- FServer := AServer;
-end;
-
-function TTestServer.TTestHandlerImpl.testByte(thing: ShortInt): ShortInt;
-begin
- Console.WriteLine('testByte("' + IntToStr( thing) + '")');
- Result := thing;
-end;
-
-function TTestServer.TTestHandlerImpl.testDouble(thing: Double): Double;
-begin
- Console.WriteLine('testDouble("' + FloatToStr( thing ) + '")');
- Result := thing;
-end;
-
-function TTestServer.TTestHandlerImpl.testEnum(thing: TNumberz): TNumberz;
-begin
- Console.WriteLine('testEnum(' + IntToStr( Integer( thing)) + ')');
- Result := thing;
-end;
-
-procedure TTestServer.TTestHandlerImpl.testException(arg: string);
-var
- x : TXception;
-begin
- Console.WriteLine('testException(' + arg + ')');
- if ( arg = 'Xception') then
- begin
- x := TXception.Create;
- x.ErrorCode := 1001;
- x.Message_ := 'This is an Xception';
- raise x;
- end;
-end;
-
-function TTestServer.TTestHandlerImpl.testI32(thing: Integer): Integer;
-begin
- Console.WriteLine('testI32("' + IntToStr( thing) + '")');
- Result := thing;
-end;
-
-function TTestServer.TTestHandlerImpl.testI64(thing: Int64): Int64;
-begin
- Console.WriteLine('testI64("' + IntToStr( thing) + '")');
- Result := thing;
-end;
-
-function TTestServer.TTestHandlerImpl.testInsanity(
- 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 := 'hello';
- hello.Byte_thing := 2;
- hello.I32_thing := 2;
- hello.I64_thing := 2;
-
- goodbye := TXtructImpl.Create;
- goodbye.String_thing := 'Goodbye4';
- goodbye.Byte_thing := 4;
- goodbye.I32_thing := 4;
- goodbye.I64_thing := 4;
-
- crazy := TInsanityImpl.Create;
- crazy.UserMap := TThriftDictionaryImpl<TNumberz, Int64>.Create;
- crazy.UserMap.AddOrSetValue( TNumberz.EIGHT, 8);
- crazy.Xtructs := TThriftListImpl<IXtruct>.Create;
- crazy.Xtructs.Add(goodbye);
-
- looney := TInsanityImpl.Create;
- crazy.UserMap.AddOrSetValue( TNumberz.FIVE, 5);
- crazy.Xtructs.Add(hello);
-
- first_map := TThriftDictionaryImpl<TNumberz, IInsanity>.Create;
- second_map := TThriftDictionaryImpl<TNumberz, IInsanity>.Create;
-
- first_map.AddOrSetValue( TNumberz.SIX, crazy);
- first_map.AddOrSetValue( TNumberz.THREE, crazy);
-
- second_map.AddOrSetValue( TNumberz.SIX, looney);
-
- insane := TThriftDictionaryImpl<Int64, IThriftDictionary<TNumberz, IInsanity>>.Create;
-
- insane.AddOrSetValue( 1, first_map);
- insane.AddOrSetValue( 2, second_map);
-
- Result := insane;
-end;
-
-function TTestServer.TTestHandlerImpl.testList(
- thing: IThriftList<Integer>): IThriftList<Integer>;
-var
- first : Boolean;
- elem : Integer;
-begin
- Console.Write('testList({');
- first := True;
- for elem in thing do
- begin
- if first then
- begin
- first := False;
- end else
- begin
- Console.Write(', ');
- end;
- Console.Write( IntToStr( elem));
- end;
- Console.WriteLine('})');
- Result := thing;
-end;
-
-function TTestServer.TTestHandlerImpl.testMap(
- thing: IThriftDictionary<Integer, Integer>): IThriftDictionary<Integer, Integer>;
-var
- first : Boolean;
- key : Integer;
-begin
- Console.Write('testMap({');
- first := True;
- for key in thing.Keys do
- begin
- if (first) then
- begin
- first := false;
- end else
- begin
- Console.Write(', ');
- end;
- Console.Write(IntToStr(key) + ' => ' + IntToStr( thing[key]));
- end;
- Console.WriteLine('})');
- Result := thing;
-end;
-
-function TTestServer.TTestHandlerImpl.TestMapMap(
- hello: Integer): IThriftDictionary<Integer, IThriftDictionary<Integer, Integer>>;
-var
- mapmap : IThriftDictionary<Integer, IThriftDictionary<Integer, Integer>>;
- pos : IThriftDictionary<Integer, Integer>;
- neg : IThriftDictionary<Integer, Integer>;
- i : Integer;
-begin
- Console.WriteLine('testMapMap(' + IntToStr( hello) + ')');
- mapmap := TThriftDictionaryImpl<Integer, IThriftDictionary<Integer, Integer>>.Create;
- pos := TThriftDictionaryImpl<Integer, Integer>.Create;
- neg := TThriftDictionaryImpl<Integer, Integer>.Create;
-
- for i := 1 to 4 do
- begin
- pos.AddOrSetValue( i, i);
- neg.AddOrSetValue( -i, -i);
- end;
-
- mapmap.AddOrSetValue(4, pos);
- mapmap.AddOrSetValue( -4, neg);
-
- Result := mapmap;
-end;
-
-function TTestServer.TTestHandlerImpl.testMulti(arg0: ShortInt; arg1: Integer;
- arg2: Int64; arg3: IThriftDictionary<SmallInt, string>; arg4: TNumberz;
- arg5: Int64): IXtruct;
-var
- hello : IXtruct;
-begin
- Console.WriteLine('testMulti()');
- hello := TXtructImpl.Create;
- hello.String_thing := 'Hello2';
- hello.Byte_thing := arg0;
- hello.I32_thing := arg1;
- hello.I64_thing := arg2;
- Result := hello;
-end;
-
-function TTestServer.TTestHandlerImpl.testMultiException(arg0,
- arg1: string): IXtruct;
-var
- x : TXception;
- x2 : TXception2;
-begin
- Console.WriteLine('testMultiException(' + arg0 + ', ' + arg1 + ')');
- if ( arg0 = 'Xception') then
- begin
- x := TXception.Create;
- x.ErrorCode := 1001;
- x.Message_ := 'This is an Xception';
- raise x;
- end else
- if ( arg0 = 'Xception2') then
- begin
- x2 := TXception2.Create;
- x2.ErrorCode := 2002;
- x2.Struct_thing := TXtructImpl.Create;
- x2.Struct_thing.String_thing := 'This is an Xception2';
- raise x2;
- end;
-
- Result := TXtructImpl.Create;
- Result.String_thing := arg1;
-end;
-
-function TTestServer.TTestHandlerImpl.testNest(thing: IXtruct2): IXtruct2;
-var
- temp : IXtruct;
-begin
- temp := thing.Struct_thing;
- Console.WriteLine('testNest({' +
- IntToStr( thing.Byte_thing) + ', {' +
- '"' + temp.String_thing + '", ' +
- IntToStr( temp.Byte_thing) + ', ' +
- IntToStr( temp.I32_thing) + ', ' +
- IntToStr( temp.I64_thing) + '}, ' +
- IntToStr( temp.I32_thing) + '})');
- Result := thing;
-end;
-
-procedure TTestServer.TTestHandlerImpl.testOneway(secondsToSleep: Integer);
-begin
- Console.WriteLine('testOneway(' + IntToStr( secondsToSleep )+ '), sleeping...');
- Sleep(secondsToSleep * 1000);
- Console.WriteLine('testOneway finished');
-end;
-
-function TTestServer.TTestHandlerImpl.testSet(
- thing: IHashSet<Integer>):IHashSet<Integer>;
-var
- first : Boolean;
- elem : Integer;
-begin
- Console.Write('testSet({');
- first := True;
-
- for elem in thing do
- begin
- if first then
- begin
- first := False;
- end else
- begin
- Console.Write( ', ');
- end;
- Console.Write( IntToStr( elem));
- end;
- Console.WriteLine('})');
- Result := thing;
-end;
-
-procedure TTestServer.TTestHandlerImpl.testStop;
-begin
- if FServer <> nil then
- begin
- FServer.Stop;
- end;
-end;
-
-function TTestServer.TTestHandlerImpl.testString(thing: string): string;
-begin
- Console.WriteLine('teststring("' + thing + '")');
- Result := thing;
-end;
-
-function TTestServer.TTestHandlerImpl.testStringMap(
- thing: IThriftDictionary<string, string>): IThriftDictionary<string, string>;
-begin
-
-end;
-
-function TTestServer.TTestHandlerImpl.testTypedef(thing: Int64): Int64;
-begin
- Console.WriteLine('testTypedef(' + IntToStr( thing) + ')');
- Result := thing;
-end;
-
-procedure TTestServer.TTestHandlerImpl.TestVoid;
-begin
- Console.WriteLine('testVoid()');
-end;
-
-function TTestServer.TTestHandlerImpl.testStruct(thing: IXtruct): IXtruct;
-begin
- Console.WriteLine('testStruct({' +
- '"' + thing.String_thing + '", ' +
- IntToStr( thing.Byte_thing) + ', ' +
- IntToStr( thing.I32_thing) + ', ' +
- IntToStr( thing.I64_thing));
- Result := thing;
-end;
-
-{ TTestServer }
-
-class procedure TTestServer.Execute(args: array of string);
-var
- UseBufferedSockets : Boolean;
- UseFramed : Boolean;
- Port : Integer;
- testHandler : ITestHandler;
- testProcessor : IProcessor;
- ServerSocket : IServerTransport;
- ServerEngine : IServer;
- TransportFactroy : ITransportFactory;
-
-
-begin
- try
- UseBufferedSockets := False;
- UseFramed := False;
- Port := 9090;
-
- if ( Length( args) > 0) then
- begin
- Port := StrToIntDef( args[0], Port);
-
- if ( Length( args) > 0) then
- begin
- if ( args[0] = 'raw' ) then
- begin
- // as default
- end else
- if ( args[0] = 'buffered' ) then
- begin
- UseBufferedSockets := True;
- end else
- if ( args[0] = 'framed' ) then
- begin
- UseFramed := True;
- end else
- begin
- // Fall back to the older boolean syntax
- UseBufferedSockets := StrToBoolDef( args[1], UseBufferedSockets);
- end
- end
- end;
-
- testHandler := TTestHandlerImpl.Create;
-
- testProcessor := TThriftTest.TProcessorImpl.Create( testHandler );
- ServerSocket := TServerSocketImpl.Create( Port, 0, UseBufferedSockets );
- if UseFramed then
- begin
- TransportFactroy := TFramedTransportImpl.TFactory.Create;
- ServerEngine := TSimpleServer.Create( testProcessor, ServerSocket,
- TransportFactroy);
- end else
- begin
- ServerEngine := TSimpleServer.Create( testProcessor, ServerSocket);
- end;
-
- testHandler.SetServer( ServerEngine);
-
- Console.WriteLine('Starting the server on port ' + IntToStr( Port) +
- IfValue(UseBufferedSockets, ' with buffered socket', '') +
- IfValue(useFramed, ' with framed transport', '') +
- '...');
-
- serverEngine.Serve;
- testHandler.SetServer( nil);
-
- except
- on E: Exception do
- begin
- Console.Write( E.Message);
- end;
- end;
- Console.WriteLine( 'done.');
-end;
-
-end.
+
+ procedure testStop;
+
+ procedure SetServer( AServer : IServer );
+ end;
+
+ class procedure Execute( args: array of string);
+ end;
+
+implementation
+
+{ TTestServer.TTestHandlerImpl }
+
+procedure TTestServer.TTestHandlerImpl.SetServer(AServer: IServer);
+begin
+ FServer := AServer;
+end;
+
+function TTestServer.TTestHandlerImpl.testByte(thing: ShortInt): ShortInt;
+begin
+ Console.WriteLine('testByte("' + IntToStr( thing) + '")');
+ Result := thing;
+end;
+
+function TTestServer.TTestHandlerImpl.testDouble(thing: Double): Double;
+begin
+ Console.WriteLine('testDouble("' + FloatToStr( thing ) + '")');
+ Result := thing;
+end;
+
+function TTestServer.TTestHandlerImpl.testEnum(thing: TNumberz): TNumberz;
+begin
+ Console.WriteLine('testEnum(' + IntToStr( Integer( thing)) + ')');
+ Result := thing;
+end;
+
+procedure TTestServer.TTestHandlerImpl.testException(arg: string);
+var
+ x : TXception;
+begin
+ Console.WriteLine('testException(' + arg + ')');
+ if ( arg = 'Xception') then
+ begin
+ x := TXception.Create;
+ x.ErrorCode := 1001;
+ x.Message_ := 'This is an Xception';
+ raise x;
+ end;
+end;
+
+function TTestServer.TTestHandlerImpl.testI32(thing: Integer): Integer;
+begin
+ Console.WriteLine('testI32("' + IntToStr( thing) + '")');
+ Result := thing;
+end;
+
+function TTestServer.TTestHandlerImpl.testI64(thing: Int64): Int64;
+begin
+ Console.WriteLine('testI64("' + IntToStr( thing) + '")');
+ Result := thing;
+end;
+
+function TTestServer.TTestHandlerImpl.testInsanity(
+ 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 := 'hello';
+ hello.Byte_thing := 2;
+ hello.I32_thing := 2;
+ hello.I64_thing := 2;
+
+ goodbye := TXtructImpl.Create;
+ goodbye.String_thing := 'Goodbye4';
+ goodbye.Byte_thing := 4;
+ goodbye.I32_thing := 4;
+ goodbye.I64_thing := 4;
+
+ crazy := TInsanityImpl.Create;
+ crazy.UserMap := TThriftDictionaryImpl<TNumberz, Int64>.Create;
+ crazy.UserMap.AddOrSetValue( TNumberz.EIGHT, 8);
+ crazy.Xtructs := TThriftListImpl<IXtruct>.Create;
+ crazy.Xtructs.Add(goodbye);
+
+ looney := TInsanityImpl.Create;
+ crazy.UserMap.AddOrSetValue( TNumberz.FIVE, 5);
+ crazy.Xtructs.Add(hello);
+
+ first_map := TThriftDictionaryImpl<TNumberz, IInsanity>.Create;
+ second_map := TThriftDictionaryImpl<TNumberz, IInsanity>.Create;
+
+ first_map.AddOrSetValue( TNumberz.SIX, crazy);
+ first_map.AddOrSetValue( TNumberz.THREE, crazy);
+
+ second_map.AddOrSetValue( TNumberz.SIX, looney);
+
+ insane := TThriftDictionaryImpl<Int64, IThriftDictionary<TNumberz, IInsanity>>.Create;
+
+ insane.AddOrSetValue( 1, first_map);
+ insane.AddOrSetValue( 2, second_map);
+
+ Result := insane;
+end;
+
+function TTestServer.TTestHandlerImpl.testList(
+ thing: IThriftList<Integer>): IThriftList<Integer>;
+var
+ first : Boolean;
+ elem : Integer;
+begin
+ Console.Write('testList({');
+ first := True;
+ for elem in thing do
+ begin
+ if first then
+ begin
+ first := False;
+ end else
+ begin
+ Console.Write(', ');
+ end;
+ Console.Write( IntToStr( elem));
+ end;
+ Console.WriteLine('})');
+ Result := thing;
+end;
+
+function TTestServer.TTestHandlerImpl.testMap(
+ thing: IThriftDictionary<Integer, Integer>): IThriftDictionary<Integer, Integer>;
+var
+ first : Boolean;
+ key : Integer;
+begin
+ Console.Write('testMap({');
+ first := True;
+ for key in thing.Keys do
+ begin
+ if (first) then
+ begin
+ first := false;
+ end else
+ begin
+ Console.Write(', ');
+ end;
+ Console.Write(IntToStr(key) + ' => ' + IntToStr( thing[key]));
+ end;
+ Console.WriteLine('})');
+ Result := thing;
+end;
+
+function TTestServer.TTestHandlerImpl.TestMapMap(
+ hello: Integer): IThriftDictionary<Integer, IThriftDictionary<Integer, Integer>>;
+var
+ mapmap : IThriftDictionary<Integer, IThriftDictionary<Integer, Integer>>;
+ pos : IThriftDictionary<Integer, Integer>;
+ neg : IThriftDictionary<Integer, Integer>;
+ i : Integer;
+begin
+ Console.WriteLine('testMapMap(' + IntToStr( hello) + ')');
+ mapmap := TThriftDictionaryImpl<Integer, IThriftDictionary<Integer, Integer>>.Create;
+ pos := TThriftDictionaryImpl<Integer, Integer>.Create;
+ neg := TThriftDictionaryImpl<Integer, Integer>.Create;
+
+ for i := 1 to 4 do
+ begin
+ pos.AddOrSetValue( i, i);
+ neg.AddOrSetValue( -i, -i);
+ end;
+
+ mapmap.AddOrSetValue(4, pos);
+ mapmap.AddOrSetValue( -4, neg);
+
+ Result := mapmap;
+end;
+
+function TTestServer.TTestHandlerImpl.testMulti(arg0: ShortInt; arg1: Integer;
+ arg2: Int64; arg3: IThriftDictionary<SmallInt, string>; arg4: TNumberz;
+ arg5: Int64): IXtruct;
+var
+ hello : IXtruct;
+begin
+ Console.WriteLine('testMulti()');
+ hello := TXtructImpl.Create;
+ hello.String_thing := 'Hello2';
+ hello.Byte_thing := arg0;
+ hello.I32_thing := arg1;
+ hello.I64_thing := arg2;
+ Result := hello;
+end;
+
+function TTestServer.TTestHandlerImpl.testMultiException(arg0,
+ arg1: string): IXtruct;
+var
+ x : TXception;
+ x2 : TXception2;
+begin
+ Console.WriteLine('testMultiException(' + arg0 + ', ' + arg1 + ')');
+ if ( arg0 = 'Xception') then
+ begin
+ x := TXception.Create;
+ x.ErrorCode := 1001;
+ x.Message_ := 'This is an Xception';
+ raise x;
+ end else
+ if ( arg0 = 'Xception2') then
+ begin
+ x2 := TXception2.Create;
+ x2.ErrorCode := 2002;
+ x2.Struct_thing := TXtructImpl.Create;
+ x2.Struct_thing.String_thing := 'This is an Xception2';
+ raise x2;
+ end;
+
+ Result := TXtructImpl.Create;
+ Result.String_thing := arg1;
+end;
+
+function TTestServer.TTestHandlerImpl.testNest(thing: IXtruct2): IXtruct2;
+var
+ temp : IXtruct;
+begin
+ temp := thing.Struct_thing;
+ Console.WriteLine('testNest({' +
+ IntToStr( thing.Byte_thing) + ', {' +
+ '"' + temp.String_thing + '", ' +
+ IntToStr( temp.Byte_thing) + ', ' +
+ IntToStr( temp.I32_thing) + ', ' +
+ IntToStr( temp.I64_thing) + '}, ' +
+ IntToStr( temp.I32_thing) + '})');
+ Result := thing;
+end;
+
+procedure TTestServer.TTestHandlerImpl.testOneway(secondsToSleep: Integer);
+begin
+ Console.WriteLine('testOneway(' + IntToStr( secondsToSleep )+ '), sleeping...');
+ Sleep(secondsToSleep * 1000);
+ Console.WriteLine('testOneway finished');
+end;
+
+function TTestServer.TTestHandlerImpl.testSet(
+ thing: IHashSet<Integer>):IHashSet<Integer>;
+var
+ first : Boolean;
+ elem : Integer;
+begin
+ Console.Write('testSet({');
+ first := True;
+
+ for elem in thing do
+ begin
+ if first then
+ begin
+ first := False;
+ end else
+ begin
+ Console.Write( ', ');
+ end;
+ Console.Write( IntToStr( elem));
+ end;
+ Console.WriteLine('})');
+ Result := thing;
+end;
+
+procedure TTestServer.TTestHandlerImpl.testStop;
+begin
+ if FServer <> nil then
+ begin
+ FServer.Stop;
+ end;
+end;
+
+function TTestServer.TTestHandlerImpl.testString(thing: string): string;
+begin
+ Console.WriteLine('teststring("' + thing + '")');
+ Result := thing;
+end;
+
+function TTestServer.TTestHandlerImpl.testStringMap(
+ thing: IThriftDictionary<string, string>): IThriftDictionary<string, string>;
+begin
+
+end;
+
+function TTestServer.TTestHandlerImpl.testTypedef(thing: Int64): Int64;
+begin
+ Console.WriteLine('testTypedef(' + IntToStr( thing) + ')');
+ Result := thing;
+end;
+
+procedure TTestServer.TTestHandlerImpl.TestVoid;
+begin
+ Console.WriteLine('testVoid()');
+end;
+
+function TTestServer.TTestHandlerImpl.testStruct(thing: IXtruct): IXtruct;
+begin
+ Console.WriteLine('testStruct({' +
+ '"' + thing.String_thing + '", ' +
+ IntToStr( thing.Byte_thing) + ', ' +
+ IntToStr( thing.I32_thing) + ', ' +
+ IntToStr( thing.I64_thing));
+ Result := thing;
+end;
+
+{ TTestServer }
+
+class procedure TTestServer.Execute(args: array of string);
+var
+ UseBufferedSockets : Boolean;
+ UseFramed : Boolean;
+ Port : Integer;
+ testHandler : ITestHandler;
+ testProcessor : IProcessor;
+ ServerSocket : IServerTransport;
+ ServerEngine : IServer;
+ TransportFactory : ITransportFactory;
+ ProtocolFactory : IProtocolFactory;
+ i : Integer;
+ s : string;
+ protType, p : TKnownProtocol;
+begin
+ try
+ UseBufferedSockets := False;
+ UseFramed := False;
+ protType := prot_Binary;
+ Port := 9090;
+
+ i := 0;
+ while ( i < Length(args) ) do begin
+ s := args[i];
+ Inc(i);
+
+ if StrToIntDef( s, -1) > 0 then
+ begin
+ Port := StrToIntDef( s, Port);
+ end else
+ if ( s = 'raw' ) then
+ begin
+ // as default
+ end else
+ if ( s = 'buffered' ) then
+ begin
+ UseBufferedSockets := True;
+ end else
+ if ( s = 'framed' ) then
+ begin
+ UseFramed := True;
+ end else
+ if (s = '-prot') then // -prot JSON|binary
+ begin
+ s := args[i];
+ Inc( i );
+ for p:= Low(TKnownProtocol) to High(TKnownProtocol) do begin
+ if SameText( s, KNOWN_PROTOCOLS[p]) then begin
+ protType := p;
+ Break;
+ end;
+ end;
+ end else
+ begin
+ // Fall back to the older boolean syntax
+ UseBufferedSockets := StrToBoolDef( args[1], UseBufferedSockets);
+ end
+ end;
+
+ // create protocol factory, default to BinaryProtocol
+ case protType of
+ prot_Binary: ProtocolFactory := TBinaryProtocolImpl.TFactory.Create;
+ prot_JSON : ProtocolFactory := TJSONProtocolImpl.TFactory.Create;
+ else
+ ASSERT( FALSE); // unhandled case!
+ ProtocolFactory := TBinaryProtocolImpl.TFactory.Create;
+ end;
+
+ testHandler := TTestHandlerImpl.Create;
+
+ testProcessor := TThriftTest.TProcessorImpl.Create( testHandler );
+ ServerSocket := TServerSocketImpl.Create( Port, 0, UseBufferedSockets );
+
+ if UseFramed
+ then TransportFactory := TFramedTransportImpl.TFactory.Create
+ else TransportFactory := TTransportFactoryImpl.Create;
+
+ ServerEngine := TSimpleServer.Create( testProcessor,
+ ServerSocket,
+ TransportFactory,
+ ProtocolFactory);
+
+ testHandler.SetServer( ServerEngine);
+
+ Console.WriteLine('Starting the server on port ' + IntToStr( Port) +
+ IfValue(UseBufferedSockets, ' with buffered socket', '') +
+ IfValue(useFramed, ' with framed transport', '') +
+ ' using '+KNOWN_PROTOCOLS[protType]+' protocol' +
+ '...');
+
+ serverEngine.Serve;
+ testHandler.SetServer( nil);
+
+ except
+ on E: Exception do
+ begin
+ Console.Write( E.Message);
+ end;
+ end;
+ Console.WriteLine( 'done.');
+end;
+
+end.
diff --git a/lib/delphi/test/client.dpr b/lib/delphi/test/client.dpr
index d14079d..310e966 100644
--- a/lib/delphi/test/client.dpr
+++ b/lib/delphi/test/client.dpr
@@ -1,62 +1,63 @@
-(*
- * Licensed to the Apache Software Foundation (ASF) under one
- * or more contributor license agreements. See the NOTICE file
- * distributed with this work for additional information
- * regarding copyright ownership. The ASF licenses this file
- * to you under the Apache License, Version 2.0 (the
- * "License"); you may not use this file except in compliance
- * with the License. You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing,
- * software distributed under the License is distributed on an
- * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
- * KIND, either express or implied. See the License for the
- * specific language governing permissions and limitations
- * under the License.
- *)
-
-
-program client;
-
-{$APPTYPE CONSOLE}
-
-uses
- SysUtils,
- TestClient in 'TestClient.pas',
- Thrift.Test in 'gen-delphi\Thrift.Test.pas',
- Thrift in '..\..\..\lib\delphi\src\Thrift.pas',
- Thrift.Transport in '..\..\..\lib\delphi\src\Thrift.Transport.pas',
- Thrift.Protocol in '..\..\..\lib\delphi\src\Thrift.Protocol.pas',
- Thrift.Collections in '..\..\..\lib\delphi\src\Thrift.Collections.pas',
- Thrift.Server in '..\..\..\lib\delphi\src\Thrift.Server.pas',
- Thrift.Stream in '..\..\..\lib\delphi\src\Thrift.Stream.pas',
- Thrift.Console in '..\..\..\lib\delphi\src\Thrift.Console.pas',
- Thrift.Utils in '..\..\..\lib\delphi\src\Thrift.Utils.pas';
-
-var
- nParamCount : Integer;
- 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
- arg := ParamStr( i );
- args[i-1] := arg;
- end;
- TTestClient.Execute( args );
- Readln;
- except
- on E: Exception do
- Writeln(E.ClassName, ': ', E.Message);
- end;
-end.
-
+(*g
+ * Licensed to the Apache Software Foundation (ASF) under oneg
+ * or more contributor license agreements. See the NOTICE fileg
+ * distributed with this work for additional informationg
+ * regarding copyright ownership. The ASF licenses this fileg
+ * to you under the Apache License, Version 2.0 (theg
+ * "License"); you may not use this file except in complianceg
+ * with the License. You may obtain a copy of the License atg
+ *g
+ * http://www.apache.org/licenses/LICENSE-2.0g
+ *g
+ * Unless required by applicable law or agreed to in writing,g
+ * software distributed under the License is distributed on ang
+ * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANYg
+ * KIND, either express or implied. See the License for theg
+ * specific language governing permissions and limitationsg
+ * under the License.g
+ *)g
+g
+g
+program client;g
+g
+{$APPTYPE CONSOLE}g
+g
+usesg
+ SysUtils,
+ TestClient in 'TestClient.pas',
+ Thrift.Test in 'gen-delphi\Thrift.Test.pas',
+ Thrift in '..\..\..\lib\delphi\src\Thrift.pas',
+ Thrift.Transport in '..\..\..\lib\delphi\src\Thrift.Transport.pas',
+ Thrift.Protocol in '..\..\..\lib\delphi\src\Thrift.Protocol.pas',
+ Thrift.Protocol.JSON in '..\..\..\lib\delphi\src\Thrift.Protocol.JSON.pas',
+ Thrift.Collections in '..\..\..\lib\delphi\src\Thrift.Collections.pas',
+ Thrift.Server in '..\..\..\lib\delphi\src\Thrift.Server.pas',
+ Thrift.Stream in '..\..\..\lib\delphi\src\Thrift.Stream.pas',
+ Thrift.Console in '..\..\..\lib\delphi\src\Thrift.Console.pas',
+ Thrift.Utils in '..\..\..\lib\delphi\src\Thrift.Utils.pas';
+
+varg
+ nParamCount : Integer;g
+ args : array of string;g
+ i : Integer;g
+ arg : string;g
+ s : string;g
+g
+beging
+ tryg
+ Writeln( 'Delphi TestClient '+Thrift.Version);g
+ nParamCount := ParamCount;g
+ SetLength( args, nParamCount);g
+ for i := 1 to nParamCount dog
+ beging
+ arg := ParamStr( i );g
+ args[i-1] := arg;g
+ end;g
+ TTestClient.Execute( args );g
+ Readln;g
+ exceptg
+ on E: Exception dog
+ Writeln(E.ClassName, ': ', E.Message);g
+ end;g
+end.g
+g
diff --git a/lib/delphi/test/server.dpr b/lib/delphi/test/server.dpr
index d6a53bc..832f825 100644
--- a/lib/delphi/test/server.dpr
+++ b/lib/delphi/test/server.dpr
@@ -1,63 +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.
- *)
-
-program server;
-
-{$APPTYPE CONSOLE}
-
-uses
- SysUtils,
- TestServer in 'TestServer.pas',
- Thrift.Test in 'gen-delphi\Thrift.Test.pas',
- Thrift in '..\..\..\lib\delphi\src\Thrift.pas',
- Thrift.Transport in '..\..\..\lib\delphi\src\Thrift.Transport.pas',
- Thrift.Protocol in '..\..\..\lib\delphi\src\Thrift.Protocol.pas',
- Thrift.Collections in '..\..\..\lib\delphi\src\Thrift.Collections.pas',
- Thrift.Server in '..\..\..\lib\delphi\src\Thrift.Server.pas',
- Thrift.Console in '..\..\..\lib\delphi\src\Thrift.Console.pas',
- Thrift.Utils in '..\..\..\lib\delphi\src\Thrift.Utils.pas',
- Thrift.Stream in '..\..\..\lib\delphi\src\Thrift.Stream.pas';
-
-var
- nParamCount : Integer;
- 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
- arg := ParamStr( i );
- args[i-1] := arg;
- end;
- TTestServer.Execute( args );
- Readln;
- except
- on E: Exception do
- Writeln(E.ClassName, ': ', E.Message);
- end;
-end.
-
-
-
+(*
+ * Licensed to the Apache Software Foundation (ASF) under one
+ * or more contributor license agreements. See the NOTICE file
+ * distributed with this work for additional information
+ * regarding copyright ownership. The ASF licenses this file
+ * to you under the Apache License, Version 2.0 (the
+ * "License"); you may not use this file except in compliance
+ * with the License. You may obtain a copy of the License at
+ *
+ * http://www.apache.org/licenses/LICENSE-2.0
+ *
+ * Unless required by applicable law or agreed to in writing,
+ * software distributed under the License is distributed on an
+ * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+ * KIND, either express or implied. See the License for the
+ * specific language governing permissions and limitations
+ * under the License.
+ *)
+
+program server;
+
+{$APPTYPE CONSOLE}
+
+uses
+ SysUtils,
+ TestServer in 'TestServer.pas',
+ Thrift.Test in 'gen-delphi\Thrift.Test.pas',
+ Thrift in '..\..\..\lib\delphi\src\Thrift.pas',
+ Thrift.Transport in '..\..\..\lib\delphi\src\Thrift.Transport.pas',
+ Thrift.Protocol in '..\..\..\lib\delphi\src\Thrift.Protocol.pas',
+ Thrift.Protocol.JSON in '..\..\..\lib\delphi\src\Thrift.Protocol.JSON.pas',
+ Thrift.Collections in '..\..\..\lib\delphi\src\Thrift.Collections.pas',
+ Thrift.Server in '..\..\..\lib\delphi\src\Thrift.Server.pas',
+ Thrift.Console in '..\..\..\lib\delphi\src\Thrift.Console.pas',
+ Thrift.Utils in '..\..\..\lib\delphi\src\Thrift.Utils.pas',
+ Thrift.Stream in '..\..\..\lib\delphi\src\Thrift.Stream.pas';
+
+var
+ nParamCount : Integer;
+ 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
+ arg := ParamStr( i );
+ args[i-1] := arg;
+ end;
+ TTestServer.Execute( args );
+ Readln;
+ except
+ on E: Exception do
+ Writeln(E.ClassName, ': ', E.Message);
+ end;
+end.
+