blob: 043ff331b8b2401adf95f6b573beffc49105d51a [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 Geyer9f7f11e2016-04-14 21:37:11 +020022{$I ../src/Thrift.Defines.inc}
23
Jens Geyer06045cf2013-03-27 20:26:25 +020024{.$DEFINE StressTest} // activate to stress-test the server with frequent connects/disconnects
25{.$DEFINE PerfTest} // activate to activate the performance test
26
Roger Meier3bef8c22012-10-06 06:58:00 +000027interface
28
29uses
Jens Geyerfd1b3582014-12-13 23:42:58 +010030 Windows, SysUtils, Classes, Math,
Roger Meier3bef8c22012-10-06 06:58:00 +000031 DateUtils,
32 Generics.Collections,
33 TestConstants,
34 Thrift,
Jens Geyerf0e63312015-03-01 18:47:49 +010035 Thrift.Protocol.Compact,
Roger Meier3bef8c22012-10-06 06:58:00 +000036 Thrift.Protocol.JSON,
37 Thrift.Protocol,
38 Thrift.Transport.Pipes,
39 Thrift.Transport,
40 Thrift.Stream,
41 Thrift.Test,
Jens Geyerf7904452017-07-26 15:02:12 +020042 Thrift.Utils,
Roger Meier3bef8c22012-10-06 06:58:00 +000043 Thrift.Collections,
44 Thrift.Console;
45
46type
47 TThreadConsole = class
48 private
49 FThread : TThread;
50 public
51 procedure Write( const S : string);
52 procedure WriteLine( const S : string);
53 constructor Create( AThread: TThread);
54 end;
55
56 TClientThread = class( TThread )
Jens Geyerf8a1b7a2014-09-24 00:26:46 +020057 private type
58 TTestGroup = (
59 test_Unknown,
60 test_BaseTypes,
61 test_Structs,
62 test_Containers,
63 test_Exceptions
64 // new values here
65 );
66 TTestGroups = set of TTestGroup;
67
Roger Meier3bef8c22012-10-06 06:58:00 +000068 private
69 FTransport : ITransport;
70 FProtocol : IProtocol;
71 FNumIteration : Integer;
72 FConsole : TThreadConsole;
73
74 // test reporting, will be refactored out into separate class later
75 FTestGroup : string;
Jens Geyerf8a1b7a2014-09-24 00:26:46 +020076 FCurrentTest : TTestGroup;
Roger Meier3bef8c22012-10-06 06:58:00 +000077 FSuccesses : Integer;
78 FErrors : TStringList;
Jens Geyerf8a1b7a2014-09-24 00:26:46 +020079 FFailed : TTestGroups;
80 FExecuted : TTestGroups;
81 procedure StartTestGroup( const aGroup : string; const aTest : TTestGroup);
Roger Meier3bef8c22012-10-06 06:58:00 +000082 procedure Expect( aTestResult : Boolean; const aTestInfo : string);
83 procedure ReportResults;
Jens Geyerfd1b3582014-12-13 23:42:58 +010084 function CalculateExitCode : Byte;
Roger Meier3bef8c22012-10-06 06:58:00 +000085
86 procedure ClientTest;
87 procedure JSONProtocolReadWriteTest;
Jens Geyerfd1b3582014-12-13 23:42:58 +010088 function PrepareBinaryData( aRandomDist : Boolean = FALSE) : TBytes;
Jens Geyer718f6ee2013-09-06 21:02:34 +020089 {$IFDEF StressTest}
Jens Geyer06045cf2013-03-27 20:26:25 +020090 procedure StressTest(const client : TThriftTest.Iface);
Jens Geyer718f6ee2013-09-06 21:02:34 +020091 {$ENDIF}
Jens Geyerf7904452017-07-26 15:02:12 +020092 {$IFDEF Win64}
93 procedure UseInterlockedExchangeAdd64;
94 {$ENDIF}
Roger Meier3bef8c22012-10-06 06:58:00 +000095 protected
96 procedure Execute; override;
97 public
98 constructor Create( const ATransport: ITransport; const AProtocol : IProtocol; ANumIteration: Integer);
99 destructor Destroy; override;
100 end;
101
102 TTestClient = class
103 private
104 class var
105 FNumIteration : Integer;
106 FNumThread : Integer;
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200107
108 class procedure PrintCmdLineHelp;
109 class procedure InvalidArgs;
Roger Meier3bef8c22012-10-06 06:58:00 +0000110 public
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200111 class function Execute( const args: array of string) : Byte;
Roger Meier3bef8c22012-10-06 06:58:00 +0000112 end;
113
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200114
Roger Meier3bef8c22012-10-06 06:58:00 +0000115implementation
116
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200117const
118 EXITCODE_SUCCESS = $00; // no errors bits set
119 //
120 EXITCODE_FAILBIT_BASETYPES = $01;
121 EXITCODE_FAILBIT_STRUCTS = $02;
122 EXITCODE_FAILBIT_CONTAINERS = $04;
123 EXITCODE_FAILBIT_EXCEPTIONS = $08;
124
125 MAP_FAILURES_TO_EXITCODE_BITS : array[TClientThread.TTestGroup] of Byte = (
126 EXITCODE_SUCCESS, // no bits here
127 EXITCODE_FAILBIT_BASETYPES,
128 EXITCODE_FAILBIT_STRUCTS,
129 EXITCODE_FAILBIT_CONTAINERS,
130 EXITCODE_FAILBIT_EXCEPTIONS
131 );
132
133
134
Roger Meier3bef8c22012-10-06 06:58:00 +0000135function BoolToString( b : Boolean) : string;
136// overrides global BoolToString()
137begin
138 if b
139 then result := 'true'
140 else result := 'false';
141end;
142
143// not available in all versions, so make sure we have this one imported
144function IsDebuggerPresent: BOOL; stdcall; external KERNEL32 name 'IsDebuggerPresent';
145
146{ TTestClient }
147
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200148class procedure TTestClient.PrintCmdLineHelp;
149const HELPTEXT = ' [options]'#10
150 + #10
151 + 'Allowed options:'#10
152 + ' -h [ --help ] produce help message'#10
153 + ' --host arg (=localhost) Host to connect'#10
154 + ' --port arg (=9090) Port number to connect'#10
155 + ' --domain-socket arg Domain Socket (e.g. /tmp/ThriftTest.thrift),'#10
156 + ' instead of host and port'#10
157 + ' --named-pipe arg Windows Named Pipe (e.g. MyThriftPipe)'#10
158 + ' --anon-pipes hRead hWrite Windows Anonymous Pipes pair (handles)'#10
159 + ' --transport arg (=sockets) Transport: buffered, framed, http, evhttp'#10
160 + ' --protocol arg (=binary) Protocol: binary, compact, json'#10
161 + ' --ssl Encrypted Transport using SSL'#10
162 + ' -n [ --testloops ] arg (=1) Number of Tests'#10
163 + ' -t [ --threads ] arg (=1) Number of Test threads'#10
164 ;
165begin
166 Writeln( ChangeFileExt(ExtractFileName(ParamStr(0)),'') + HELPTEXT);
167end;
168
169class procedure TTestClient.InvalidArgs;
170begin
171 Console.WriteLine( 'Invalid args.');
172 Console.WriteLine( ChangeFileExt(ExtractFileName(ParamStr(0)),'') + ' -h for more information');
173 Abort;
174end;
175
176class function TTestClient.Execute(const args: array of string) : Byte;
Roger Meier3bef8c22012-10-06 06:58:00 +0000177var
178 i : Integer;
179 host : string;
180 port : Integer;
Roger Meier3bef8c22012-10-06 06:58:00 +0000181 sPipeName : string;
182 hAnonRead, hAnonWrite : THandle;
183 s : string;
Roger Meier3bef8c22012-10-06 06:58:00 +0000184 threads : array of TThread;
185 dtStart : TDateTime;
186 test : Integer;
187 thread : TThread;
188 trans : ITransport;
189 prot : IProtocol;
190 streamtrans : IStreamTransport;
191 http : IHTTPClient;
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200192 protType : TKnownProtocol;
193 endpoint : TEndpointTransport;
194 layered : TLayeredTransports;
195 UseSSL : Boolean; // include where appropriate (TLayeredTransport?)
Jens Geyer0b20cc82013-03-07 20:47:01 +0100196const
197 // pipe timeouts to be used
198 DEBUG_TIMEOUT = 30 * 1000;
Jens Geyer3e8d9272014-09-14 20:10:40 +0200199 RELEASE_TIMEOUT = DEFAULT_THRIFT_TIMEOUT;
Jens Geyer0b20cc82013-03-07 20:47:01 +0100200 TIMEOUT = RELEASE_TIMEOUT;
Roger Meier3bef8c22012-10-06 06:58:00 +0000201begin
Roger Meier3bef8c22012-10-06 06:58:00 +0000202 protType := prot_Binary;
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200203 endpoint := trns_Sockets;
204 layered := [];
205 UseSSL := FALSE;
206 host := 'localhost';
207 port := 9090;
208 sPipeName := '';
209 hAnonRead := INVALID_HANDLE_VALUE;
210 hAnonWrite := INVALID_HANDLE_VALUE;
Roger Meier3bef8c22012-10-06 06:58:00 +0000211 try
Roger Meier3bef8c22012-10-06 06:58:00 +0000212 i := 0;
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200213 while ( i < Length(args) ) do begin
214 s := args[i];
215 Inc( i);
Roger Meier3bef8c22012-10-06 06:58:00 +0000216
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200217 if (s = '-h') or (s = '--help') then begin
218 // -h [ --help ] produce help message
219 PrintCmdLineHelp;
220 result := $FF; // all tests failed
221 Exit;
222 end
Jens Geyerb360b652014-09-28 01:55:46 +0200223 else if s = '--host' then begin
224 // --host arg (=localhost) Host to connect
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200225 host := args[i];
226 Inc( i);
227 end
Jens Geyerb360b652014-09-28 01:55:46 +0200228 else if s = '--port' then begin
229 // --port arg (=9090) Port number to connect
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200230 s := args[i];
231 Inc( i);
232 port := StrToIntDef(s,0);
233 if port <= 0 then InvalidArgs;
234 end
Jens Geyerb360b652014-09-28 01:55:46 +0200235 else if s = '--domain-socket' then begin
236 // --domain-socket arg Domain Socket (e.g. /tmp/ThriftTest.thrift), instead of host and port
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200237 raise Exception.Create('domain-socket not supported');
238 end
Jens Geyerb360b652014-09-28 01:55:46 +0200239 else if s = '--named-pipe' then begin
240 // --named-pipe arg Windows Named Pipe (e.g. MyThriftPipe)
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200241 endpoint := trns_NamedPipes;
242 sPipeName := args[i];
243 Inc( i);
244 end
Jens Geyerb360b652014-09-28 01:55:46 +0200245 else if s = '--anon-pipes' then begin
246 // --anon-pipes hRead hWrite Windows Anonymous Pipes pair (handles)
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200247 endpoint := trns_AnonPipes;
248 hAnonRead := THandle( StrToIntDef( args[i], Integer(INVALID_HANDLE_VALUE)));
249 Inc( i);
250 hAnonWrite := THandle( StrToIntDef( args[i], Integer(INVALID_HANDLE_VALUE)));
251 Inc( i);
252 end
Jens Geyerb360b652014-09-28 01:55:46 +0200253 else if s = '--transport' then begin
254 // --transport arg (=sockets) Transport: buffered, framed, http, evhttp
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200255 s := args[i];
256 Inc( i);
Roger Meier3bef8c22012-10-06 06:58:00 +0000257
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200258 if s = 'buffered' then Include( layered, trns_Buffered)
259 else if s = 'framed' then Include( layered, trns_Framed)
260 else if s = 'http' then endpoint := trns_Http
261 else if s = 'evhttp' then endpoint := trns_AnonPipes
262 else InvalidArgs;
263 end
Jens Geyerb360b652014-09-28 01:55:46 +0200264 else if s = '--protocol' then begin
265 // --protocol arg (=binary) Protocol: binary, compact, json
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200266 s := args[i];
267 Inc( i);
Roger Meier3bef8c22012-10-06 06:58:00 +0000268
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200269 if s = 'binary' then protType := prot_Binary
270 else if s = 'compact' then protType := prot_Compact
271 else if s = 'json' then protType := prot_JSON
272 else InvalidArgs;
273 end
Jens Geyerb360b652014-09-28 01:55:46 +0200274 else if s = '--ssl' then begin
275 // --ssl Encrypted Transport using SSL
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200276 UseSSL := TRUE;
277
278 end
279 else if (s = '-n') or (s = '--testloops') then begin
280 // -n [ --testloops ] arg (=1) Number of Tests
281 FNumIteration := StrToIntDef( args[i], 0);
282 Inc( i);
283 if FNumIteration <= 0
284 then InvalidArgs;
285
286 end
287 else if (s = '-t') or (s = '--threads') then begin
288 // -t [ --threads ] arg (=1) Number of Test threads
289 FNumThread := StrToIntDef( args[i], 0);
290 Inc( i);
291 if FNumThread <= 0
292 then InvalidArgs;
293 end
294 else begin
295 InvalidArgs;
Roger Meier3bef8c22012-10-06 06:58:00 +0000296 end;
297 end;
298
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200299
Roger Meier79655fb2012-10-20 20:59:41 +0000300 // In the anonymous pipes mode the client is launched by the test server
301 // -> behave nicely and allow for attaching a debugger to this process
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200302 if (endpoint = trns_AnonPipes) and not IsDebuggerPresent
Roger Meier79655fb2012-10-20 20:59:41 +0000303 then MessageBox( 0, 'Attach Debugger and/or click OK to continue.',
304 'Thrift TestClient (Delphi)',
305 MB_OK or MB_ICONEXCLAMATION);
306
Roger Meier3bef8c22012-10-06 06:58:00 +0000307 SetLength( threads, FNumThread);
308 dtStart := Now;
309
310 for test := 0 to FNumThread - 1 do
311 begin
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200312 case endpoint of
313 trns_Sockets: begin
Roger Meier3bef8c22012-10-06 06:58:00 +0000314 Console.WriteLine('Using sockets ('+host+' port '+IntToStr(port)+')');
315 streamtrans := TSocketImpl.Create( host, port );
316 end;
317
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200318 trns_Http: begin
319 Console.WriteLine('Using HTTPClient');
320 http := THTTPClientImpl.Create( host);
321 trans := http;
Roger Meier3bef8c22012-10-06 06:58:00 +0000322 end;
323
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200324 trns_EvHttp: begin
325 raise Exception.Create(ENDPOINT_TRANSPORTS[endpoint]+' transport not implemented');
Roger Meier3bef8c22012-10-06 06:58:00 +0000326 end;
327
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200328 trns_NamedPipes: begin
329 Console.WriteLine('Using named pipe ('+sPipeName+')');
Jens Geyerae985dd2016-04-20 21:48:35 +0200330 streamtrans := TNamedPipeTransportClientEndImpl.Create( sPipeName, 0, nil, TIMEOUT, TIMEOUT);
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200331 end;
332
333 trns_AnonPipes: begin
334 Console.WriteLine('Using anonymous pipes ('+IntToStr(Integer(hAnonRead))+' and '+IntToStr(Integer(hAnonWrite))+')');
335 streamtrans := TAnonymousPipeTransportImpl.Create( hAnonRead, hAnonWrite, FALSE);
336 end;
337
338 else
339 raise Exception.Create('Unhandled endpoint transport');
340 end;
341 trans := streamtrans;
342 ASSERT( trans <> nil);
343
344 if (trns_Buffered in layered) then begin
345 trans := TBufferedTransportImpl.Create( streamtrans, 32); // small buffer to test read()
346 Console.WriteLine('Using buffered transport');
347 end;
348
349 if (trns_Framed in layered) then begin
350 trans := TFramedTransportImpl.Create( trans );
351 Console.WriteLine('Using framed transport');
352 end;
353
354 if UseSSL then begin
355 raise Exception.Create('SSL not implemented');
Roger Meier3bef8c22012-10-06 06:58:00 +0000356 end;
357
358 // create protocol instance, default to BinaryProtocol
359 case protType of
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200360 prot_Binary : prot := TBinaryProtocolImpl.Create( trans, BINARY_STRICT_READ, BINARY_STRICT_WRITE);
361 prot_JSON : prot := TJSONProtocolImpl.Create( trans);
Jens Geyerf0e63312015-03-01 18:47:49 +0100362 prot_Compact : prot := TCompactProtocolImpl.Create( trans);
Roger Meier3bef8c22012-10-06 06:58:00 +0000363 else
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200364 raise Exception.Create('Unhandled protocol');
Roger Meier3bef8c22012-10-06 06:58:00 +0000365 end;
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200366 ASSERT( trans <> nil);
367 Console.WriteLine(THRIFT_PROTOCOLS[protType]+' protocol');
Roger Meier3bef8c22012-10-06 06:58:00 +0000368
369 thread := TClientThread.Create( trans, prot, FNumIteration);
370 threads[test] := thread;
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200371 thread.Start;
Roger Meier3bef8c22012-10-06 06:58:00 +0000372 end;
373
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200374 result := 0;
375 for test := 0 to FNumThread - 1 do begin
376 result := result or threads[test].WaitFor;
Roger Meier3bef8c22012-10-06 06:58:00 +0000377 end;
378
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200379 for test := 0 to FNumThread - 1
380 do threads[test].Free;
Roger Meier3bef8c22012-10-06 06:58:00 +0000381
382 Console.Write('Total time: ' + IntToStr( MilliSecondsBetween(Now, dtStart)));
383
384 except
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200385 on E: EAbort do raise;
386 on E: Exception do begin
387 Console.WriteLine( E.Message + #10 + E.StackTrace);
388 raise;
Roger Meier3bef8c22012-10-06 06:58:00 +0000389 end;
390 end;
391
392 Console.WriteLine('');
393 Console.WriteLine('done!');
394end;
395
396{ TClientThread }
397
398procedure TClientThread.ClientTest;
399var
400 client : TThriftTest.Iface;
401 s : string;
402 i8 : ShortInt;
403 i32 : Integer;
404 i64 : Int64;
Jens Geyerfd1b3582014-12-13 23:42:58 +0100405 binOut,binIn : TBytes;
Roger Meier3bef8c22012-10-06 06:58:00 +0000406 dub : Double;
407 o : IXtruct;
408 o2 : IXtruct2;
409 i : IXtruct;
410 i2 : IXtruct2;
411 mapout : IThriftDictionary<Integer,Integer>;
412 mapin : IThriftDictionary<Integer,Integer>;
413 strmapout : IThriftDictionary<string,string>;
414 strmapin : IThriftDictionary<string,string>;
415 j : Integer;
416 first : Boolean;
417 key : Integer;
418 strkey : string;
419 listout : IThriftList<Integer>;
420 listin : IThriftList<Integer>;
421 setout : IHashSet<Integer>;
422 setin : IHashSet<Integer>;
423 ret : TNumberz;
424 uid : Int64;
425 mm : IThriftDictionary<Integer, IThriftDictionary<Integer, Integer>>;
426 pos : IThriftDictionary<Integer, Integer>;
427 neg : IThriftDictionary<Integer, Integer>;
428 m2 : IThriftDictionary<Integer, Integer>;
429 k2 : Integer;
430 insane : IInsanity;
431 truck : IXtruct;
432 whoa : IThriftDictionary<Int64, IThriftDictionary<TNumberz, IInsanity>>;
433 key64 : Int64;
434 val : IThriftDictionary<TNumberz, IInsanity>;
435 k2_2 : TNumberz;
436 k3 : TNumberz;
437 v2 : IInsanity;
438 userMap : IThriftDictionary<TNumberz, Int64>;
439 xtructs : IThriftList<IXtruct>;
440 x : IXtruct;
441 arg0 : ShortInt;
442 arg1 : Integer;
443 arg2 : Int64;
444 arg3 : IThriftDictionary<SmallInt, string>;
445 arg4 : TNumberz;
446 arg5 : Int64;
Jens Geyer9f7f11e2016-04-14 21:37:11 +0200447 {$IFDEF PerfTest}
Roger Meier3bef8c22012-10-06 06:58:00 +0000448 StartTick : Cardinal;
449 k : Integer;
Jens Geyer9f7f11e2016-04-14 21:37:11 +0200450 {$ENDIF}
Roger Meier3bef8c22012-10-06 06:58:00 +0000451 hello, goodbye : IXtruct;
452 crazy : IInsanity;
453 looney : IInsanity;
454 first_map : IThriftDictionary<TNumberz, IInsanity>;
455 second_map : IThriftDictionary<TNumberz, IInsanity>;
Jens Geyer540e3462016-12-28 14:25:41 +0100456 pair : TPair<TNumberz, TUserId>;
Roger Meier3bef8c22012-10-06 06:58:00 +0000457begin
458 client := TThriftTest.TClient.Create( FProtocol);
459 FTransport.Open;
460
Jens Geyer06045cf2013-03-27 20:26:25 +0200461 {$IFDEF StressTest}
462 StressTest( client);
463 {$ENDIF StressTest}
464
Roger Meier3bef8c22012-10-06 06:58:00 +0000465 // in-depth exception test
466 // (1) do we get an exception at all?
467 // (2) do we get the right exception?
468 // (3) does the exception contain the expected data?
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200469 StartTestGroup( 'testException', test_Exceptions);
Roger Meier3bef8c22012-10-06 06:58:00 +0000470 // case 1: exception type declared in IDL at the function call
471 try
472 client.testException('Xception');
473 Expect( FALSE, 'testException(''Xception''): must trow an exception');
474 except
475 on e:TXception do begin
476 Expect( e.ErrorCode = 1001, 'error code');
477 Expect( e.Message_ = 'Xception', 'error message');
478 Console.WriteLine( ' = ' + IntToStr(e.ErrorCode) + ', ' + e.Message_ );
479 end;
480 on e:TTransportException do Expect( FALSE, 'Unexpected : "'+e.ToString+'"');
481 on e:Exception do Expect( FALSE, 'Unexpected exception type "'+e.ClassName+'"');
482 end;
483
484 // case 2: exception type NOT declared in IDL at the function call
485 // this will close the connection
486 try
487 client.testException('TException');
488 Expect( FALSE, 'testException(''TException''): must trow an exception');
489 except
490 on e:TTransportException do begin
491 Console.WriteLine( e.ClassName+' = '+e.Message); // this is what we get
Roger Meier3bef8c22012-10-06 06:58:00 +0000492 end;
Jens Geyer6bbbf192014-09-07 01:45:56 +0200493 on e:TApplicationException do begin
494 Console.WriteLine( e.ClassName+' = '+e.Message); // this is what we get
Jens Geyer6bbbf192014-09-07 01:45:56 +0200495 end;
Roger Meier3bef8c22012-10-06 06:58:00 +0000496 on e:TException do Expect( FALSE, 'Unexpected exception type "'+e.ClassName+'"');
497 on e:Exception do Expect( FALSE, 'Unexpected exception type "'+e.ClassName+'"');
498 end;
499
Jens Geyer6f6aa8a2016-03-10 19:47:12 +0100500
Jens Geyer2ad6c302015-02-26 19:38:53 +0100501 if FTransport.IsOpen then FTransport.Close;
502 FTransport.Open; // re-open connection, server has already closed
Jens Geyer6f6aa8a2016-03-10 19:47:12 +0100503
Jens Geyer2ad6c302015-02-26 19:38:53 +0100504
Roger Meier3bef8c22012-10-06 06:58:00 +0000505 // case 3: no exception
506 try
507 client.testException('something');
508 Expect( TRUE, 'testException(''something''): must not trow an exception');
509 except
510 on e:TTransportException do Expect( FALSE, 'Unexpected : "'+e.ToString+'"');
511 on e:Exception do Expect( FALSE, 'Unexpected exception "'+e.ClassName+'"');
512 end;
513
514
515 // simple things
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200516 StartTestGroup( 'simple Thrift calls', test_BaseTypes);
Roger Meier3bef8c22012-10-06 06:58:00 +0000517 client.testVoid();
518 Expect( TRUE, 'testVoid()'); // success := no exception
519
Jens Geyer39ba6b72015-09-22 00:00:49 +0200520 s := BoolToString( client.testBool(TRUE));
521 Expect( s = BoolToString(TRUE), 'testBool(TRUE) = '+s);
522 s := BoolToString( client.testBool(FALSE));
523 Expect( s = BoolToString(FALSE), 'testBool(FALSE) = '+s);
524
Roger Meier3bef8c22012-10-06 06:58:00 +0000525 s := client.testString('Test');
526 Expect( s = 'Test', 'testString(''Test'') = "'+s+'"');
527
Jens Geyer06045cf2013-03-27 20:26:25 +0200528 s := client.testString(HUGE_TEST_STRING);
529 Expect( length(s) = length(HUGE_TEST_STRING),
Konrad Grochowski3b5dacb2014-11-24 10:55:31 +0100530 'testString( length(HUGE_TEST_STRING) = '+IntToStr(Length(HUGE_TEST_STRING))+') '
Jens Geyer06045cf2013-03-27 20:26:25 +0200531 +'=> length(result) = '+IntToStr(Length(s)));
532
Roger Meier3bef8c22012-10-06 06:58:00 +0000533 i8 := client.testByte(1);
534 Expect( i8 = 1, 'testByte(1) = ' + IntToStr( i8 ));
535
536 i32 := client.testI32(-1);
537 Expect( i32 = -1, 'testI32(-1) = ' + IntToStr(i32));
538
539 Console.WriteLine('testI64(-34359738368)');
540 i64 := client.testI64(-34359738368);
541 Expect( i64 = -34359738368, 'testI64(-34359738368) = ' + IntToStr( i64));
542
Jens Geyerfd1b3582014-12-13 23:42:58 +0100543 binOut := PrepareBinaryData( TRUE);
544 Console.WriteLine('testBinary('+BytesToHex(binOut)+')');
545 try
546 binIn := client.testBinary(binOut);
547 Expect( Length(binOut) = Length(binIn), 'testBinary(): length '+IntToStr(Length(binOut))+' = '+IntToStr(Length(binIn)));
548 i32 := Min( Length(binOut), Length(binIn));
549 Expect( CompareMem( binOut, binIn, i32), 'testBinary('+BytesToHex(binOut)+') = '+BytesToHex(binIn));
550 except
551 on e:TApplicationException do Console.WriteLine('testBinary(): '+e.Message);
552 on e:Exception do Expect( FALSE, 'testBinary(): Unexpected exception "'+e.ClassName+'": '+e.Message);
553 end;
554
Roger Meier3bef8c22012-10-06 06:58:00 +0000555 Console.WriteLine('testDouble(5.325098235)');
556 dub := client.testDouble(5.325098235);
557 Expect( abs(dub-5.325098235) < 1e-14, 'testDouble(5.325098235) = ' + FloatToStr( dub));
558
559 // structs
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200560 StartTestGroup( 'testStruct', test_Structs);
Roger Meier3bef8c22012-10-06 06:58:00 +0000561 Console.WriteLine('testStruct({''Zero'', 1, -3, -5})');
562 o := TXtructImpl.Create;
563 o.String_thing := 'Zero';
564 o.Byte_thing := 1;
565 o.I32_thing := -3;
566 o.I64_thing := -5;
567 i := client.testStruct(o);
568 Expect( i.String_thing = 'Zero', 'i.String_thing = "'+i.String_thing+'"');
569 Expect( i.Byte_thing = 1, 'i.Byte_thing = '+IntToStr(i.Byte_thing));
570 Expect( i.I32_thing = -3, 'i.I32_thing = '+IntToStr(i.I32_thing));
571 Expect( i.I64_thing = -5, 'i.I64_thing = '+IntToStr(i.I64_thing));
572 Expect( i.__isset_String_thing, 'i.__isset_String_thing = '+BoolToString(i.__isset_String_thing));
573 Expect( i.__isset_Byte_thing, 'i.__isset_Byte_thing = '+BoolToString(i.__isset_Byte_thing));
574 Expect( i.__isset_I32_thing, 'i.__isset_I32_thing = '+BoolToString(i.__isset_I32_thing));
575 Expect( i.__isset_I64_thing, 'i.__isset_I64_thing = '+BoolToString(i.__isset_I64_thing));
576
577 // nested structs
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200578 StartTestGroup( 'testNest', test_Structs);
Roger Meier3bef8c22012-10-06 06:58:00 +0000579 Console.WriteLine('testNest({1, {''Zero'', 1, -3, -5}, 5})');
580 o2 := TXtruct2Impl.Create;
581 o2.Byte_thing := 1;
582 o2.Struct_thing := o;
583 o2.I32_thing := 5;
584 i2 := client.testNest(o2);
585 i := i2.Struct_thing;
586 Expect( i.String_thing = 'Zero', 'i.String_thing = "'+i.String_thing+'"');
587 Expect( i.Byte_thing = 1, 'i.Byte_thing = '+IntToStr(i.Byte_thing));
588 Expect( i.I32_thing = -3, 'i.I32_thing = '+IntToStr(i.I32_thing));
589 Expect( i.I64_thing = -5, 'i.I64_thing = '+IntToStr(i.I64_thing));
590 Expect( i2.Byte_thing = 1, 'i2.Byte_thing = '+IntToStr(i2.Byte_thing));
591 Expect( i2.I32_thing = 5, 'i2.I32_thing = '+IntToStr(i2.I32_thing));
592 Expect( i.__isset_String_thing, 'i.__isset_String_thing = '+BoolToString(i.__isset_String_thing));
593 Expect( i.__isset_Byte_thing, 'i.__isset_Byte_thing = '+BoolToString(i.__isset_Byte_thing));
594 Expect( i.__isset_I32_thing, 'i.__isset_I32_thing = '+BoolToString(i.__isset_I32_thing));
595 Expect( i.__isset_I64_thing, 'i.__isset_I64_thing = '+BoolToString(i.__isset_I64_thing));
596 Expect( i2.__isset_Byte_thing, 'i2.__isset_Byte_thing');
597 Expect( i2.__isset_I32_thing, 'i2.__isset_I32_thing');
598
599 // map<type1,type2>: A map of strictly unique keys to values.
600 // Translates to an STL map, Java HashMap, PHP associative array, Python/Ruby dictionary, etc.
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200601 StartTestGroup( 'testMap', test_Containers);
Roger Meier3bef8c22012-10-06 06:58:00 +0000602 mapout := TThriftDictionaryImpl<Integer,Integer>.Create;
603 for j := 0 to 4 do
604 begin
605 mapout.AddOrSetValue( j, j - 10);
606 end;
607 Console.Write('testMap({');
608 first := True;
609 for key in mapout.Keys do
610 begin
611 if first
612 then first := False
613 else Console.Write( ', ' );
614 Console.Write( IntToStr( key) + ' => ' + IntToStr( mapout[key]));
615 end;
616 Console.WriteLine('})');
617
618 mapin := client.testMap( mapout );
619 Expect( mapin.Count = mapout.Count, 'testMap: mapin.Count = mapout.Count');
620 for j := 0 to 4 do
621 begin
622 Expect( mapout.ContainsKey(j), 'testMap: mapout.ContainsKey('+IntToStr(j)+') = '+BoolToString(mapout.ContainsKey(j)));
623 end;
624 for key in mapin.Keys do
625 begin
626 Expect( mapin[key] = mapout[key], 'testMap: '+IntToStr(key) + ' => ' + IntToStr( mapin[key]));
627 Expect( mapin[key] = key - 10, 'testMap: mapin['+IntToStr(key)+'] = '+IntToStr( mapin[key]));
628 end;
629
630
631 // map<type1,type2>: A map of strictly unique keys to values.
632 // Translates to an STL map, Java HashMap, PHP associative array, Python/Ruby dictionary, etc.
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200633 StartTestGroup( 'testStringMap', test_Containers);
Roger Meier3bef8c22012-10-06 06:58:00 +0000634 strmapout := TThriftDictionaryImpl<string,string>.Create;
635 for j := 0 to 4 do
636 begin
637 strmapout.AddOrSetValue( IntToStr(j), IntToStr(j - 10));
638 end;
639 Console.Write('testStringMap({');
640 first := True;
641 for strkey in strmapout.Keys do
642 begin
643 if first
644 then first := False
645 else Console.Write( ', ' );
646 Console.Write( strkey + ' => ' + strmapout[strkey]);
647 end;
648 Console.WriteLine('})');
649
650 strmapin := client.testStringMap( strmapout );
651 Expect( strmapin.Count = strmapout.Count, 'testStringMap: strmapin.Count = strmapout.Count');
652 for j := 0 to 4 do
653 begin
654 Expect( strmapout.ContainsKey(IntToStr(j)),
655 'testStringMap: strmapout.ContainsKey('+IntToStr(j)+') = '
656 + BoolToString(strmapout.ContainsKey(IntToStr(j))));
657 end;
658 for strkey in strmapin.Keys do
659 begin
660 Expect( strmapin[strkey] = strmapout[strkey], 'testStringMap: '+strkey + ' => ' + strmapin[strkey]);
661 Expect( strmapin[strkey] = IntToStr( StrToInt(strkey) - 10), 'testStringMap: strmapin['+strkey+'] = '+strmapin[strkey]);
662 end;
663
664
665 // set<type>: An unordered set of unique elements.
666 // Translates to an STL set, Java HashSet, set in Python, etc.
667 // Note: PHP does not support sets, so it is treated similar to a List
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200668 StartTestGroup( 'testSet', test_Containers);
Roger Meier3bef8c22012-10-06 06:58:00 +0000669 setout := THashSetImpl<Integer>.Create;
670 for j := -2 to 2 do
671 begin
672 setout.Add( j );
673 end;
674 Console.Write('testSet({');
675 first := True;
676 for j in setout 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 setin := client.testSet(setout);
686 Expect( setin.Count = setout.Count, 'testSet: setin.Count = setout.Count');
687 Expect( setin.Count = 5, 'testSet: setin.Count = '+IntToStr(setin.Count));
688 for j := -2 to 2 do // unordered, we can't rely on the order => test for known elements only
689 begin
690 Expect( setin.Contains(j), 'testSet: setin.Contains('+IntToStr(j)+') => '+BoolToString(setin.Contains(j)));
691 end;
692
693 // list<type>: An ordered list of elements.
694 // Translates to an STL vector, Java ArrayList, native arrays in scripting languages, etc.
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200695 StartTestGroup( 'testList', test_Containers);
Roger Meier3bef8c22012-10-06 06:58:00 +0000696 listout := TThriftListImpl<Integer>.Create;
697 listout.Add( +1);
698 listout.Add( -2);
699 listout.Add( +3);
700 listout.Add( -4);
701 listout.Add( 0);
702 Console.Write('testList({');
703 first := True;
704 for j in listout do
705 begin
706 if first
707 then first := False
708 else Console.Write(', ');
709 Console.Write(IntToStr( j));
710 end;
711 Console.WriteLine('})');
712
713 listin := client.testList(listout);
714 Expect( listin.Count = listout.Count, 'testList: listin.Count = listout.Count');
715 Expect( listin.Count = 5, 'testList: listin.Count = '+IntToStr(listin.Count));
716 Expect( listin[0] = +1, 'listin[0] = '+IntToStr( listin[0]));
717 Expect( listin[1] = -2, 'listin[1] = '+IntToStr( listin[1]));
718 Expect( listin[2] = +3, 'listin[2] = '+IntToStr( listin[2]));
719 Expect( listin[3] = -4, 'listin[3] = '+IntToStr( listin[3]));
720 Expect( listin[4] = 0, 'listin[4] = '+IntToStr( listin[4]));
721
722 // enums
723 ret := client.testEnum(TNumberz.ONE);
724 Expect( ret = TNumberz.ONE, 'testEnum(ONE) = '+IntToStr(Ord(ret)));
725
726 ret := client.testEnum(TNumberz.TWO);
727 Expect( ret = TNumberz.TWO, 'testEnum(TWO) = '+IntToStr(Ord(ret)));
728
729 ret := client.testEnum(TNumberz.THREE);
730 Expect( ret = TNumberz.THREE, 'testEnum(THREE) = '+IntToStr(Ord(ret)));
731
732 ret := client.testEnum(TNumberz.FIVE);
733 Expect( ret = TNumberz.FIVE, 'testEnum(FIVE) = '+IntToStr(Ord(ret)));
734
735 ret := client.testEnum(TNumberz.EIGHT);
736 Expect( ret = TNumberz.EIGHT, 'testEnum(EIGHT) = '+IntToStr(Ord(ret)));
737
738
739 // typedef
740 uid := client.testTypedef(309858235082523);
741 Expect( uid = 309858235082523, 'testTypedef(309858235082523) = '+IntToStr(uid));
742
743
744 // maps of maps
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200745 StartTestGroup( 'testMapMap(1)', test_Containers);
Roger Meier3bef8c22012-10-06 06:58:00 +0000746 mm := client.testMapMap(1);
747 Console.Write(' = {');
748 for key in mm.Keys do
749 begin
750 Console.Write( IntToStr( key) + ' => {');
751 m2 := mm[key];
752 for k2 in m2.Keys do
753 begin
754 Console.Write( IntToStr( k2) + ' => ' + IntToStr( m2[k2]) + ', ');
755 end;
756 Console.Write('}, ');
757 end;
758 Console.WriteLine('}');
759
760 // verify result data
761 Expect( mm.Count = 2, 'mm.Count = '+IntToStr(mm.Count));
762 pos := mm[4];
763 neg := mm[-4];
764 for j := 1 to 4 do
765 begin
766 Expect( pos[j] = j, 'pos[j] = '+IntToStr(pos[j]));
767 Expect( neg[-j] = -j, 'neg[-j] = '+IntToStr(neg[-j]));
768 end;
769
770
771
772 // insanity
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200773 StartTestGroup( 'testInsanity', test_Structs);
Roger Meier3bef8c22012-10-06 06:58:00 +0000774 insane := TInsanityImpl.Create;
775 insane.UserMap := TThriftDictionaryImpl<TNumberz, Int64>.Create;
776 insane.UserMap.AddOrSetValue( TNumberz.FIVE, 5000);
777 truck := TXtructImpl.Create;
778 truck.String_thing := 'Truck';
Jens Geyer540e3462016-12-28 14:25:41 +0100779 truck.Byte_thing := -8; // byte is signed
780 truck.I32_thing := 32;
781 truck.I64_thing := 64;
Roger Meier3bef8c22012-10-06 06:58:00 +0000782 insane.Xtructs := TThriftListImpl<IXtruct>.Create;
783 insane.Xtructs.Add( truck );
784 whoa := client.testInsanity( insane );
785 Console.Write(' = {');
786 for key64 in whoa.Keys do
787 begin
788 val := whoa[key64];
789 Console.Write( IntToStr( key64) + ' => {');
790 for k2_2 in val.Keys do
791 begin
792 v2 := val[k2_2];
793 Console.Write( IntToStr( Integer( k2_2)) + ' => {');
794 userMap := v2.UserMap;
795 Console.Write('{');
796 if userMap <> nil then
797 begin
798 for k3 in userMap.Keys do
799 begin
800 Console.Write( IntToStr( Integer( k3)) + ' => ' + IntToStr( userMap[k3]) + ', ');
801 end;
802 end else
803 begin
804 Console.Write('null');
805 end;
806 Console.Write('}, ');
807 xtructs := v2.Xtructs;
808 Console.Write('{');
809
810 if xtructs <> nil then
811 begin
812 for x in xtructs do
813 begin
814 Console.Write('{"' + x.String_thing + '", ' +
815 IntToStr( x.Byte_thing) + ', ' +
816 IntToStr( x.I32_thing) + ', ' +
817 IntToStr( x.I32_thing) + '}, ');
818 end;
819 end else
820 begin
821 Console.Write('null');
822 end;
823 Console.Write('}');
824 Console.Write('}, ');
825 end;
826 Console.Write('}, ');
827 end;
828 Console.WriteLine('}');
829
Jens Geyer540e3462016-12-28 14:25:41 +0100830 (**
831 * So you think you've got this all worked, out eh?
832 *
833 * Creates a the returned map with these values and prints it out:
834 * { 1 => { 2 => argument,
835 * 3 => argument,
836 * },
837 * 2 => { 6 => <empty Insanity struct>, },
838 * }
839 * @return map<UserId, map<Numberz,Insanity>> - a map with the above values
840 *)
841
Roger Meier3bef8c22012-10-06 06:58:00 +0000842 // verify result data
843 Expect( whoa.Count = 2, 'whoa.Count = '+IntToStr(whoa.Count));
844 //
845 first_map := whoa[1];
846 second_map := whoa[2];
847 Expect( first_map.Count = 2, 'first_map.Count = '+IntToStr(first_map.Count));
848 Expect( second_map.Count = 1, 'second_map.Count = '+IntToStr(second_map.Count));
849 //
850 looney := second_map[TNumberz.SIX];
851 Expect( Assigned(looney), 'Assigned(looney) = '+BoolToString(Assigned(looney)));
852 Expect( not looney.__isset_UserMap, 'looney.__isset_UserMap = '+BoolToString(looney.__isset_UserMap));
853 Expect( not looney.__isset_Xtructs, 'looney.__isset_Xtructs = '+BoolToString(looney.__isset_Xtructs));
854 //
855 for ret in [TNumberz.TWO, TNumberz.THREE] do begin
856 crazy := first_map[ret];
857 Console.WriteLine('first_map['+intToStr(Ord(ret))+']');
858
859 Expect( crazy.__isset_UserMap, 'crazy.__isset_UserMap = '+BoolToString(crazy.__isset_UserMap));
860 Expect( crazy.__isset_Xtructs, 'crazy.__isset_Xtructs = '+BoolToString(crazy.__isset_Xtructs));
861
Jens Geyer540e3462016-12-28 14:25:41 +0100862 Expect( crazy.UserMap.Count = insane.UserMap.Count, 'crazy.UserMap.Count = '+IntToStr(crazy.UserMap.Count));
863 for pair in insane.UserMap do begin
864 Expect( crazy.UserMap[pair.Key] = pair.Value, 'crazy.UserMap['+IntToStr(Ord(pair.key))+'] = '+IntToStr(crazy.UserMap[pair.Key]));
865 end;
Roger Meier3bef8c22012-10-06 06:58:00 +0000866
Jens Geyer540e3462016-12-28 14:25:41 +0100867 Expect( crazy.Xtructs.Count = insane.Xtructs.Count, 'crazy.Xtructs.Count = '+IntToStr(crazy.Xtructs.Count));
868 for arg0 := 0 to insane.Xtructs.Count-1 do begin
869 hello := insane.Xtructs[arg0];
870 goodbye := crazy.Xtructs[arg0];
871 Expect( goodbye.String_thing = hello.String_thing, 'goodbye.String_thing = '+goodbye.String_thing);
872 Expect( goodbye.Byte_thing = hello.Byte_thing, 'goodbye.Byte_thing = '+IntToStr(goodbye.Byte_thing));
873 Expect( goodbye.I32_thing = hello.I32_thing, 'goodbye.I32_thing = '+IntToStr(goodbye.I32_thing));
874 Expect( goodbye.I64_thing = hello.I64_thing, 'goodbye.I64_thing = '+IntToStr(goodbye.I64_thing));
875 end;
Roger Meier3bef8c22012-10-06 06:58:00 +0000876 end;
877
878
879 // multi args
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200880 StartTestGroup( 'testMulti', test_BaseTypes);
Roger Meier3bef8c22012-10-06 06:58:00 +0000881 arg0 := 1;
882 arg1 := 2;
883 arg2 := High(Int64);
884 arg3 := TThriftDictionaryImpl<SmallInt, string>.Create;
885 arg3.AddOrSetValue( 1, 'one');
886 arg4 := TNumberz.FIVE;
887 arg5 := 5000000;
888 Console.WriteLine('Test Multi(' + IntToStr( arg0) + ',' +
889 IntToStr( arg1) + ',' + IntToStr( arg2) + ',' +
890 arg3.ToString + ',' + IntToStr( Integer( arg4)) + ',' +
891 IntToStr( arg5) + ')');
892
893 i := client.testMulti( arg0, arg1, arg2, arg3, arg4, arg5);
894 Expect( i.String_thing = 'Hello2', 'testMulti: i.String_thing = "'+i.String_thing+'"');
895 Expect( i.Byte_thing = arg0, 'testMulti: i.Byte_thing = '+IntToStr(i.Byte_thing));
896 Expect( i.I32_thing = arg1, 'testMulti: i.I32_thing = '+IntToStr(i.I32_thing));
897 Expect( i.I64_thing = arg2, 'testMulti: i.I64_thing = '+IntToStr(i.I64_thing));
898 Expect( i.__isset_String_thing, 'testMulti: i.__isset_String_thing = '+BoolToString(i.__isset_String_thing));
899 Expect( i.__isset_Byte_thing, 'testMulti: i.__isset_Byte_thing = '+BoolToString(i.__isset_Byte_thing));
900 Expect( i.__isset_I32_thing, 'testMulti: i.__isset_I32_thing = '+BoolToString(i.__isset_I32_thing));
901 Expect( i.__isset_I64_thing, 'testMulti: i.__isset_I64_thing = '+BoolToString(i.__isset_I64_thing));
902
903 // multi exception
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200904 StartTestGroup( 'testMultiException(1)', test_Exceptions);
Roger Meier3bef8c22012-10-06 06:58:00 +0000905 try
906 i := client.testMultiException( 'need more pizza', 'run out of beer');
907 Expect( i.String_thing = 'run out of beer', 'i.String_thing = "' +i.String_thing+ '"');
908 Expect( i.__isset_String_thing, 'i.__isset_String_thing = '+BoolToString(i.__isset_String_thing));
Jens Geyer6bbbf192014-09-07 01:45:56 +0200909 { this is not necessarily true, these fields are default-serialized
Jens Geyerd5436f52014-10-03 19:50:38 +0200910 Expect( not i.__isset_Byte_thing, 'i.__isset_Byte_thing = '+BoolToString(i.__isset_Byte_thing));
Roger Meier3bef8c22012-10-06 06:58:00 +0000911 Expect( not i.__isset_I32_thing, 'i.__isset_I32_thing = '+BoolToString(i.__isset_I32_thing));
912 Expect( not i.__isset_I64_thing, 'i.__isset_I64_thing = '+BoolToString(i.__isset_I64_thing));
Jens Geyerd5436f52014-10-03 19:50:38 +0200913 }
Roger Meier3bef8c22012-10-06 06:58:00 +0000914 except
915 on e:Exception do Expect( FALSE, 'Unexpected exception "'+e.ClassName+'"');
916 end;
917
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200918 StartTestGroup( 'testMultiException(Xception)', test_Exceptions);
Roger Meier3bef8c22012-10-06 06:58:00 +0000919 try
920 i := client.testMultiException( 'Xception', 'second test');
921 Expect( FALSE, 'testMultiException(''Xception''): must trow an exception');
922 except
923 on x:TXception do begin
924 Expect( x.__isset_ErrorCode, 'x.__isset_ErrorCode = '+BoolToString(x.__isset_ErrorCode));
925 Expect( x.__isset_Message_, 'x.__isset_Message_ = '+BoolToString(x.__isset_Message_));
926 Expect( x.ErrorCode = 1001, 'x.ErrorCode = '+IntToStr(x.ErrorCode));
927 Expect( x.Message_ = 'This is an Xception', 'x.Message = "'+x.Message_+'"');
928 end;
929 on e:Exception do Expect( FALSE, 'Unexpected exception "'+e.ClassName+'"');
930 end;
931
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200932 StartTestGroup( 'testMultiException(Xception2)', test_Exceptions);
Roger Meier3bef8c22012-10-06 06:58:00 +0000933 try
934 i := client.testMultiException( 'Xception2', 'third test');
935 Expect( FALSE, 'testMultiException(''Xception2''): must trow an exception');
936 except
937 on x:TXception2 do begin
938 Expect( x.__isset_ErrorCode, 'x.__isset_ErrorCode = '+BoolToString(x.__isset_ErrorCode));
939 Expect( x.__isset_Struct_thing, 'x.__isset_Struct_thing = '+BoolToString(x.__isset_Struct_thing));
940 Expect( x.ErrorCode = 2002, 'x.ErrorCode = '+IntToStr(x.ErrorCode));
941 Expect( x.Struct_thing.String_thing = 'This is an Xception2', 'x.Struct_thing.String_thing = "'+x.Struct_thing.String_thing+'"');
942 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 +0200943 { this is not necessarily true, these fields are default-serialized
Roger Meier3bef8c22012-10-06 06:58:00 +0000944 Expect( not x.Struct_thing.__isset_Byte_thing, 'x.Struct_thing.__isset_Byte_thing = '+BoolToString(x.Struct_thing.__isset_Byte_thing));
945 Expect( not x.Struct_thing.__isset_I32_thing, 'x.Struct_thing.__isset_I32_thing = '+BoolToString(x.Struct_thing.__isset_I32_thing));
946 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 +0200947 }
Roger Meier3bef8c22012-10-06 06:58:00 +0000948 end;
949 on e:Exception do Expect( FALSE, 'Unexpected exception "'+e.ClassName+'"');
950 end;
951
952
953 // oneway functions
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200954 StartTestGroup( 'Test Oneway(1)', test_Unknown);
Roger Meier3bef8c22012-10-06 06:58:00 +0000955 client.testOneway(1);
956 Expect( TRUE, 'Test Oneway(1)'); // success := no exception
957
958 // call time
Jens Geyer06045cf2013-03-27 20:26:25 +0200959 {$IFDEF PerfTest}
Roger Meier3bef8c22012-10-06 06:58:00 +0000960 StartTestGroup( 'Test Calltime()');
Jens Geyer9f7f11e2016-04-14 21:37:11 +0200961 StartTick := GetTickCount;
Roger Meier3bef8c22012-10-06 06:58:00 +0000962 for k := 0 to 1000 - 1 do
963 begin
964 client.testVoid();
965 end;
966 Console.WriteLine(' = ' + FloatToStr( (GetTickCount - StartTick) / 1000 ) + ' ms a testVoid() call' );
Jens Geyer06045cf2013-03-27 20:26:25 +0200967 {$ENDIF PerfTest}
Roger Meier3bef8c22012-10-06 06:58:00 +0000968
969 // no more tests here
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200970 StartTestGroup( '', test_Unknown);
Roger Meier3bef8c22012-10-06 06:58:00 +0000971end;
972
973
Jens Geyer718f6ee2013-09-06 21:02:34 +0200974{$IFDEF StressTest}
Jens Geyer06045cf2013-03-27 20:26:25 +0200975procedure TClientThread.StressTest(const client : TThriftTest.Iface);
976begin
977 while TRUE do begin
978 try
979 if not FTransport.IsOpen then FTransport.Open; // re-open connection, server has already closed
980 try
981 client.testString('Test');
982 Write('.');
983 finally
984 if FTransport.IsOpen then FTransport.Close;
985 end;
986 except
987 on e:Exception do Writeln(#10+e.message);
988 end;
989 end;
990end;
Jens Geyer718f6ee2013-09-06 21:02:34 +0200991{$ENDIF}
Jens Geyer06045cf2013-03-27 20:26:25 +0200992
Jens Geyerfd1b3582014-12-13 23:42:58 +0100993
994function TClientThread.PrepareBinaryData( aRandomDist : Boolean = FALSE) : TBytes;
995var i, nextPos : Integer;
996begin
997 SetLength( result, $100);
998 ASSERT( Low(result) = 0);
999
1000 // linear distribution, unless random is requested
1001 if not aRandomDist then begin
1002 for i := Low(result) to High(result) do begin
1003 result[i] := i;
1004 end;
1005 Exit;
1006 end;
1007
1008 // random distribution of all 256 values
1009 FillChar( result[0], Length(result) * SizeOf(result[0]), $0);
1010 i := 1;
1011 while i < Length(result) do begin
1012 nextPos := Byte( Random($100));
1013 if result[nextPos] = 0 then begin // unused?
1014 result[nextPos] := i;
1015 Inc(i);
1016 end;
1017 end;
1018end;
1019
1020
Jens Geyerf7904452017-07-26 15:02:12 +02001021{$IFDEF Win64}
1022procedure TClientThread.UseInterlockedExchangeAdd64;
1023var a,b : Int64;
1024begin
1025 a := 1;
1026 b := 2;
1027 Thrift.Utils.InterlockedExchangeAdd64( a,b);
1028 Expect( a = 3, 'InterlockedExchangeAdd64');
1029end;
1030{$ENDIF}
1031
1032
Roger Meier3bef8c22012-10-06 06:58:00 +00001033procedure TClientThread.JSONProtocolReadWriteTest;
1034// Tests only then read/write procedures of the JSON protocol
1035// All tests succeed, if we can read what we wrote before
1036// Note that passing this test does not imply, that our JSON is really compatible to what
1037// other clients or servers expect as the real JSON. This is beyond the scope of this test.
1038var prot : IProtocol;
1039 stm : TStringStream;
1040 list : IList;
1041 binary, binRead : TBytes;
1042 i,iErr : Integer;
1043const
1044 TEST_SHORT = ShortInt( $FE);
1045 TEST_SMALL = SmallInt( $FEDC);
1046 TEST_LONG = LongInt( $FEDCBA98);
1047 TEST_I64 = Int64( $FEDCBA9876543210);
1048 TEST_DOUBLE = -1.234e-56;
1049 DELTA_DOUBLE = TEST_DOUBLE * 1e-14;
1050 TEST_STRING = 'abc-'#$00E4#$00f6#$00fc; // german umlauts (en-us: "funny chars")
Phongphan Phutthaa6509f72015-10-31 01:09:47 +07001051 // Test THRIFT-2336 and THRIFT-3404 with U+1D11E (G Clef symbol) and 'Русское Название';
1052 G_CLEF_AND_CYRILLIC_TEXT = #$1d11e' '#$0420#$0443#$0441#$0441#$043a#$043e#$0435' '#$041d#$0430#$0437#$0432#$0430#$043d#$0438#$0435;
1053 G_CLEF_AND_CYRILLIC_JSON = '"\ud834\udd1e \u0420\u0443\u0441\u0441\u043a\u043e\u0435 \u041d\u0430\u0437\u0432\u0430\u043d\u0438\u0435"';
Jens Geyer21366942013-12-30 22:04:51 +01001054 // test both possible solidus encodings
1055 SOLIDUS_JSON_DATA = '"one/two\/three"';
1056 SOLIDUS_EXCPECTED = 'one/two/three';
Roger Meier3bef8c22012-10-06 06:58:00 +00001057begin
1058 stm := TStringStream.Create;
1059 try
Jens Geyerf8a1b7a2014-09-24 00:26:46 +02001060 StartTestGroup( 'JsonProtocolTest', test_Unknown);
Roger Meier3bef8c22012-10-06 06:58:00 +00001061
1062 // prepare binary data
Jens Geyerfd1b3582014-12-13 23:42:58 +01001063 binary := PrepareBinaryData( FALSE);
Roger Meier3bef8c22012-10-06 06:58:00 +00001064
1065 // output setup
1066 prot := TJSONProtocolImpl.Create(
1067 TStreamTransportImpl.Create(
1068 nil, TThriftStreamAdapterDelphi.Create( stm, FALSE)));
1069
1070 // write
1071 prot.WriteListBegin( TListImpl.Create( TType.String_, 9));
1072 prot.WriteBool( TRUE);
1073 prot.WriteBool( FALSE);
1074 prot.WriteByte( TEST_SHORT);
1075 prot.WriteI16( TEST_SMALL);
1076 prot.WriteI32( TEST_LONG);
1077 prot.WriteI64( TEST_I64);
1078 prot.WriteDouble( TEST_DOUBLE);
1079 prot.WriteString( TEST_STRING);
1080 prot.WriteBinary( binary);
1081 prot.WriteListEnd;
1082
1083 // input setup
1084 Expect( stm.Position = stm.Size, 'Stream position/length after write');
1085 stm.Position := 0;
1086 prot := TJSONProtocolImpl.Create(
1087 TStreamTransportImpl.Create(
1088 TThriftStreamAdapterDelphi.Create( stm, FALSE), nil));
1089
1090 // read and compare
1091 list := prot.ReadListBegin;
1092 Expect( list.ElementType = TType.String_, 'list element type');
1093 Expect( list.Count = 9, 'list element count');
1094 Expect( prot.ReadBool, 'WriteBool/ReadBool: TRUE');
1095 Expect( not prot.ReadBool, 'WriteBool/ReadBool: FALSE');
1096 Expect( prot.ReadByte = TEST_SHORT, 'WriteByte/ReadByte');
1097 Expect( prot.ReadI16 = TEST_SMALL, 'WriteI16/ReadI16');
1098 Expect( prot.ReadI32 = TEST_LONG, 'WriteI32/ReadI32');
1099 Expect( prot.ReadI64 = TEST_I64, 'WriteI64/ReadI64');
1100 Expect( abs(prot.ReadDouble-TEST_DOUBLE) < abs(DELTA_DOUBLE), 'WriteDouble/ReadDouble');
1101 Expect( prot.ReadString = TEST_STRING, 'WriteString/ReadString');
1102 binRead := prot.ReadBinary;
1103 prot.ReadListEnd;
1104
1105 // test binary data
1106 Expect( Length(binary) = Length(binRead), 'Binary data length check');
1107 iErr := -1;
1108 for i := Low(binary) to High(binary) do begin
1109 if binary[i] <> binRead[i] then begin
1110 iErr := i;
1111 Break;
1112 end;
1113 end;
1114 if iErr < 0
1115 then Expect( TRUE, 'Binary data check ('+IntToStr(Length(binary))+' Bytes)')
1116 else Expect( FALSE, 'Binary data check at offset '+IntToStr(iErr));
1117
1118 Expect( stm.Position = stm.Size, 'Stream position after read');
1119
Jens Geyer7bb44a32014-02-07 22:24:37 +01001120
Jens Geyer21366942013-12-30 22:04:51 +01001121 // Solidus can be encoded in two ways. Make sure we can read both
1122 stm.Position := 0;
1123 stm.Size := 0;
1124 stm.WriteString(SOLIDUS_JSON_DATA);
1125 stm.Position := 0;
1126 prot := TJSONProtocolImpl.Create(
1127 TStreamTransportImpl.Create(
1128 TThriftStreamAdapterDelphi.Create( stm, FALSE), nil));
1129 Expect( prot.ReadString = SOLIDUS_EXCPECTED, 'Solidus encoding');
1130
1131
Jens Geyer7bb44a32014-02-07 22:24:37 +01001132 // Widechars should work too. Do they?
1133 // After writing, we ensure that we are able to read it back
1134 // We can't assume hex-encoding, since (nearly) any Unicode char is valid JSON
1135 stm.Position := 0;
1136 stm.Size := 0;
1137 prot := TJSONProtocolImpl.Create(
1138 TStreamTransportImpl.Create(
1139 nil, TThriftStreamAdapterDelphi.Create( stm, FALSE)));
Phongphan Phutthaa6509f72015-10-31 01:09:47 +07001140 prot.WriteString( G_CLEF_AND_CYRILLIC_TEXT);
Jens Geyer7bb44a32014-02-07 22:24:37 +01001141 stm.Position := 0;
1142 prot := TJSONProtocolImpl.Create(
1143 TStreamTransportImpl.Create(
1144 TThriftStreamAdapterDelphi.Create( stm, FALSE), nil));
Phongphan Phutthaa6509f72015-10-31 01:09:47 +07001145 Expect( prot.ReadString = G_CLEF_AND_CYRILLIC_TEXT, 'Writing JSON with chars > 8 bit');
Jens Geyer7bb44a32014-02-07 22:24:37 +01001146
1147 // Widechars should work with hex-encoding too. Do they?
1148 stm.Position := 0;
1149 stm.Size := 0;
Phongphan Phutthaa6509f72015-10-31 01:09:47 +07001150 stm.WriteString( G_CLEF_AND_CYRILLIC_JSON);
Jens Geyer7bb44a32014-02-07 22:24:37 +01001151 stm.Position := 0;
1152 prot := TJSONProtocolImpl.Create(
1153 TStreamTransportImpl.Create(
1154 TThriftStreamAdapterDelphi.Create( stm, FALSE), nil));
Phongphan Phutthaa6509f72015-10-31 01:09:47 +07001155 Expect( prot.ReadString = G_CLEF_AND_CYRILLIC_TEXT, 'Reading JSON with chars > 8 bit');
Jens Geyer7bb44a32014-02-07 22:24:37 +01001156
1157
Roger Meier3bef8c22012-10-06 06:58:00 +00001158 finally
1159 stm.Free;
1160 prot := nil; //-> Release
Jens Geyerf8a1b7a2014-09-24 00:26:46 +02001161 StartTestGroup( '', test_Unknown); // no more tests here
Roger Meier3bef8c22012-10-06 06:58:00 +00001162 end;
1163end;
1164
1165
Jens Geyerf8a1b7a2014-09-24 00:26:46 +02001166procedure TClientThread.StartTestGroup( const aGroup : string; const aTest : TTestGroup);
Roger Meier3bef8c22012-10-06 06:58:00 +00001167begin
1168 FTestGroup := aGroup;
Jens Geyerf8a1b7a2014-09-24 00:26:46 +02001169 FCurrentTest := aTest;
1170
1171 Include( FExecuted, aTest);
1172
Roger Meier3bef8c22012-10-06 06:58:00 +00001173 if FTestGroup <> '' then begin
1174 Console.WriteLine('');
1175 Console.WriteLine( aGroup+' tests');
1176 Console.WriteLine( StringOfChar('-',60));
1177 end;
1178end;
1179
1180
1181procedure TClientThread.Expect( aTestResult : Boolean; const aTestInfo : string);
1182begin
1183 if aTestResult then begin
1184 Inc(FSuccesses);
1185 Console.WriteLine( aTestInfo+': passed');
1186 end
1187 else begin
1188 FErrors.Add( FTestGroup+': '+aTestInfo);
Jens Geyerf8a1b7a2014-09-24 00:26:46 +02001189 Include( FFailed, FCurrentTest);
Roger Meier3bef8c22012-10-06 06:58:00 +00001190 Console.WriteLine( aTestInfo+': *** FAILED ***');
1191
1192 // We have a failed test!
1193 // -> issue DebugBreak ONLY if a debugger is attached,
1194 // -> unhandled DebugBreaks would cause Windows to terminate the app otherwise
Jens Geyer9f7f11e2016-04-14 21:37:11 +02001195 if IsDebuggerPresent
1196 then {$IFDEF CPUX64} DebugBreak {$ELSE} asm int 3 end {$ENDIF};
Roger Meier3bef8c22012-10-06 06:58:00 +00001197 end;
1198end;
1199
1200
1201procedure TClientThread.ReportResults;
1202var nTotal : Integer;
1203 sLine : string;
1204begin
1205 // prevent us from stupid DIV/0 errors
1206 nTotal := FSuccesses + FErrors.Count;
1207 if nTotal = 0 then begin
1208 Console.WriteLine('No results logged');
1209 Exit;
1210 end;
1211
1212 Console.WriteLine('');
1213 Console.WriteLine( StringOfChar('=',60));
1214 Console.WriteLine( IntToStr(nTotal)+' tests performed');
1215 Console.WriteLine( IntToStr(FSuccesses)+' tests succeeded ('+IntToStr(round(100*FSuccesses/nTotal))+'%)');
1216 Console.WriteLine( IntToStr(FErrors.Count)+' tests failed ('+IntToStr(round(100*FErrors.Count/nTotal))+'%)');
1217 Console.WriteLine( StringOfChar('=',60));
1218 if FErrors.Count > 0 then begin
1219 Console.WriteLine('FAILED TESTS:');
1220 for sLine in FErrors do Console.WriteLine('- '+sLine);
1221 Console.WriteLine( StringOfChar('=',60));
1222 InterlockedIncrement( ExitCode); // return <> 0 on errors
1223 end;
1224 Console.WriteLine('');
1225end;
1226
1227
Jens Geyerf8a1b7a2014-09-24 00:26:46 +02001228function TClientThread.CalculateExitCode : Byte;
1229var test : TTestGroup;
1230begin
1231 result := EXITCODE_SUCCESS;
1232 for test := Low(TTestGroup) to High(TTestGroup) do begin
1233 if (test in FFailed) or not (test in FExecuted)
1234 then result := result or MAP_FAILURES_TO_EXITCODE_BITS[test];
1235 end;
1236end;
1237
1238
Roger Meier3bef8c22012-10-06 06:58:00 +00001239constructor TClientThread.Create( const ATransport: ITransport; const AProtocol : IProtocol; ANumIteration: Integer);
1240begin
1241 inherited Create( True );
1242 FNumIteration := ANumIteration;
1243 FTransport := ATransport;
1244 FProtocol := AProtocol;
1245 FConsole := TThreadConsole.Create( Self );
Jens Geyerf8a1b7a2014-09-24 00:26:46 +02001246 FCurrentTest := test_Unknown;
Roger Meier3bef8c22012-10-06 06:58:00 +00001247
1248 // error list: keep correct order, allow for duplicates
1249 FErrors := TStringList.Create;
1250 FErrors.Sorted := FALSE;
1251 FErrors.Duplicates := dupAccept;
1252end;
1253
1254destructor TClientThread.Destroy;
1255begin
1256 FreeAndNil( FConsole);
1257 FreeAndNil( FErrors);
1258 inherited;
1259end;
1260
1261procedure TClientThread.Execute;
1262var
1263 i : Integer;
1264 proc : TThreadProcedure;
1265begin
1266 // perform all tests
1267 try
Jens Geyerf7904452017-07-26 15:02:12 +02001268 {$IFDEF Win64}
1269 UseInterlockedExchangeAdd64;
1270 {$ENDIF}
Jens Geyer7bb44a32014-02-07 22:24:37 +01001271 JSONProtocolReadWriteTest;
Jens Geyerf7904452017-07-26 15:02:12 +02001272
Roger Meier3bef8c22012-10-06 06:58:00 +00001273 for i := 0 to FNumIteration - 1 do
1274 begin
1275 ClientTest;
Roger Meier3bef8c22012-10-06 06:58:00 +00001276 end;
1277 except
1278 on e:Exception do Expect( FALSE, 'unexpected exception: "'+e.message+'"');
1279 end;
1280
1281 // report the outcome
1282 ReportResults;
Jens Geyerf8a1b7a2014-09-24 00:26:46 +02001283 SetReturnValue( CalculateExitCode);
Roger Meier3bef8c22012-10-06 06:58:00 +00001284
1285 // shutdown
1286 proc := procedure
1287 begin
1288 if FTransport <> nil then
1289 begin
1290 FTransport.Close;
1291 FTransport := nil;
1292 end;
1293 end;
1294
1295 Synchronize( proc );
1296end;
1297
Jens Geyerf8a1b7a2014-09-24 00:26:46 +02001298
Roger Meier3bef8c22012-10-06 06:58:00 +00001299{ TThreadConsole }
1300
1301constructor TThreadConsole.Create(AThread: TThread);
1302begin
Jens Geyer718f6ee2013-09-06 21:02:34 +02001303 inherited Create;
Roger Meier3bef8c22012-10-06 06:58:00 +00001304 FThread := AThread;
1305end;
1306
1307procedure TThreadConsole.Write(const S: string);
1308var
1309 proc : TThreadProcedure;
1310begin
1311 proc := procedure
1312 begin
1313 Console.Write( S );
1314 end;
1315 TThread.Synchronize( FThread, proc);
1316end;
1317
1318procedure TThreadConsole.WriteLine(const S: string);
1319var
1320 proc : TThreadProcedure;
1321begin
1322 proc := procedure
1323 begin
1324 Console.WriteLine( S );
1325 end;
1326 TThread.Synchronize( FThread, proc);
1327end;
1328
1329initialization
1330begin
1331 TTestClient.FNumIteration := 1;
1332 TTestClient.FNumThread := 1;
1333end;
1334
1335end.