blob: dc39828aa2227a7c3419cd0179c30e4127a81ff5 [file] [log] [blame]
Jens Geyer7bb44a32014-02-07 22:24:37 +01001(*
Roger Meier3bef8c22012-10-06 06:58:00 +00002 * Licensed to the Apache Software Foundation (ASF) under one
3 * or more contributor license agreements. See the NOTICE file
4 * distributed with this work for additional information
5 * regarding copyright ownership. The ASF licenses this file
6 * to you under the Apache License, Version 2.0 (the
7 * "License"); you may not use this file except in compliance
8 * with the License. You may obtain a copy of the License at
9 *
10 * http://www.apache.org/licenses/LICENSE-2.0
11 *
12 * Unless required by applicable law or agreed to in writing,
13 * software distributed under the License is distributed on an
14 * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
15 * KIND, either express or implied. See the License for the
16 * specific language governing permissions and limitations
17 * under the License.
18 *)
19
20unit TestClient;
21
Jens Geyer06045cf2013-03-27 20:26:25 +020022{.$DEFINE StressTest} // activate to stress-test the server with frequent connects/disconnects
23{.$DEFINE PerfTest} // activate to activate the performance test
24
Roger Meier3bef8c22012-10-06 06:58:00 +000025interface
26
27uses
28 Windows, SysUtils, Classes,
29 DateUtils,
30 Generics.Collections,
31 TestConstants,
32 Thrift,
33 Thrift.Protocol.JSON,
34 Thrift.Protocol,
35 Thrift.Transport.Pipes,
36 Thrift.Transport,
37 Thrift.Stream,
38 Thrift.Test,
39 Thrift.Collections,
40 Thrift.Console;
41
42type
43 TThreadConsole = class
44 private
45 FThread : TThread;
46 public
47 procedure Write( const S : string);
48 procedure WriteLine( const S : string);
49 constructor Create( AThread: TThread);
50 end;
51
52 TClientThread = class( TThread )
Jens Geyerf8a1b7a2014-09-24 00:26:46 +020053 private type
54 TTestGroup = (
55 test_Unknown,
56 test_BaseTypes,
57 test_Structs,
58 test_Containers,
59 test_Exceptions
60 // new values here
61 );
62 TTestGroups = set of TTestGroup;
63
Roger Meier3bef8c22012-10-06 06:58:00 +000064 private
65 FTransport : ITransport;
66 FProtocol : IProtocol;
67 FNumIteration : Integer;
68 FConsole : TThreadConsole;
69
70 // test reporting, will be refactored out into separate class later
71 FTestGroup : string;
Jens Geyerf8a1b7a2014-09-24 00:26:46 +020072 FCurrentTest : TTestGroup;
Roger Meier3bef8c22012-10-06 06:58:00 +000073 FSuccesses : Integer;
74 FErrors : TStringList;
Jens Geyerf8a1b7a2014-09-24 00:26:46 +020075 FFailed : TTestGroups;
76 FExecuted : TTestGroups;
77 procedure StartTestGroup( const aGroup : string; const aTest : TTestGroup);
Roger Meier3bef8c22012-10-06 06:58:00 +000078 procedure Expect( aTestResult : Boolean; const aTestInfo : string);
79 procedure ReportResults;
Jens Geyerf8a1b7a2014-09-24 00:26:46 +020080 function CalculateExitCode : Byte;
Roger Meier3bef8c22012-10-06 06:58:00 +000081
82 procedure ClientTest;
83 procedure JSONProtocolReadWriteTest;
Jens Geyer718f6ee2013-09-06 21:02:34 +020084 {$IFDEF StressTest}
Jens Geyer06045cf2013-03-27 20:26:25 +020085 procedure StressTest(const client : TThriftTest.Iface);
Jens Geyer718f6ee2013-09-06 21:02:34 +020086 {$ENDIF}
Roger Meier3bef8c22012-10-06 06:58:00 +000087 protected
88 procedure Execute; override;
89 public
90 constructor Create( const ATransport: ITransport; const AProtocol : IProtocol; ANumIteration: Integer);
91 destructor Destroy; override;
92 end;
93
94 TTestClient = class
95 private
96 class var
97 FNumIteration : Integer;
98 FNumThread : Integer;
Jens Geyerf8a1b7a2014-09-24 00:26:46 +020099
100 class procedure PrintCmdLineHelp;
101 class procedure InvalidArgs;
Roger Meier3bef8c22012-10-06 06:58:00 +0000102 public
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200103 class function Execute( const args: array of string) : Byte;
Roger Meier3bef8c22012-10-06 06:58:00 +0000104 end;
105
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200106
Roger Meier3bef8c22012-10-06 06:58:00 +0000107implementation
108
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200109const
110 EXITCODE_SUCCESS = $00; // no errors bits set
111 //
112 EXITCODE_FAILBIT_BASETYPES = $01;
113 EXITCODE_FAILBIT_STRUCTS = $02;
114 EXITCODE_FAILBIT_CONTAINERS = $04;
115 EXITCODE_FAILBIT_EXCEPTIONS = $08;
116
117 MAP_FAILURES_TO_EXITCODE_BITS : array[TClientThread.TTestGroup] of Byte = (
118 EXITCODE_SUCCESS, // no bits here
119 EXITCODE_FAILBIT_BASETYPES,
120 EXITCODE_FAILBIT_STRUCTS,
121 EXITCODE_FAILBIT_CONTAINERS,
122 EXITCODE_FAILBIT_EXCEPTIONS
123 );
124
125
126
Roger Meier3bef8c22012-10-06 06:58:00 +0000127function BoolToString( b : Boolean) : string;
128// overrides global BoolToString()
129begin
130 if b
131 then result := 'true'
132 else result := 'false';
133end;
134
135// not available in all versions, so make sure we have this one imported
136function IsDebuggerPresent: BOOL; stdcall; external KERNEL32 name 'IsDebuggerPresent';
137
138{ TTestClient }
139
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200140class procedure TTestClient.PrintCmdLineHelp;
141const HELPTEXT = ' [options]'#10
142 + #10
143 + 'Allowed options:'#10
144 + ' -h [ --help ] produce help message'#10
145 + ' --host arg (=localhost) Host to connect'#10
146 + ' --port arg (=9090) Port number to connect'#10
147 + ' --domain-socket arg Domain Socket (e.g. /tmp/ThriftTest.thrift),'#10
148 + ' instead of host and port'#10
149 + ' --named-pipe arg Windows Named Pipe (e.g. MyThriftPipe)'#10
150 + ' --anon-pipes hRead hWrite Windows Anonymous Pipes pair (handles)'#10
151 + ' --transport arg (=sockets) Transport: buffered, framed, http, evhttp'#10
152 + ' --protocol arg (=binary) Protocol: binary, compact, json'#10
153 + ' --ssl Encrypted Transport using SSL'#10
154 + ' -n [ --testloops ] arg (=1) Number of Tests'#10
155 + ' -t [ --threads ] arg (=1) Number of Test threads'#10
156 ;
157begin
158 Writeln( ChangeFileExt(ExtractFileName(ParamStr(0)),'') + HELPTEXT);
159end;
160
161class procedure TTestClient.InvalidArgs;
162begin
163 Console.WriteLine( 'Invalid args.');
164 Console.WriteLine( ChangeFileExt(ExtractFileName(ParamStr(0)),'') + ' -h for more information');
165 Abort;
166end;
167
168class function TTestClient.Execute(const args: array of string) : Byte;
Roger Meier3bef8c22012-10-06 06:58:00 +0000169var
170 i : Integer;
171 host : string;
172 port : Integer;
Roger Meier3bef8c22012-10-06 06:58:00 +0000173 sPipeName : string;
174 hAnonRead, hAnonWrite : THandle;
175 s : string;
Roger Meier3bef8c22012-10-06 06:58:00 +0000176 threads : array of TThread;
177 dtStart : TDateTime;
178 test : Integer;
179 thread : TThread;
180 trans : ITransport;
181 prot : IProtocol;
182 streamtrans : IStreamTransport;
183 http : IHTTPClient;
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200184 protType : TKnownProtocol;
185 endpoint : TEndpointTransport;
186 layered : TLayeredTransports;
187 UseSSL : Boolean; // include where appropriate (TLayeredTransport?)
Jens Geyer0b20cc82013-03-07 20:47:01 +0100188const
189 // pipe timeouts to be used
190 DEBUG_TIMEOUT = 30 * 1000;
Jens Geyer3e8d9272014-09-14 20:10:40 +0200191 RELEASE_TIMEOUT = DEFAULT_THRIFT_TIMEOUT;
Jens Geyer0b20cc82013-03-07 20:47:01 +0100192 TIMEOUT = RELEASE_TIMEOUT;
Roger Meier3bef8c22012-10-06 06:58:00 +0000193begin
Roger Meier3bef8c22012-10-06 06:58:00 +0000194 protType := prot_Binary;
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200195 endpoint := trns_Sockets;
196 layered := [];
197 UseSSL := FALSE;
198 host := 'localhost';
199 port := 9090;
200 sPipeName := '';
201 hAnonRead := INVALID_HANDLE_VALUE;
202 hAnonWrite := INVALID_HANDLE_VALUE;
Roger Meier3bef8c22012-10-06 06:58:00 +0000203 try
Roger Meier3bef8c22012-10-06 06:58:00 +0000204 i := 0;
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200205 while ( i < Length(args) ) do begin
206 s := args[i];
207 Inc( i);
Roger Meier3bef8c22012-10-06 06:58:00 +0000208
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200209 if (s = '-h') or (s = '--help') then begin
210 // -h [ --help ] produce help message
211 PrintCmdLineHelp;
212 result := $FF; // all tests failed
213 Exit;
214 end
Jens Geyerb360b652014-09-28 01:55:46 +0200215 else if s = '--host' then begin
216 // --host arg (=localhost) Host to connect
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200217 host := args[i];
218 Inc( i);
219 end
Jens Geyerb360b652014-09-28 01:55:46 +0200220 else if s = '--port' then begin
221 // --port arg (=9090) Port number to connect
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200222 s := args[i];
223 Inc( i);
224 port := StrToIntDef(s,0);
225 if port <= 0 then InvalidArgs;
226 end
Jens Geyerb360b652014-09-28 01:55:46 +0200227 else if s = '--domain-socket' then begin
228 // --domain-socket arg Domain Socket (e.g. /tmp/ThriftTest.thrift), instead of host and port
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200229 raise Exception.Create('domain-socket not supported');
230 end
Jens Geyerb360b652014-09-28 01:55:46 +0200231 else if s = '--named-pipe' then begin
232 // --named-pipe arg Windows Named Pipe (e.g. MyThriftPipe)
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200233 endpoint := trns_NamedPipes;
234 sPipeName := args[i];
235 Inc( i);
236 end
Jens Geyerb360b652014-09-28 01:55:46 +0200237 else if s = '--anon-pipes' then begin
238 // --anon-pipes hRead hWrite Windows Anonymous Pipes pair (handles)
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200239 endpoint := trns_AnonPipes;
240 hAnonRead := THandle( StrToIntDef( args[i], Integer(INVALID_HANDLE_VALUE)));
241 Inc( i);
242 hAnonWrite := THandle( StrToIntDef( args[i], Integer(INVALID_HANDLE_VALUE)));
243 Inc( i);
244 end
Jens Geyerb360b652014-09-28 01:55:46 +0200245 else if s = '--transport' then begin
246 // --transport arg (=sockets) Transport: buffered, framed, http, evhttp
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200247 s := args[i];
248 Inc( i);
Roger Meier3bef8c22012-10-06 06:58:00 +0000249
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200250 if s = 'buffered' then Include( layered, trns_Buffered)
251 else if s = 'framed' then Include( layered, trns_Framed)
252 else if s = 'http' then endpoint := trns_Http
253 else if s = 'evhttp' then endpoint := trns_AnonPipes
254 else InvalidArgs;
255 end
Jens Geyerb360b652014-09-28 01:55:46 +0200256 else if s = '--protocol' then begin
257 // --protocol arg (=binary) Protocol: binary, compact, json
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200258 s := args[i];
259 Inc( i);
Roger Meier3bef8c22012-10-06 06:58:00 +0000260
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200261 if s = 'binary' then protType := prot_Binary
262 else if s = 'compact' then protType := prot_Compact
263 else if s = 'json' then protType := prot_JSON
264 else InvalidArgs;
265 end
Jens Geyerb360b652014-09-28 01:55:46 +0200266 else if s = '--ssl' then begin
267 // --ssl Encrypted Transport using SSL
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200268 UseSSL := TRUE;
269
270 end
271 else if (s = '-n') or (s = '--testloops') then begin
272 // -n [ --testloops ] arg (=1) Number of Tests
273 FNumIteration := StrToIntDef( args[i], 0);
274 Inc( i);
275 if FNumIteration <= 0
276 then InvalidArgs;
277
278 end
279 else if (s = '-t') or (s = '--threads') then begin
280 // -t [ --threads ] arg (=1) Number of Test threads
281 FNumThread := StrToIntDef( args[i], 0);
282 Inc( i);
283 if FNumThread <= 0
284 then InvalidArgs;
285 end
286 else begin
287 InvalidArgs;
Roger Meier3bef8c22012-10-06 06:58:00 +0000288 end;
289 end;
290
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200291
Roger Meier79655fb2012-10-20 20:59:41 +0000292 // In the anonymous pipes mode the client is launched by the test server
293 // -> behave nicely and allow for attaching a debugger to this process
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200294 if (endpoint = trns_AnonPipes) and not IsDebuggerPresent
Roger Meier79655fb2012-10-20 20:59:41 +0000295 then MessageBox( 0, 'Attach Debugger and/or click OK to continue.',
296 'Thrift TestClient (Delphi)',
297 MB_OK or MB_ICONEXCLAMATION);
298
Roger Meier3bef8c22012-10-06 06:58:00 +0000299 SetLength( threads, FNumThread);
300 dtStart := Now;
301
302 for test := 0 to FNumThread - 1 do
303 begin
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200304 case endpoint of
305 trns_Sockets: begin
Roger Meier3bef8c22012-10-06 06:58:00 +0000306 Console.WriteLine('Using sockets ('+host+' port '+IntToStr(port)+')');
307 streamtrans := TSocketImpl.Create( host, port );
308 end;
309
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200310 trns_Http: begin
311 Console.WriteLine('Using HTTPClient');
312 http := THTTPClientImpl.Create( host);
313 trans := http;
Roger Meier3bef8c22012-10-06 06:58:00 +0000314 end;
315
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200316 trns_EvHttp: begin
317 raise Exception.Create(ENDPOINT_TRANSPORTS[endpoint]+' transport not implemented');
Roger Meier3bef8c22012-10-06 06:58:00 +0000318 end;
319
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200320 trns_NamedPipes: begin
321 Console.WriteLine('Using named pipe ('+sPipeName+')');
322 streamtrans := TNamedPipeTransportClientEndImpl.Create( sPipeName, 0, nil, TIMEOUT);
323 end;
324
325 trns_AnonPipes: begin
326 Console.WriteLine('Using anonymous pipes ('+IntToStr(Integer(hAnonRead))+' and '+IntToStr(Integer(hAnonWrite))+')');
327 streamtrans := TAnonymousPipeTransportImpl.Create( hAnonRead, hAnonWrite, FALSE);
328 end;
329
330 else
331 raise Exception.Create('Unhandled endpoint transport');
332 end;
333 trans := streamtrans;
334 ASSERT( trans <> nil);
335
336 if (trns_Buffered in layered) then begin
337 trans := TBufferedTransportImpl.Create( streamtrans, 32); // small buffer to test read()
338 Console.WriteLine('Using buffered transport');
339 end;
340
341 if (trns_Framed in layered) then begin
342 trans := TFramedTransportImpl.Create( trans );
343 Console.WriteLine('Using framed transport');
344 end;
345
346 if UseSSL then begin
347 raise Exception.Create('SSL not implemented');
Roger Meier3bef8c22012-10-06 06:58:00 +0000348 end;
349
350 // create protocol instance, default to BinaryProtocol
351 case protType of
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200352 prot_Binary : prot := TBinaryProtocolImpl.Create( trans, BINARY_STRICT_READ, BINARY_STRICT_WRITE);
353 prot_JSON : prot := TJSONProtocolImpl.Create( trans);
354 prot_Compact : raise Exception.Create('Compact protocol not implemented');
Roger Meier3bef8c22012-10-06 06:58:00 +0000355 else
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200356 raise Exception.Create('Unhandled protocol');
Roger Meier3bef8c22012-10-06 06:58:00 +0000357 end;
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200358 ASSERT( trans <> nil);
359 Console.WriteLine(THRIFT_PROTOCOLS[protType]+' protocol');
Roger Meier3bef8c22012-10-06 06:58:00 +0000360
361 thread := TClientThread.Create( trans, prot, FNumIteration);
362 threads[test] := thread;
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200363 thread.Start;
Roger Meier3bef8c22012-10-06 06:58:00 +0000364 end;
365
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200366 result := 0;
367 for test := 0 to FNumThread - 1 do begin
368 result := result or threads[test].WaitFor;
Roger Meier3bef8c22012-10-06 06:58:00 +0000369 end;
370
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200371 for test := 0 to FNumThread - 1
372 do threads[test].Free;
Roger Meier3bef8c22012-10-06 06:58:00 +0000373
374 Console.Write('Total time: ' + IntToStr( MilliSecondsBetween(Now, dtStart)));
375
376 except
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200377 on E: EAbort do raise;
378 on E: Exception do begin
379 Console.WriteLine( E.Message + #10 + E.StackTrace);
380 raise;
Roger Meier3bef8c22012-10-06 06:58:00 +0000381 end;
382 end;
383
384 Console.WriteLine('');
385 Console.WriteLine('done!');
386end;
387
388{ TClientThread }
389
390procedure TClientThread.ClientTest;
391var
392 client : TThriftTest.Iface;
393 s : string;
394 i8 : ShortInt;
395 i32 : Integer;
396 i64 : Int64;
397 dub : Double;
398 o : IXtruct;
399 o2 : IXtruct2;
400 i : IXtruct;
401 i2 : IXtruct2;
402 mapout : IThriftDictionary<Integer,Integer>;
403 mapin : IThriftDictionary<Integer,Integer>;
404 strmapout : IThriftDictionary<string,string>;
405 strmapin : IThriftDictionary<string,string>;
406 j : Integer;
407 first : Boolean;
408 key : Integer;
409 strkey : string;
410 listout : IThriftList<Integer>;
411 listin : IThriftList<Integer>;
412 setout : IHashSet<Integer>;
413 setin : IHashSet<Integer>;
414 ret : TNumberz;
415 uid : Int64;
416 mm : IThriftDictionary<Integer, IThriftDictionary<Integer, Integer>>;
417 pos : IThriftDictionary<Integer, Integer>;
418 neg : IThriftDictionary<Integer, Integer>;
419 m2 : IThriftDictionary<Integer, Integer>;
420 k2 : Integer;
421 insane : IInsanity;
422 truck : IXtruct;
423 whoa : IThriftDictionary<Int64, IThriftDictionary<TNumberz, IInsanity>>;
424 key64 : Int64;
425 val : IThriftDictionary<TNumberz, IInsanity>;
426 k2_2 : TNumberz;
427 k3 : TNumberz;
428 v2 : IInsanity;
429 userMap : IThriftDictionary<TNumberz, Int64>;
430 xtructs : IThriftList<IXtruct>;
431 x : IXtruct;
432 arg0 : ShortInt;
433 arg1 : Integer;
434 arg2 : Int64;
435 arg3 : IThriftDictionary<SmallInt, string>;
436 arg4 : TNumberz;
437 arg5 : Int64;
438 StartTick : Cardinal;
439 k : Integer;
440 proc : TThreadProcedure;
441 hello, goodbye : IXtruct;
442 crazy : IInsanity;
443 looney : IInsanity;
444 first_map : IThriftDictionary<TNumberz, IInsanity>;
445 second_map : IThriftDictionary<TNumberz, IInsanity>;
446
447begin
448 client := TThriftTest.TClient.Create( FProtocol);
449 FTransport.Open;
450
Jens Geyer06045cf2013-03-27 20:26:25 +0200451 {$IFDEF StressTest}
452 StressTest( client);
453 {$ENDIF StressTest}
454
Roger Meier3bef8c22012-10-06 06:58:00 +0000455 // in-depth exception test
456 // (1) do we get an exception at all?
457 // (2) do we get the right exception?
458 // (3) does the exception contain the expected data?
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200459 StartTestGroup( 'testException', test_Exceptions);
Roger Meier3bef8c22012-10-06 06:58:00 +0000460 // case 1: exception type declared in IDL at the function call
461 try
462 client.testException('Xception');
463 Expect( FALSE, 'testException(''Xception''): must trow an exception');
464 except
465 on e:TXception do begin
466 Expect( e.ErrorCode = 1001, 'error code');
467 Expect( e.Message_ = 'Xception', 'error message');
468 Console.WriteLine( ' = ' + IntToStr(e.ErrorCode) + ', ' + e.Message_ );
469 end;
470 on e:TTransportException do Expect( FALSE, 'Unexpected : "'+e.ToString+'"');
471 on e:Exception do Expect( FALSE, 'Unexpected exception type "'+e.ClassName+'"');
472 end;
473
474 // case 2: exception type NOT declared in IDL at the function call
475 // this will close the connection
476 try
477 client.testException('TException');
478 Expect( FALSE, 'testException(''TException''): must trow an exception');
479 except
480 on e:TTransportException do begin
481 Console.WriteLine( e.ClassName+' = '+e.Message); // this is what we get
482 if FTransport.IsOpen then FTransport.Close;
483 FTransport.Open; // re-open connection, server has already closed
484 end;
Jens Geyer6bbbf192014-09-07 01:45:56 +0200485 on e:TApplicationException do begin
486 Console.WriteLine( e.ClassName+' = '+e.Message); // this is what we get
487 if FTransport.IsOpen then FTransport.Close;
488 FTransport.Open; // re-open connection, server has already closed
489 end;
Roger Meier3bef8c22012-10-06 06:58:00 +0000490 on e:TException do Expect( FALSE, 'Unexpected exception type "'+e.ClassName+'"');
491 on e:Exception do Expect( FALSE, 'Unexpected exception type "'+e.ClassName+'"');
492 end;
493
494 // case 3: no exception
495 try
496 client.testException('something');
497 Expect( TRUE, 'testException(''something''): must not trow an exception');
498 except
499 on e:TTransportException do Expect( FALSE, 'Unexpected : "'+e.ToString+'"');
500 on e:Exception do Expect( FALSE, 'Unexpected exception "'+e.ClassName+'"');
501 end;
502
503
504 // simple things
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200505 StartTestGroup( 'simple Thrift calls', test_BaseTypes);
Roger Meier3bef8c22012-10-06 06:58:00 +0000506 client.testVoid();
507 Expect( TRUE, 'testVoid()'); // success := no exception
508
509 s := client.testString('Test');
510 Expect( s = 'Test', 'testString(''Test'') = "'+s+'"');
511
Jens Geyer06045cf2013-03-27 20:26:25 +0200512 s := client.testString(HUGE_TEST_STRING);
513 Expect( length(s) = length(HUGE_TEST_STRING),
514 'testString( lenght(HUGE_TEST_STRING) = '+IntToStr(Length(HUGE_TEST_STRING))+') '
515 +'=> length(result) = '+IntToStr(Length(s)));
516
Roger Meier3bef8c22012-10-06 06:58:00 +0000517 i8 := client.testByte(1);
518 Expect( i8 = 1, 'testByte(1) = ' + IntToStr( i8 ));
519
520 i32 := client.testI32(-1);
521 Expect( i32 = -1, 'testI32(-1) = ' + IntToStr(i32));
522
523 Console.WriteLine('testI64(-34359738368)');
524 i64 := client.testI64(-34359738368);
525 Expect( i64 = -34359738368, 'testI64(-34359738368) = ' + IntToStr( i64));
526
527 Console.WriteLine('testDouble(5.325098235)');
528 dub := client.testDouble(5.325098235);
529 Expect( abs(dub-5.325098235) < 1e-14, 'testDouble(5.325098235) = ' + FloatToStr( dub));
530
531 // structs
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200532 StartTestGroup( 'testStruct', test_Structs);
Roger Meier3bef8c22012-10-06 06:58:00 +0000533 Console.WriteLine('testStruct({''Zero'', 1, -3, -5})');
534 o := TXtructImpl.Create;
535 o.String_thing := 'Zero';
536 o.Byte_thing := 1;
537 o.I32_thing := -3;
538 o.I64_thing := -5;
539 i := client.testStruct(o);
540 Expect( i.String_thing = 'Zero', 'i.String_thing = "'+i.String_thing+'"');
541 Expect( i.Byte_thing = 1, 'i.Byte_thing = '+IntToStr(i.Byte_thing));
542 Expect( i.I32_thing = -3, 'i.I32_thing = '+IntToStr(i.I32_thing));
543 Expect( i.I64_thing = -5, 'i.I64_thing = '+IntToStr(i.I64_thing));
544 Expect( i.__isset_String_thing, 'i.__isset_String_thing = '+BoolToString(i.__isset_String_thing));
545 Expect( i.__isset_Byte_thing, 'i.__isset_Byte_thing = '+BoolToString(i.__isset_Byte_thing));
546 Expect( i.__isset_I32_thing, 'i.__isset_I32_thing = '+BoolToString(i.__isset_I32_thing));
547 Expect( i.__isset_I64_thing, 'i.__isset_I64_thing = '+BoolToString(i.__isset_I64_thing));
548
549 // nested structs
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200550 StartTestGroup( 'testNest', test_Structs);
Roger Meier3bef8c22012-10-06 06:58:00 +0000551 Console.WriteLine('testNest({1, {''Zero'', 1, -3, -5}, 5})');
552 o2 := TXtruct2Impl.Create;
553 o2.Byte_thing := 1;
554 o2.Struct_thing := o;
555 o2.I32_thing := 5;
556 i2 := client.testNest(o2);
557 i := i2.Struct_thing;
558 Expect( i.String_thing = 'Zero', 'i.String_thing = "'+i.String_thing+'"');
559 Expect( i.Byte_thing = 1, 'i.Byte_thing = '+IntToStr(i.Byte_thing));
560 Expect( i.I32_thing = -3, 'i.I32_thing = '+IntToStr(i.I32_thing));
561 Expect( i.I64_thing = -5, 'i.I64_thing = '+IntToStr(i.I64_thing));
562 Expect( i2.Byte_thing = 1, 'i2.Byte_thing = '+IntToStr(i2.Byte_thing));
563 Expect( i2.I32_thing = 5, 'i2.I32_thing = '+IntToStr(i2.I32_thing));
564 Expect( i.__isset_String_thing, 'i.__isset_String_thing = '+BoolToString(i.__isset_String_thing));
565 Expect( i.__isset_Byte_thing, 'i.__isset_Byte_thing = '+BoolToString(i.__isset_Byte_thing));
566 Expect( i.__isset_I32_thing, 'i.__isset_I32_thing = '+BoolToString(i.__isset_I32_thing));
567 Expect( i.__isset_I64_thing, 'i.__isset_I64_thing = '+BoolToString(i.__isset_I64_thing));
568 Expect( i2.__isset_Byte_thing, 'i2.__isset_Byte_thing');
569 Expect( i2.__isset_I32_thing, 'i2.__isset_I32_thing');
570
571 // map<type1,type2>: A map of strictly unique keys to values.
572 // Translates to an STL map, Java HashMap, PHP associative array, Python/Ruby dictionary, etc.
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200573 StartTestGroup( 'testMap', test_Containers);
Roger Meier3bef8c22012-10-06 06:58:00 +0000574 mapout := TThriftDictionaryImpl<Integer,Integer>.Create;
575 for j := 0 to 4 do
576 begin
577 mapout.AddOrSetValue( j, j - 10);
578 end;
579 Console.Write('testMap({');
580 first := True;
581 for key in mapout.Keys do
582 begin
583 if first
584 then first := False
585 else Console.Write( ', ' );
586 Console.Write( IntToStr( key) + ' => ' + IntToStr( mapout[key]));
587 end;
588 Console.WriteLine('})');
589
590 mapin := client.testMap( mapout );
591 Expect( mapin.Count = mapout.Count, 'testMap: mapin.Count = mapout.Count');
592 for j := 0 to 4 do
593 begin
594 Expect( mapout.ContainsKey(j), 'testMap: mapout.ContainsKey('+IntToStr(j)+') = '+BoolToString(mapout.ContainsKey(j)));
595 end;
596 for key in mapin.Keys do
597 begin
598 Expect( mapin[key] = mapout[key], 'testMap: '+IntToStr(key) + ' => ' + IntToStr( mapin[key]));
599 Expect( mapin[key] = key - 10, 'testMap: mapin['+IntToStr(key)+'] = '+IntToStr( mapin[key]));
600 end;
601
602
603 // map<type1,type2>: A map of strictly unique keys to values.
604 // Translates to an STL map, Java HashMap, PHP associative array, Python/Ruby dictionary, etc.
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200605 StartTestGroup( 'testStringMap', test_Containers);
Roger Meier3bef8c22012-10-06 06:58:00 +0000606 strmapout := TThriftDictionaryImpl<string,string>.Create;
607 for j := 0 to 4 do
608 begin
609 strmapout.AddOrSetValue( IntToStr(j), IntToStr(j - 10));
610 end;
611 Console.Write('testStringMap({');
612 first := True;
613 for strkey in strmapout.Keys do
614 begin
615 if first
616 then first := False
617 else Console.Write( ', ' );
618 Console.Write( strkey + ' => ' + strmapout[strkey]);
619 end;
620 Console.WriteLine('})');
621
622 strmapin := client.testStringMap( strmapout );
623 Expect( strmapin.Count = strmapout.Count, 'testStringMap: strmapin.Count = strmapout.Count');
624 for j := 0 to 4 do
625 begin
626 Expect( strmapout.ContainsKey(IntToStr(j)),
627 'testStringMap: strmapout.ContainsKey('+IntToStr(j)+') = '
628 + BoolToString(strmapout.ContainsKey(IntToStr(j))));
629 end;
630 for strkey in strmapin.Keys do
631 begin
632 Expect( strmapin[strkey] = strmapout[strkey], 'testStringMap: '+strkey + ' => ' + strmapin[strkey]);
633 Expect( strmapin[strkey] = IntToStr( StrToInt(strkey) - 10), 'testStringMap: strmapin['+strkey+'] = '+strmapin[strkey]);
634 end;
635
636
637 // set<type>: An unordered set of unique elements.
638 // Translates to an STL set, Java HashSet, set in Python, etc.
639 // Note: PHP does not support sets, so it is treated similar to a List
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200640 StartTestGroup( 'testSet', test_Containers);
Roger Meier3bef8c22012-10-06 06:58:00 +0000641 setout := THashSetImpl<Integer>.Create;
642 for j := -2 to 2 do
643 begin
644 setout.Add( j );
645 end;
646 Console.Write('testSet({');
647 first := True;
648 for j in setout do
649 begin
650 if first
651 then first := False
652 else Console.Write(', ');
653 Console.Write(IntToStr( j));
654 end;
655 Console.WriteLine('})');
656
657 setin := client.testSet(setout);
658 Expect( setin.Count = setout.Count, 'testSet: setin.Count = setout.Count');
659 Expect( setin.Count = 5, 'testSet: setin.Count = '+IntToStr(setin.Count));
660 for j := -2 to 2 do // unordered, we can't rely on the order => test for known elements only
661 begin
662 Expect( setin.Contains(j), 'testSet: setin.Contains('+IntToStr(j)+') => '+BoolToString(setin.Contains(j)));
663 end;
664
665 // list<type>: An ordered list of elements.
666 // Translates to an STL vector, Java ArrayList, native arrays in scripting languages, etc.
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200667 StartTestGroup( 'testList', test_Containers);
Roger Meier3bef8c22012-10-06 06:58:00 +0000668 listout := TThriftListImpl<Integer>.Create;
669 listout.Add( +1);
670 listout.Add( -2);
671 listout.Add( +3);
672 listout.Add( -4);
673 listout.Add( 0);
674 Console.Write('testList({');
675 first := True;
676 for j in listout do
677 begin
678 if first
679 then first := False
680 else Console.Write(', ');
681 Console.Write(IntToStr( j));
682 end;
683 Console.WriteLine('})');
684
685 listin := client.testList(listout);
686 Expect( listin.Count = listout.Count, 'testList: listin.Count = listout.Count');
687 Expect( listin.Count = 5, 'testList: listin.Count = '+IntToStr(listin.Count));
688 Expect( listin[0] = +1, 'listin[0] = '+IntToStr( listin[0]));
689 Expect( listin[1] = -2, 'listin[1] = '+IntToStr( listin[1]));
690 Expect( listin[2] = +3, 'listin[2] = '+IntToStr( listin[2]));
691 Expect( listin[3] = -4, 'listin[3] = '+IntToStr( listin[3]));
692 Expect( listin[4] = 0, 'listin[4] = '+IntToStr( listin[4]));
693
694 // enums
695 ret := client.testEnum(TNumberz.ONE);
696 Expect( ret = TNumberz.ONE, 'testEnum(ONE) = '+IntToStr(Ord(ret)));
697
698 ret := client.testEnum(TNumberz.TWO);
699 Expect( ret = TNumberz.TWO, 'testEnum(TWO) = '+IntToStr(Ord(ret)));
700
701 ret := client.testEnum(TNumberz.THREE);
702 Expect( ret = TNumberz.THREE, 'testEnum(THREE) = '+IntToStr(Ord(ret)));
703
704 ret := client.testEnum(TNumberz.FIVE);
705 Expect( ret = TNumberz.FIVE, 'testEnum(FIVE) = '+IntToStr(Ord(ret)));
706
707 ret := client.testEnum(TNumberz.EIGHT);
708 Expect( ret = TNumberz.EIGHT, 'testEnum(EIGHT) = '+IntToStr(Ord(ret)));
709
710
711 // typedef
712 uid := client.testTypedef(309858235082523);
713 Expect( uid = 309858235082523, 'testTypedef(309858235082523) = '+IntToStr(uid));
714
715
716 // maps of maps
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200717 StartTestGroup( 'testMapMap(1)', test_Containers);
Roger Meier3bef8c22012-10-06 06:58:00 +0000718 mm := client.testMapMap(1);
719 Console.Write(' = {');
720 for key in mm.Keys do
721 begin
722 Console.Write( IntToStr( key) + ' => {');
723 m2 := mm[key];
724 for k2 in m2.Keys do
725 begin
726 Console.Write( IntToStr( k2) + ' => ' + IntToStr( m2[k2]) + ', ');
727 end;
728 Console.Write('}, ');
729 end;
730 Console.WriteLine('}');
731
732 // verify result data
733 Expect( mm.Count = 2, 'mm.Count = '+IntToStr(mm.Count));
734 pos := mm[4];
735 neg := mm[-4];
736 for j := 1 to 4 do
737 begin
738 Expect( pos[j] = j, 'pos[j] = '+IntToStr(pos[j]));
739 Expect( neg[-j] = -j, 'neg[-j] = '+IntToStr(neg[-j]));
740 end;
741
742
743
744 // insanity
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200745 StartTestGroup( 'testInsanity', test_Structs);
Roger Meier3bef8c22012-10-06 06:58:00 +0000746 insane := TInsanityImpl.Create;
747 insane.UserMap := TThriftDictionaryImpl<TNumberz, Int64>.Create;
748 insane.UserMap.AddOrSetValue( TNumberz.FIVE, 5000);
749 truck := TXtructImpl.Create;
750 truck.String_thing := 'Truck';
751 truck.Byte_thing := 8;
752 truck.I32_thing := 8;
753 truck.I64_thing := 8;
754 insane.Xtructs := TThriftListImpl<IXtruct>.Create;
755 insane.Xtructs.Add( truck );
756 whoa := client.testInsanity( insane );
757 Console.Write(' = {');
758 for key64 in whoa.Keys do
759 begin
760 val := whoa[key64];
761 Console.Write( IntToStr( key64) + ' => {');
762 for k2_2 in val.Keys do
763 begin
764 v2 := val[k2_2];
765 Console.Write( IntToStr( Integer( k2_2)) + ' => {');
766 userMap := v2.UserMap;
767 Console.Write('{');
768 if userMap <> nil then
769 begin
770 for k3 in userMap.Keys do
771 begin
772 Console.Write( IntToStr( Integer( k3)) + ' => ' + IntToStr( userMap[k3]) + ', ');
773 end;
774 end else
775 begin
776 Console.Write('null');
777 end;
778 Console.Write('}, ');
779 xtructs := v2.Xtructs;
780 Console.Write('{');
781
782 if xtructs <> nil then
783 begin
784 for x in xtructs do
785 begin
786 Console.Write('{"' + x.String_thing + '", ' +
787 IntToStr( x.Byte_thing) + ', ' +
788 IntToStr( x.I32_thing) + ', ' +
789 IntToStr( x.I32_thing) + '}, ');
790 end;
791 end else
792 begin
793 Console.Write('null');
794 end;
795 Console.Write('}');
796 Console.Write('}, ');
797 end;
798 Console.Write('}, ');
799 end;
800 Console.WriteLine('}');
801
802 // verify result data
803 Expect( whoa.Count = 2, 'whoa.Count = '+IntToStr(whoa.Count));
804 //
805 first_map := whoa[1];
806 second_map := whoa[2];
807 Expect( first_map.Count = 2, 'first_map.Count = '+IntToStr(first_map.Count));
808 Expect( second_map.Count = 1, 'second_map.Count = '+IntToStr(second_map.Count));
809 //
810 looney := second_map[TNumberz.SIX];
811 Expect( Assigned(looney), 'Assigned(looney) = '+BoolToString(Assigned(looney)));
812 Expect( not looney.__isset_UserMap, 'looney.__isset_UserMap = '+BoolToString(looney.__isset_UserMap));
813 Expect( not looney.__isset_Xtructs, 'looney.__isset_Xtructs = '+BoolToString(looney.__isset_Xtructs));
814 //
815 for ret in [TNumberz.TWO, TNumberz.THREE] do begin
816 crazy := first_map[ret];
817 Console.WriteLine('first_map['+intToStr(Ord(ret))+']');
818
819 Expect( crazy.__isset_UserMap, 'crazy.__isset_UserMap = '+BoolToString(crazy.__isset_UserMap));
820 Expect( crazy.__isset_Xtructs, 'crazy.__isset_Xtructs = '+BoolToString(crazy.__isset_Xtructs));
821
822 Expect( crazy.UserMap.Count = 2, 'crazy.UserMap.Count = '+IntToStr(crazy.UserMap.Count));
823 Expect( crazy.UserMap[TNumberz.FIVE] = 5, 'crazy.UserMap[TNumberz.FIVE] = '+IntToStr(crazy.UserMap[TNumberz.FIVE]));
824 Expect( crazy.UserMap[TNumberz.EIGHT] = 8, 'crazy.UserMap[TNumberz.EIGHT] = '+IntToStr(crazy.UserMap[TNumberz.EIGHT]));
825
826 Expect( crazy.Xtructs.Count = 2, 'crazy.Xtructs.Count = '+IntToStr(crazy.Xtructs.Count));
827 goodbye := crazy.Xtructs[0]; // lists are ordered, so we are allowed to assume this order
Jens Geyerd5436f52014-10-03 19:50:38 +0200828 hello := crazy.Xtructs[1];
Roger Meier3bef8c22012-10-06 06:58:00 +0000829
830 Expect( goodbye.String_thing = 'Goodbye4', 'goodbye.String_thing = "'+goodbye.String_thing+'"');
831 Expect( goodbye.Byte_thing = 4, 'goodbye.Byte_thing = '+IntToStr(goodbye.Byte_thing));
832 Expect( goodbye.I32_thing = 4, 'goodbye.I32_thing = '+IntToStr(goodbye.I32_thing));
833 Expect( goodbye.I64_thing = 4, 'goodbye.I64_thing = '+IntToStr(goodbye.I64_thing));
834 Expect( goodbye.__isset_String_thing, 'goodbye.__isset_String_thing = '+BoolToString(goodbye.__isset_String_thing));
835 Expect( goodbye.__isset_Byte_thing, 'goodbye.__isset_Byte_thing = '+BoolToString(goodbye.__isset_Byte_thing));
836 Expect( goodbye.__isset_I32_thing, 'goodbye.__isset_I32_thing = '+BoolToString(goodbye.__isset_I32_thing));
837 Expect( goodbye.__isset_I64_thing, 'goodbye.__isset_I64_thing = '+BoolToString(goodbye.__isset_I64_thing));
838
839 Expect( hello.String_thing = 'Hello2', 'hello.String_thing = "'+hello.String_thing+'"');
840 Expect( hello.Byte_thing = 2, 'hello.Byte_thing = '+IntToStr(hello.Byte_thing));
841 Expect( hello.I32_thing = 2, 'hello.I32_thing = '+IntToStr(hello.I32_thing));
842 Expect( hello.I64_thing = 2, 'hello.I64_thing = '+IntToStr(hello.I64_thing));
843 Expect( hello.__isset_String_thing, 'hello.__isset_String_thing = '+BoolToString(hello.__isset_String_thing));
844 Expect( hello.__isset_Byte_thing, 'hello.__isset_Byte_thing = '+BoolToString(hello.__isset_Byte_thing));
845 Expect( hello.__isset_I32_thing, 'hello.__isset_I32_thing = '+BoolToString(hello.__isset_I32_thing));
846 Expect( hello.__isset_I64_thing, 'hello.__isset_I64_thing = '+BoolToString(hello.__isset_I64_thing));
847 end;
848
849
850 // multi args
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200851 StartTestGroup( 'testMulti', test_BaseTypes);
Roger Meier3bef8c22012-10-06 06:58:00 +0000852 arg0 := 1;
853 arg1 := 2;
854 arg2 := High(Int64);
855 arg3 := TThriftDictionaryImpl<SmallInt, string>.Create;
856 arg3.AddOrSetValue( 1, 'one');
857 arg4 := TNumberz.FIVE;
858 arg5 := 5000000;
859 Console.WriteLine('Test Multi(' + IntToStr( arg0) + ',' +
860 IntToStr( arg1) + ',' + IntToStr( arg2) + ',' +
861 arg3.ToString + ',' + IntToStr( Integer( arg4)) + ',' +
862 IntToStr( arg5) + ')');
863
864 i := client.testMulti( arg0, arg1, arg2, arg3, arg4, arg5);
865 Expect( i.String_thing = 'Hello2', 'testMulti: i.String_thing = "'+i.String_thing+'"');
866 Expect( i.Byte_thing = arg0, 'testMulti: i.Byte_thing = '+IntToStr(i.Byte_thing));
867 Expect( i.I32_thing = arg1, 'testMulti: i.I32_thing = '+IntToStr(i.I32_thing));
868 Expect( i.I64_thing = arg2, 'testMulti: i.I64_thing = '+IntToStr(i.I64_thing));
869 Expect( i.__isset_String_thing, 'testMulti: i.__isset_String_thing = '+BoolToString(i.__isset_String_thing));
870 Expect( i.__isset_Byte_thing, 'testMulti: i.__isset_Byte_thing = '+BoolToString(i.__isset_Byte_thing));
871 Expect( i.__isset_I32_thing, 'testMulti: i.__isset_I32_thing = '+BoolToString(i.__isset_I32_thing));
872 Expect( i.__isset_I64_thing, 'testMulti: i.__isset_I64_thing = '+BoolToString(i.__isset_I64_thing));
873
874 // multi exception
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200875 StartTestGroup( 'testMultiException(1)', test_Exceptions);
Roger Meier3bef8c22012-10-06 06:58:00 +0000876 try
877 i := client.testMultiException( 'need more pizza', 'run out of beer');
878 Expect( i.String_thing = 'run out of beer', 'i.String_thing = "' +i.String_thing+ '"');
879 Expect( i.__isset_String_thing, 'i.__isset_String_thing = '+BoolToString(i.__isset_String_thing));
Jens Geyer6bbbf192014-09-07 01:45:56 +0200880 { this is not necessarily true, these fields are default-serialized
Jens Geyerd5436f52014-10-03 19:50:38 +0200881 Expect( not i.__isset_Byte_thing, 'i.__isset_Byte_thing = '+BoolToString(i.__isset_Byte_thing));
Roger Meier3bef8c22012-10-06 06:58:00 +0000882 Expect( not i.__isset_I32_thing, 'i.__isset_I32_thing = '+BoolToString(i.__isset_I32_thing));
883 Expect( not i.__isset_I64_thing, 'i.__isset_I64_thing = '+BoolToString(i.__isset_I64_thing));
Jens Geyerd5436f52014-10-03 19:50:38 +0200884 }
Roger Meier3bef8c22012-10-06 06:58:00 +0000885 except
886 on e:Exception do Expect( FALSE, 'Unexpected exception "'+e.ClassName+'"');
887 end;
888
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200889 StartTestGroup( 'testMultiException(Xception)', test_Exceptions);
Roger Meier3bef8c22012-10-06 06:58:00 +0000890 try
891 i := client.testMultiException( 'Xception', 'second test');
892 Expect( FALSE, 'testMultiException(''Xception''): must trow an exception');
893 except
894 on x:TXception do begin
895 Expect( x.__isset_ErrorCode, 'x.__isset_ErrorCode = '+BoolToString(x.__isset_ErrorCode));
896 Expect( x.__isset_Message_, 'x.__isset_Message_ = '+BoolToString(x.__isset_Message_));
897 Expect( x.ErrorCode = 1001, 'x.ErrorCode = '+IntToStr(x.ErrorCode));
898 Expect( x.Message_ = 'This is an Xception', 'x.Message = "'+x.Message_+'"');
899 end;
900 on e:Exception do Expect( FALSE, 'Unexpected exception "'+e.ClassName+'"');
901 end;
902
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200903 StartTestGroup( 'testMultiException(Xception2)', test_Exceptions);
Roger Meier3bef8c22012-10-06 06:58:00 +0000904 try
905 i := client.testMultiException( 'Xception2', 'third test');
906 Expect( FALSE, 'testMultiException(''Xception2''): must trow an exception');
907 except
908 on x:TXception2 do begin
909 Expect( x.__isset_ErrorCode, 'x.__isset_ErrorCode = '+BoolToString(x.__isset_ErrorCode));
910 Expect( x.__isset_Struct_thing, 'x.__isset_Struct_thing = '+BoolToString(x.__isset_Struct_thing));
911 Expect( x.ErrorCode = 2002, 'x.ErrorCode = '+IntToStr(x.ErrorCode));
912 Expect( x.Struct_thing.String_thing = 'This is an Xception2', 'x.Struct_thing.String_thing = "'+x.Struct_thing.String_thing+'"');
913 Expect( x.Struct_thing.__isset_String_thing, 'x.Struct_thing.__isset_String_thing = '+BoolToString(x.Struct_thing.__isset_String_thing));
Jens Geyer6bbbf192014-09-07 01:45:56 +0200914 { this is not necessarily true, these fields are default-serialized
Roger Meier3bef8c22012-10-06 06:58:00 +0000915 Expect( not x.Struct_thing.__isset_Byte_thing, 'x.Struct_thing.__isset_Byte_thing = '+BoolToString(x.Struct_thing.__isset_Byte_thing));
916 Expect( not x.Struct_thing.__isset_I32_thing, 'x.Struct_thing.__isset_I32_thing = '+BoolToString(x.Struct_thing.__isset_I32_thing));
917 Expect( not x.Struct_thing.__isset_I64_thing, 'x.Struct_thing.__isset_I64_thing = '+BoolToString(x.Struct_thing.__isset_I64_thing));
Jens Geyerd5436f52014-10-03 19:50:38 +0200918 }
Roger Meier3bef8c22012-10-06 06:58:00 +0000919 end;
920 on e:Exception do Expect( FALSE, 'Unexpected exception "'+e.ClassName+'"');
921 end;
922
923
924 // oneway functions
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200925 StartTestGroup( 'Test Oneway(1)', test_Unknown);
Roger Meier3bef8c22012-10-06 06:58:00 +0000926 client.testOneway(1);
927 Expect( TRUE, 'Test Oneway(1)'); // success := no exception
928
929 // call time
Jens Geyer06045cf2013-03-27 20:26:25 +0200930 {$IFDEF PerfTest}
Roger Meier3bef8c22012-10-06 06:58:00 +0000931 StartTestGroup( 'Test Calltime()');
932 StartTick := GetTIckCount;
933 for k := 0 to 1000 - 1 do
934 begin
935 client.testVoid();
936 end;
937 Console.WriteLine(' = ' + FloatToStr( (GetTickCount - StartTick) / 1000 ) + ' ms a testVoid() call' );
Jens Geyer06045cf2013-03-27 20:26:25 +0200938 {$ENDIF PerfTest}
Roger Meier3bef8c22012-10-06 06:58:00 +0000939
940 // no more tests here
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200941 StartTestGroup( '', test_Unknown);
Roger Meier3bef8c22012-10-06 06:58:00 +0000942end;
943
944
Jens Geyer718f6ee2013-09-06 21:02:34 +0200945{$IFDEF StressTest}
Jens Geyer06045cf2013-03-27 20:26:25 +0200946procedure TClientThread.StressTest(const client : TThriftTest.Iface);
947begin
948 while TRUE do begin
949 try
950 if not FTransport.IsOpen then FTransport.Open; // re-open connection, server has already closed
951 try
952 client.testString('Test');
953 Write('.');
954 finally
955 if FTransport.IsOpen then FTransport.Close;
956 end;
957 except
958 on e:Exception do Writeln(#10+e.message);
959 end;
960 end;
961end;
Jens Geyer718f6ee2013-09-06 21:02:34 +0200962{$ENDIF}
Jens Geyer06045cf2013-03-27 20:26:25 +0200963
Roger Meier3bef8c22012-10-06 06:58:00 +0000964procedure TClientThread.JSONProtocolReadWriteTest;
965// Tests only then read/write procedures of the JSON protocol
966// All tests succeed, if we can read what we wrote before
967// Note that passing this test does not imply, that our JSON is really compatible to what
968// other clients or servers expect as the real JSON. This is beyond the scope of this test.
969var prot : IProtocol;
970 stm : TStringStream;
971 list : IList;
972 binary, binRead : TBytes;
973 i,iErr : Integer;
974const
975 TEST_SHORT = ShortInt( $FE);
976 TEST_SMALL = SmallInt( $FEDC);
977 TEST_LONG = LongInt( $FEDCBA98);
978 TEST_I64 = Int64( $FEDCBA9876543210);
979 TEST_DOUBLE = -1.234e-56;
980 DELTA_DOUBLE = TEST_DOUBLE * 1e-14;
981 TEST_STRING = 'abc-'#$00E4#$00f6#$00fc; // german umlauts (en-us: "funny chars")
Jens Geyer7bb44a32014-02-07 22:24:37 +0100982 // Test THRIFT-2336 with 'Русское Название';
983 RUSSIAN_TEXT = #$0420#$0443#$0441#$0441#$043a#$043e#$0435' '#$041d#$0430#$0437#$0432#$0430#$043d#$0438#$0435;
984 RUSSIAN_JSON = '"\u0420\u0443\u0441\u0441\u043a\u043e\u0435 \u041d\u0430\u0437\u0432\u0430\u043d\u0438\u0435"';
Jens Geyer21366942013-12-30 22:04:51 +0100985 // test both possible solidus encodings
986 SOLIDUS_JSON_DATA = '"one/two\/three"';
987 SOLIDUS_EXCPECTED = 'one/two/three';
Roger Meier3bef8c22012-10-06 06:58:00 +0000988begin
989 stm := TStringStream.Create;
990 try
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200991 StartTestGroup( 'JsonProtocolTest', test_Unknown);
Roger Meier3bef8c22012-10-06 06:58:00 +0000992
993 // prepare binary data
994 SetLength( binary, $100);
995 for i := Low(binary) to High(binary) do binary[i] := i;
996
997 // output setup
998 prot := TJSONProtocolImpl.Create(
999 TStreamTransportImpl.Create(
1000 nil, TThriftStreamAdapterDelphi.Create( stm, FALSE)));
1001
1002 // write
1003 prot.WriteListBegin( TListImpl.Create( TType.String_, 9));
1004 prot.WriteBool( TRUE);
1005 prot.WriteBool( FALSE);
1006 prot.WriteByte( TEST_SHORT);
1007 prot.WriteI16( TEST_SMALL);
1008 prot.WriteI32( TEST_LONG);
1009 prot.WriteI64( TEST_I64);
1010 prot.WriteDouble( TEST_DOUBLE);
1011 prot.WriteString( TEST_STRING);
1012 prot.WriteBinary( binary);
1013 prot.WriteListEnd;
1014
1015 // input setup
1016 Expect( stm.Position = stm.Size, 'Stream position/length after write');
1017 stm.Position := 0;
1018 prot := TJSONProtocolImpl.Create(
1019 TStreamTransportImpl.Create(
1020 TThriftStreamAdapterDelphi.Create( stm, FALSE), nil));
1021
1022 // read and compare
1023 list := prot.ReadListBegin;
1024 Expect( list.ElementType = TType.String_, 'list element type');
1025 Expect( list.Count = 9, 'list element count');
1026 Expect( prot.ReadBool, 'WriteBool/ReadBool: TRUE');
1027 Expect( not prot.ReadBool, 'WriteBool/ReadBool: FALSE');
1028 Expect( prot.ReadByte = TEST_SHORT, 'WriteByte/ReadByte');
1029 Expect( prot.ReadI16 = TEST_SMALL, 'WriteI16/ReadI16');
1030 Expect( prot.ReadI32 = TEST_LONG, 'WriteI32/ReadI32');
1031 Expect( prot.ReadI64 = TEST_I64, 'WriteI64/ReadI64');
1032 Expect( abs(prot.ReadDouble-TEST_DOUBLE) < abs(DELTA_DOUBLE), 'WriteDouble/ReadDouble');
1033 Expect( prot.ReadString = TEST_STRING, 'WriteString/ReadString');
1034 binRead := prot.ReadBinary;
1035 prot.ReadListEnd;
1036
1037 // test binary data
1038 Expect( Length(binary) = Length(binRead), 'Binary data length check');
1039 iErr := -1;
1040 for i := Low(binary) to High(binary) do begin
1041 if binary[i] <> binRead[i] then begin
1042 iErr := i;
1043 Break;
1044 end;
1045 end;
1046 if iErr < 0
1047 then Expect( TRUE, 'Binary data check ('+IntToStr(Length(binary))+' Bytes)')
1048 else Expect( FALSE, 'Binary data check at offset '+IntToStr(iErr));
1049
1050 Expect( stm.Position = stm.Size, 'Stream position after read');
1051
Jens Geyer7bb44a32014-02-07 22:24:37 +01001052
Jens Geyer21366942013-12-30 22:04:51 +01001053 // Solidus can be encoded in two ways. Make sure we can read both
1054 stm.Position := 0;
1055 stm.Size := 0;
1056 stm.WriteString(SOLIDUS_JSON_DATA);
1057 stm.Position := 0;
1058 prot := TJSONProtocolImpl.Create(
1059 TStreamTransportImpl.Create(
1060 TThriftStreamAdapterDelphi.Create( stm, FALSE), nil));
1061 Expect( prot.ReadString = SOLIDUS_EXCPECTED, 'Solidus encoding');
1062
1063
Jens Geyer7bb44a32014-02-07 22:24:37 +01001064 // Widechars should work too. Do they?
1065 // After writing, we ensure that we are able to read it back
1066 // We can't assume hex-encoding, since (nearly) any Unicode char is valid JSON
1067 stm.Position := 0;
1068 stm.Size := 0;
1069 prot := TJSONProtocolImpl.Create(
1070 TStreamTransportImpl.Create(
1071 nil, TThriftStreamAdapterDelphi.Create( stm, FALSE)));
1072 prot.WriteString( RUSSIAN_TEXT);
1073 stm.Position := 0;
1074 prot := TJSONProtocolImpl.Create(
1075 TStreamTransportImpl.Create(
1076 TThriftStreamAdapterDelphi.Create( stm, FALSE), nil));
1077 Expect( prot.ReadString = RUSSIAN_TEXT, 'Writing JSON with chars > 8 bit');
1078
1079 // Widechars should work with hex-encoding too. Do they?
1080 stm.Position := 0;
1081 stm.Size := 0;
1082 stm.WriteString( RUSSIAN_JSON);
1083 stm.Position := 0;
1084 prot := TJSONProtocolImpl.Create(
1085 TStreamTransportImpl.Create(
1086 TThriftStreamAdapterDelphi.Create( stm, FALSE), nil));
1087 Expect( prot.ReadString = RUSSIAN_TEXT, 'Reading JSON with chars > 8 bit');
1088
1089
Roger Meier3bef8c22012-10-06 06:58:00 +00001090 finally
1091 stm.Free;
1092 prot := nil; //-> Release
Jens Geyerf8a1b7a2014-09-24 00:26:46 +02001093 StartTestGroup( '', test_Unknown); // no more tests here
Roger Meier3bef8c22012-10-06 06:58:00 +00001094 end;
1095end;
1096
1097
Jens Geyerf8a1b7a2014-09-24 00:26:46 +02001098procedure TClientThread.StartTestGroup( const aGroup : string; const aTest : TTestGroup);
Roger Meier3bef8c22012-10-06 06:58:00 +00001099begin
1100 FTestGroup := aGroup;
Jens Geyerf8a1b7a2014-09-24 00:26:46 +02001101 FCurrentTest := aTest;
1102
1103 Include( FExecuted, aTest);
1104
Roger Meier3bef8c22012-10-06 06:58:00 +00001105 if FTestGroup <> '' then begin
1106 Console.WriteLine('');
1107 Console.WriteLine( aGroup+' tests');
1108 Console.WriteLine( StringOfChar('-',60));
1109 end;
1110end;
1111
1112
1113procedure TClientThread.Expect( aTestResult : Boolean; const aTestInfo : string);
1114begin
1115 if aTestResult then begin
1116 Inc(FSuccesses);
1117 Console.WriteLine( aTestInfo+': passed');
1118 end
1119 else begin
1120 FErrors.Add( FTestGroup+': '+aTestInfo);
Jens Geyerf8a1b7a2014-09-24 00:26:46 +02001121 Include( FFailed, FCurrentTest);
Roger Meier3bef8c22012-10-06 06:58:00 +00001122 Console.WriteLine( aTestInfo+': *** FAILED ***');
1123
1124 // We have a failed test!
1125 // -> issue DebugBreak ONLY if a debugger is attached,
1126 // -> unhandled DebugBreaks would cause Windows to terminate the app otherwise
1127 if IsDebuggerPresent then asm int 3 end;
1128 end;
1129end;
1130
1131
1132procedure TClientThread.ReportResults;
1133var nTotal : Integer;
1134 sLine : string;
1135begin
1136 // prevent us from stupid DIV/0 errors
1137 nTotal := FSuccesses + FErrors.Count;
1138 if nTotal = 0 then begin
1139 Console.WriteLine('No results logged');
1140 Exit;
1141 end;
1142
1143 Console.WriteLine('');
1144 Console.WriteLine( StringOfChar('=',60));
1145 Console.WriteLine( IntToStr(nTotal)+' tests performed');
1146 Console.WriteLine( IntToStr(FSuccesses)+' tests succeeded ('+IntToStr(round(100*FSuccesses/nTotal))+'%)');
1147 Console.WriteLine( IntToStr(FErrors.Count)+' tests failed ('+IntToStr(round(100*FErrors.Count/nTotal))+'%)');
1148 Console.WriteLine( StringOfChar('=',60));
1149 if FErrors.Count > 0 then begin
1150 Console.WriteLine('FAILED TESTS:');
1151 for sLine in FErrors do Console.WriteLine('- '+sLine);
1152 Console.WriteLine( StringOfChar('=',60));
1153 InterlockedIncrement( ExitCode); // return <> 0 on errors
1154 end;
1155 Console.WriteLine('');
1156end;
1157
1158
Jens Geyerf8a1b7a2014-09-24 00:26:46 +02001159function TClientThread.CalculateExitCode : Byte;
1160var test : TTestGroup;
1161begin
1162 result := EXITCODE_SUCCESS;
1163 for test := Low(TTestGroup) to High(TTestGroup) do begin
1164 if (test in FFailed) or not (test in FExecuted)
1165 then result := result or MAP_FAILURES_TO_EXITCODE_BITS[test];
1166 end;
1167end;
1168
1169
Roger Meier3bef8c22012-10-06 06:58:00 +00001170constructor TClientThread.Create( const ATransport: ITransport; const AProtocol : IProtocol; ANumIteration: Integer);
1171begin
1172 inherited Create( True );
1173 FNumIteration := ANumIteration;
1174 FTransport := ATransport;
1175 FProtocol := AProtocol;
1176 FConsole := TThreadConsole.Create( Self );
Jens Geyerf8a1b7a2014-09-24 00:26:46 +02001177 FCurrentTest := test_Unknown;
Roger Meier3bef8c22012-10-06 06:58:00 +00001178
1179 // error list: keep correct order, allow for duplicates
1180 FErrors := TStringList.Create;
1181 FErrors.Sorted := FALSE;
1182 FErrors.Duplicates := dupAccept;
1183end;
1184
1185destructor TClientThread.Destroy;
1186begin
1187 FreeAndNil( FConsole);
1188 FreeAndNil( FErrors);
1189 inherited;
1190end;
1191
1192procedure TClientThread.Execute;
1193var
1194 i : Integer;
1195 proc : TThreadProcedure;
1196begin
1197 // perform all tests
1198 try
Jens Geyer7bb44a32014-02-07 22:24:37 +01001199 JSONProtocolReadWriteTest;
Roger Meier3bef8c22012-10-06 06:58:00 +00001200 for i := 0 to FNumIteration - 1 do
1201 begin
1202 ClientTest;
Roger Meier3bef8c22012-10-06 06:58:00 +00001203 end;
1204 except
1205 on e:Exception do Expect( FALSE, 'unexpected exception: "'+e.message+'"');
1206 end;
1207
1208 // report the outcome
1209 ReportResults;
Jens Geyerf8a1b7a2014-09-24 00:26:46 +02001210 SetReturnValue( CalculateExitCode);
Roger Meier3bef8c22012-10-06 06:58:00 +00001211
1212 // shutdown
1213 proc := procedure
1214 begin
1215 if FTransport <> nil then
1216 begin
1217 FTransport.Close;
1218 FTransport := nil;
1219 end;
1220 end;
1221
1222 Synchronize( proc );
1223end;
1224
Jens Geyerf8a1b7a2014-09-24 00:26:46 +02001225
Roger Meier3bef8c22012-10-06 06:58:00 +00001226{ TThreadConsole }
1227
1228constructor TThreadConsole.Create(AThread: TThread);
1229begin
Jens Geyer718f6ee2013-09-06 21:02:34 +02001230 inherited Create;
Roger Meier3bef8c22012-10-06 06:58:00 +00001231 FThread := AThread;
1232end;
1233
1234procedure TThreadConsole.Write(const S: string);
1235var
1236 proc : TThreadProcedure;
1237begin
1238 proc := procedure
1239 begin
1240 Console.Write( S );
1241 end;
1242 TThread.Synchronize( FThread, proc);
1243end;
1244
1245procedure TThreadConsole.WriteLine(const S: string);
1246var
1247 proc : TThreadProcedure;
1248begin
1249 proc := procedure
1250 begin
1251 Console.WriteLine( S );
1252 end;
1253 TThread.Synchronize( FThread, proc);
1254end;
1255
1256initialization
1257begin
1258 TTestClient.FNumIteration := 1;
1259 TTestClient.FNumThread := 1;
1260end;
1261
1262end.