blob: 59b2a66c913d233077d0c487991ec41d559547e1 [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
Jens Geyer17c3ad92017-09-05 20:31:27 +020025{.$DEFINE PerfTest} // activate the performance test
26{$DEFINE Exceptions} // activate the exceptions test (or disable while debugging)
Jens Geyer06045cf2013-03-27 20:26:25 +020027
Roger Meier3bef8c22012-10-06 06:58:00 +000028interface
29
30uses
Jens Geyerfd1b3582014-12-13 23:42:58 +010031 Windows, SysUtils, Classes, Math,
Roger Meier3bef8c22012-10-06 06:58:00 +000032 DateUtils,
33 Generics.Collections,
34 TestConstants,
35 Thrift,
Jens Geyerf0e63312015-03-01 18:47:49 +010036 Thrift.Protocol.Compact,
Roger Meier3bef8c22012-10-06 06:58:00 +000037 Thrift.Protocol.JSON,
38 Thrift.Protocol,
39 Thrift.Transport.Pipes,
40 Thrift.Transport,
41 Thrift.Stream,
42 Thrift.Test,
Jens Geyerf7904452017-07-26 15:02:12 +020043 Thrift.Utils,
Roger Meier3bef8c22012-10-06 06:58:00 +000044 Thrift.Collections,
45 Thrift.Console;
46
47type
48 TThreadConsole = class
49 private
50 FThread : TThread;
51 public
52 procedure Write( const S : string);
53 procedure WriteLine( const S : string);
54 constructor Create( AThread: TThread);
55 end;
56
57 TClientThread = class( TThread )
Jens Geyerf8a1b7a2014-09-24 00:26:46 +020058 private type
59 TTestGroup = (
60 test_Unknown,
61 test_BaseTypes,
62 test_Structs,
63 test_Containers,
64 test_Exceptions
65 // new values here
66 );
67 TTestGroups = set of TTestGroup;
68
Roger Meier3bef8c22012-10-06 06:58:00 +000069 private
70 FTransport : ITransport;
71 FProtocol : IProtocol;
72 FNumIteration : Integer;
73 FConsole : TThreadConsole;
74
75 // test reporting, will be refactored out into separate class later
76 FTestGroup : string;
Jens Geyerf8a1b7a2014-09-24 00:26:46 +020077 FCurrentTest : TTestGroup;
Roger Meier3bef8c22012-10-06 06:58:00 +000078 FSuccesses : Integer;
79 FErrors : TStringList;
Jens Geyerf8a1b7a2014-09-24 00:26:46 +020080 FFailed : TTestGroups;
81 FExecuted : TTestGroups;
82 procedure StartTestGroup( const aGroup : string; const aTest : TTestGroup);
Roger Meier3bef8c22012-10-06 06:58:00 +000083 procedure Expect( aTestResult : Boolean; const aTestInfo : string);
84 procedure ReportResults;
Jens Geyerfd1b3582014-12-13 23:42:58 +010085 function CalculateExitCode : Byte;
Roger Meier3bef8c22012-10-06 06:58:00 +000086
87 procedure ClientTest;
88 procedure JSONProtocolReadWriteTest;
Jens Geyerd4df9172017-10-25 22:30:23 +020089 function PrepareBinaryData( aRandomDist, aHuge : Boolean) : TBytes;
Jens Geyer718f6ee2013-09-06 21:02:34 +020090 {$IFDEF StressTest}
Jens Geyer06045cf2013-03-27 20:26:25 +020091 procedure StressTest(const client : TThriftTest.Iface);
Jens Geyer718f6ee2013-09-06 21:02:34 +020092 {$ENDIF}
Jens Geyerf7904452017-07-26 15:02:12 +020093 {$IFDEF Win64}
94 procedure UseInterlockedExchangeAdd64;
95 {$ENDIF}
Roger Meier3bef8c22012-10-06 06:58:00 +000096 protected
97 procedure Execute; override;
98 public
99 constructor Create( const ATransport: ITransport; const AProtocol : IProtocol; ANumIteration: Integer);
100 destructor Destroy; override;
101 end;
102
103 TTestClient = class
104 private
105 class var
106 FNumIteration : Integer;
107 FNumThread : Integer;
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200108
109 class procedure PrintCmdLineHelp;
110 class procedure InvalidArgs;
Roger Meier3bef8c22012-10-06 06:58:00 +0000111 public
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200112 class function Execute( const args: array of string) : Byte;
Roger Meier3bef8c22012-10-06 06:58:00 +0000113 end;
114
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200115
Roger Meier3bef8c22012-10-06 06:58:00 +0000116implementation
117
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200118const
119 EXITCODE_SUCCESS = $00; // no errors bits set
120 //
121 EXITCODE_FAILBIT_BASETYPES = $01;
122 EXITCODE_FAILBIT_STRUCTS = $02;
123 EXITCODE_FAILBIT_CONTAINERS = $04;
124 EXITCODE_FAILBIT_EXCEPTIONS = $08;
125
126 MAP_FAILURES_TO_EXITCODE_BITS : array[TClientThread.TTestGroup] of Byte = (
127 EXITCODE_SUCCESS, // no bits here
128 EXITCODE_FAILBIT_BASETYPES,
129 EXITCODE_FAILBIT_STRUCTS,
130 EXITCODE_FAILBIT_CONTAINERS,
131 EXITCODE_FAILBIT_EXCEPTIONS
132 );
133
134
135
Roger Meier3bef8c22012-10-06 06:58:00 +0000136function BoolToString( b : Boolean) : string;
137// overrides global BoolToString()
138begin
139 if b
140 then result := 'true'
141 else result := 'false';
142end;
143
144// not available in all versions, so make sure we have this one imported
145function IsDebuggerPresent: BOOL; stdcall; external KERNEL32 name 'IsDebuggerPresent';
146
147{ TTestClient }
148
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200149class procedure TTestClient.PrintCmdLineHelp;
150const HELPTEXT = ' [options]'#10
151 + #10
152 + 'Allowed options:'#10
153 + ' -h [ --help ] produce help message'#10
154 + ' --host arg (=localhost) Host to connect'#10
155 + ' --port arg (=9090) Port number to connect'#10
156 + ' --domain-socket arg Domain Socket (e.g. /tmp/ThriftTest.thrift),'#10
157 + ' instead of host and port'#10
158 + ' --named-pipe arg Windows Named Pipe (e.g. MyThriftPipe)'#10
159 + ' --anon-pipes hRead hWrite Windows Anonymous Pipes pair (handles)'#10
160 + ' --transport arg (=sockets) Transport: buffered, framed, http, evhttp'#10
161 + ' --protocol arg (=binary) Protocol: binary, compact, json'#10
162 + ' --ssl Encrypted Transport using SSL'#10
163 + ' -n [ --testloops ] arg (=1) Number of Tests'#10
164 + ' -t [ --threads ] arg (=1) Number of Test threads'#10
165 ;
166begin
167 Writeln( ChangeFileExt(ExtractFileName(ParamStr(0)),'') + HELPTEXT);
168end;
169
170class procedure TTestClient.InvalidArgs;
171begin
172 Console.WriteLine( 'Invalid args.');
173 Console.WriteLine( ChangeFileExt(ExtractFileName(ParamStr(0)),'') + ' -h for more information');
174 Abort;
175end;
176
177class function TTestClient.Execute(const args: array of string) : Byte;
Roger Meier3bef8c22012-10-06 06:58:00 +0000178var
179 i : Integer;
180 host : string;
181 port : Integer;
Roger Meier3bef8c22012-10-06 06:58:00 +0000182 sPipeName : string;
183 hAnonRead, hAnonWrite : THandle;
184 s : string;
Roger Meier3bef8c22012-10-06 06:58:00 +0000185 threads : array of TThread;
186 dtStart : TDateTime;
187 test : Integer;
188 thread : TThread;
189 trans : ITransport;
190 prot : IProtocol;
191 streamtrans : IStreamTransport;
192 http : IHTTPClient;
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200193 protType : TKnownProtocol;
194 endpoint : TEndpointTransport;
195 layered : TLayeredTransports;
196 UseSSL : Boolean; // include where appropriate (TLayeredTransport?)
Jens Geyer0b20cc82013-03-07 20:47:01 +0100197const
198 // pipe timeouts to be used
199 DEBUG_TIMEOUT = 30 * 1000;
Jens Geyer3e8d9272014-09-14 20:10:40 +0200200 RELEASE_TIMEOUT = DEFAULT_THRIFT_TIMEOUT;
Jens Geyer0b20cc82013-03-07 20:47:01 +0100201 TIMEOUT = RELEASE_TIMEOUT;
Roger Meier3bef8c22012-10-06 06:58:00 +0000202begin
Roger Meier3bef8c22012-10-06 06:58:00 +0000203 protType := prot_Binary;
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200204 endpoint := trns_Sockets;
205 layered := [];
206 UseSSL := FALSE;
207 host := 'localhost';
208 port := 9090;
209 sPipeName := '';
210 hAnonRead := INVALID_HANDLE_VALUE;
211 hAnonWrite := INVALID_HANDLE_VALUE;
Roger Meier3bef8c22012-10-06 06:58:00 +0000212 try
Roger Meier3bef8c22012-10-06 06:58:00 +0000213 i := 0;
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200214 while ( i < Length(args) ) do begin
215 s := args[i];
216 Inc( i);
Roger Meier3bef8c22012-10-06 06:58:00 +0000217
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200218 if (s = '-h') or (s = '--help') then begin
219 // -h [ --help ] produce help message
220 PrintCmdLineHelp;
221 result := $FF; // all tests failed
222 Exit;
223 end
Jens Geyerb360b652014-09-28 01:55:46 +0200224 else if s = '--host' then begin
225 // --host arg (=localhost) Host to connect
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200226 host := args[i];
227 Inc( i);
228 end
Jens Geyerb360b652014-09-28 01:55:46 +0200229 else if s = '--port' then begin
230 // --port arg (=9090) Port number to connect
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200231 s := args[i];
232 Inc( i);
233 port := StrToIntDef(s,0);
234 if port <= 0 then InvalidArgs;
235 end
Jens Geyerb360b652014-09-28 01:55:46 +0200236 else if s = '--domain-socket' then begin
237 // --domain-socket arg Domain Socket (e.g. /tmp/ThriftTest.thrift), instead of host and port
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200238 raise Exception.Create('domain-socket not supported');
239 end
Jens Geyerb360b652014-09-28 01:55:46 +0200240 else if s = '--named-pipe' then begin
241 // --named-pipe arg Windows Named Pipe (e.g. MyThriftPipe)
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200242 endpoint := trns_NamedPipes;
243 sPipeName := args[i];
244 Inc( i);
245 end
Jens Geyerb360b652014-09-28 01:55:46 +0200246 else if s = '--anon-pipes' then begin
247 // --anon-pipes hRead hWrite Windows Anonymous Pipes pair (handles)
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200248 endpoint := trns_AnonPipes;
249 hAnonRead := THandle( StrToIntDef( args[i], Integer(INVALID_HANDLE_VALUE)));
250 Inc( i);
251 hAnonWrite := THandle( StrToIntDef( args[i], Integer(INVALID_HANDLE_VALUE)));
252 Inc( i);
253 end
Jens Geyerb360b652014-09-28 01:55:46 +0200254 else if s = '--transport' then begin
255 // --transport arg (=sockets) Transport: buffered, framed, http, evhttp
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200256 s := args[i];
257 Inc( i);
Roger Meier3bef8c22012-10-06 06:58:00 +0000258
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200259 if s = 'buffered' then Include( layered, trns_Buffered)
260 else if s = 'framed' then Include( layered, trns_Framed)
261 else if s = 'http' then endpoint := trns_Http
Jens Geyera62efa42017-09-07 22:24:33 +0200262 else if s = 'evhttp' then endpoint := trns_EvHttp
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200263 else InvalidArgs;
264 end
Jens Geyerb360b652014-09-28 01:55:46 +0200265 else if s = '--protocol' then begin
266 // --protocol arg (=binary) Protocol: binary, compact, json
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200267 s := args[i];
268 Inc( i);
Roger Meier3bef8c22012-10-06 06:58:00 +0000269
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200270 if s = 'binary' then protType := prot_Binary
271 else if s = 'compact' then protType := prot_Compact
272 else if s = 'json' then protType := prot_JSON
273 else InvalidArgs;
274 end
Jens Geyerb360b652014-09-28 01:55:46 +0200275 else if s = '--ssl' then begin
276 // --ssl Encrypted Transport using SSL
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200277 UseSSL := TRUE;
278
279 end
280 else if (s = '-n') or (s = '--testloops') then begin
281 // -n [ --testloops ] arg (=1) Number of Tests
282 FNumIteration := StrToIntDef( args[i], 0);
283 Inc( i);
284 if FNumIteration <= 0
285 then InvalidArgs;
286
287 end
288 else if (s = '-t') or (s = '--threads') then begin
289 // -t [ --threads ] arg (=1) Number of Test threads
290 FNumThread := StrToIntDef( args[i], 0);
291 Inc( i);
292 if FNumThread <= 0
293 then InvalidArgs;
294 end
295 else begin
296 InvalidArgs;
Roger Meier3bef8c22012-10-06 06:58:00 +0000297 end;
298 end;
299
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200300
Roger Meier79655fb2012-10-20 20:59:41 +0000301 // In the anonymous pipes mode the client is launched by the test server
302 // -> behave nicely and allow for attaching a debugger to this process
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200303 if (endpoint = trns_AnonPipes) and not IsDebuggerPresent
Roger Meier79655fb2012-10-20 20:59:41 +0000304 then MessageBox( 0, 'Attach Debugger and/or click OK to continue.',
305 'Thrift TestClient (Delphi)',
306 MB_OK or MB_ICONEXCLAMATION);
307
Roger Meier3bef8c22012-10-06 06:58:00 +0000308 SetLength( threads, FNumThread);
309 dtStart := Now;
310
311 for test := 0 to FNumThread - 1 do
312 begin
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200313 case endpoint of
314 trns_Sockets: begin
Roger Meier3bef8c22012-10-06 06:58:00 +0000315 Console.WriteLine('Using sockets ('+host+' port '+IntToStr(port)+')');
316 streamtrans := TSocketImpl.Create( host, port );
317 end;
318
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200319 trns_Http: begin
320 Console.WriteLine('Using HTTPClient');
321 http := THTTPClientImpl.Create( host);
322 trans := http;
Roger Meier3bef8c22012-10-06 06:58:00 +0000323 end;
324
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200325 trns_EvHttp: begin
326 raise Exception.Create(ENDPOINT_TRANSPORTS[endpoint]+' transport not implemented');
Roger Meier3bef8c22012-10-06 06:58:00 +0000327 end;
328
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200329 trns_NamedPipes: begin
330 Console.WriteLine('Using named pipe ('+sPipeName+')');
Jens Geyerae985dd2016-04-20 21:48:35 +0200331 streamtrans := TNamedPipeTransportClientEndImpl.Create( sPipeName, 0, nil, TIMEOUT, TIMEOUT);
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200332 end;
333
334 trns_AnonPipes: begin
335 Console.WriteLine('Using anonymous pipes ('+IntToStr(Integer(hAnonRead))+' and '+IntToStr(Integer(hAnonWrite))+')');
336 streamtrans := TAnonymousPipeTransportImpl.Create( hAnonRead, hAnonWrite, FALSE);
337 end;
338
339 else
340 raise Exception.Create('Unhandled endpoint transport');
341 end;
342 trans := streamtrans;
343 ASSERT( trans <> nil);
344
345 if (trns_Buffered in layered) then begin
346 trans := TBufferedTransportImpl.Create( streamtrans, 32); // small buffer to test read()
347 Console.WriteLine('Using buffered transport');
348 end;
349
350 if (trns_Framed in layered) then begin
351 trans := TFramedTransportImpl.Create( trans );
352 Console.WriteLine('Using framed transport');
353 end;
354
355 if UseSSL then begin
356 raise Exception.Create('SSL not implemented');
Roger Meier3bef8c22012-10-06 06:58:00 +0000357 end;
358
359 // create protocol instance, default to BinaryProtocol
360 case protType of
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200361 prot_Binary : prot := TBinaryProtocolImpl.Create( trans, BINARY_STRICT_READ, BINARY_STRICT_WRITE);
362 prot_JSON : prot := TJSONProtocolImpl.Create( trans);
Jens Geyerf0e63312015-03-01 18:47:49 +0100363 prot_Compact : prot := TCompactProtocolImpl.Create( trans);
Roger Meier3bef8c22012-10-06 06:58:00 +0000364 else
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200365 raise Exception.Create('Unhandled protocol');
Roger Meier3bef8c22012-10-06 06:58:00 +0000366 end;
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200367 ASSERT( trans <> nil);
368 Console.WriteLine(THRIFT_PROTOCOLS[protType]+' protocol');
Roger Meier3bef8c22012-10-06 06:58:00 +0000369
370 thread := TClientThread.Create( trans, prot, FNumIteration);
371 threads[test] := thread;
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200372 thread.Start;
Roger Meier3bef8c22012-10-06 06:58:00 +0000373 end;
374
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200375 result := 0;
376 for test := 0 to FNumThread - 1 do begin
377 result := result or threads[test].WaitFor;
Roger Meier3bef8c22012-10-06 06:58:00 +0000378 end;
379
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200380 for test := 0 to FNumThread - 1
381 do threads[test].Free;
Roger Meier3bef8c22012-10-06 06:58:00 +0000382
383 Console.Write('Total time: ' + IntToStr( MilliSecondsBetween(Now, dtStart)));
384
385 except
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200386 on E: EAbort do raise;
387 on E: Exception do begin
388 Console.WriteLine( E.Message + #10 + E.StackTrace);
389 raise;
Roger Meier3bef8c22012-10-06 06:58:00 +0000390 end;
391 end;
392
393 Console.WriteLine('');
394 Console.WriteLine('done!');
395end;
396
397{ TClientThread }
398
399procedure TClientThread.ClientTest;
400var
401 client : TThriftTest.Iface;
402 s : string;
403 i8 : ShortInt;
404 i32 : Integer;
405 i64 : Int64;
Jens Geyerfd1b3582014-12-13 23:42:58 +0100406 binOut,binIn : TBytes;
Roger Meier3bef8c22012-10-06 06:58:00 +0000407 dub : Double;
408 o : IXtruct;
409 o2 : IXtruct2;
410 i : IXtruct;
411 i2 : IXtruct2;
412 mapout : IThriftDictionary<Integer,Integer>;
413 mapin : IThriftDictionary<Integer,Integer>;
414 strmapout : IThriftDictionary<string,string>;
415 strmapin : IThriftDictionary<string,string>;
416 j : Integer;
417 first : Boolean;
418 key : Integer;
419 strkey : string;
420 listout : IThriftList<Integer>;
421 listin : IThriftList<Integer>;
422 setout : IHashSet<Integer>;
423 setin : IHashSet<Integer>;
424 ret : TNumberz;
425 uid : Int64;
426 mm : IThriftDictionary<Integer, IThriftDictionary<Integer, Integer>>;
427 pos : IThriftDictionary<Integer, Integer>;
428 neg : IThriftDictionary<Integer, Integer>;
429 m2 : IThriftDictionary<Integer, Integer>;
430 k2 : Integer;
431 insane : IInsanity;
432 truck : IXtruct;
433 whoa : IThriftDictionary<Int64, IThriftDictionary<TNumberz, IInsanity>>;
434 key64 : Int64;
435 val : IThriftDictionary<TNumberz, IInsanity>;
436 k2_2 : TNumberz;
437 k3 : TNumberz;
438 v2 : IInsanity;
439 userMap : IThriftDictionary<TNumberz, Int64>;
440 xtructs : IThriftList<IXtruct>;
441 x : IXtruct;
442 arg0 : ShortInt;
443 arg1 : Integer;
444 arg2 : Int64;
445 arg3 : IThriftDictionary<SmallInt, string>;
446 arg4 : TNumberz;
447 arg5 : Int64;
Jens Geyer9f7f11e2016-04-14 21:37:11 +0200448 {$IFDEF PerfTest}
Roger Meier3bef8c22012-10-06 06:58:00 +0000449 StartTick : Cardinal;
450 k : Integer;
Jens Geyer9f7f11e2016-04-14 21:37:11 +0200451 {$ENDIF}
Roger Meier3bef8c22012-10-06 06:58:00 +0000452 hello, goodbye : IXtruct;
453 crazy : IInsanity;
454 looney : IInsanity;
455 first_map : IThriftDictionary<TNumberz, IInsanity>;
456 second_map : IThriftDictionary<TNumberz, IInsanity>;
Jens Geyer540e3462016-12-28 14:25:41 +0100457 pair : TPair<TNumberz, TUserId>;
Roger Meier3bef8c22012-10-06 06:58:00 +0000458begin
459 client := TThriftTest.TClient.Create( FProtocol);
460 FTransport.Open;
461
Jens Geyer06045cf2013-03-27 20:26:25 +0200462 {$IFDEF StressTest}
463 StressTest( client);
464 {$ENDIF StressTest}
465
Jens Geyer17c3ad92017-09-05 20:31:27 +0200466 {$IFDEF Exceptions}
Roger Meier3bef8c22012-10-06 06:58:00 +0000467 // in-depth exception test
468 // (1) do we get an exception at all?
469 // (2) do we get the right exception?
470 // (3) does the exception contain the expected data?
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200471 StartTestGroup( 'testException', test_Exceptions);
Roger Meier3bef8c22012-10-06 06:58:00 +0000472 // case 1: exception type declared in IDL at the function call
473 try
474 client.testException('Xception');
475 Expect( FALSE, 'testException(''Xception''): must trow an exception');
476 except
477 on e:TXception do begin
478 Expect( e.ErrorCode = 1001, 'error code');
479 Expect( e.Message_ = 'Xception', 'error message');
480 Console.WriteLine( ' = ' + IntToStr(e.ErrorCode) + ', ' + e.Message_ );
481 end;
482 on e:TTransportException do Expect( FALSE, 'Unexpected : "'+e.ToString+'"');
483 on e:Exception do Expect( FALSE, 'Unexpected exception type "'+e.ClassName+'"');
484 end;
485
486 // case 2: exception type NOT declared in IDL at the function call
487 // this will close the connection
488 try
489 client.testException('TException');
490 Expect( FALSE, 'testException(''TException''): must trow an exception');
491 except
492 on e:TTransportException do begin
493 Console.WriteLine( e.ClassName+' = '+e.Message); // this is what we get
Roger Meier3bef8c22012-10-06 06:58:00 +0000494 end;
Jens Geyer6bbbf192014-09-07 01:45:56 +0200495 on e:TApplicationException do begin
496 Console.WriteLine( e.ClassName+' = '+e.Message); // this is what we get
Jens Geyer6bbbf192014-09-07 01:45:56 +0200497 end;
Roger Meier3bef8c22012-10-06 06:58:00 +0000498 on e:TException do Expect( FALSE, 'Unexpected exception type "'+e.ClassName+'"');
499 on e:Exception do Expect( FALSE, 'Unexpected exception type "'+e.ClassName+'"');
500 end;
501
Jens Geyer6f6aa8a2016-03-10 19:47:12 +0100502
Jens Geyer2ad6c302015-02-26 19:38:53 +0100503 if FTransport.IsOpen then FTransport.Close;
504 FTransport.Open; // re-open connection, server has already closed
Jens Geyer6f6aa8a2016-03-10 19:47:12 +0100505
Jens Geyer2ad6c302015-02-26 19:38:53 +0100506
Roger Meier3bef8c22012-10-06 06:58:00 +0000507 // case 3: no exception
508 try
509 client.testException('something');
510 Expect( TRUE, 'testException(''something''): must not trow an exception');
511 except
512 on e:TTransportException do Expect( FALSE, 'Unexpected : "'+e.ToString+'"');
513 on e:Exception do Expect( FALSE, 'Unexpected exception "'+e.ClassName+'"');
514 end;
Jens Geyer17c3ad92017-09-05 20:31:27 +0200515 {$ENDIF Exceptions}
Roger Meier3bef8c22012-10-06 06:58:00 +0000516
517
518 // simple things
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200519 StartTestGroup( 'simple Thrift calls', test_BaseTypes);
Roger Meier3bef8c22012-10-06 06:58:00 +0000520 client.testVoid();
521 Expect( TRUE, 'testVoid()'); // success := no exception
522
Jens Geyer39ba6b72015-09-22 00:00:49 +0200523 s := BoolToString( client.testBool(TRUE));
524 Expect( s = BoolToString(TRUE), 'testBool(TRUE) = '+s);
525 s := BoolToString( client.testBool(FALSE));
526 Expect( s = BoolToString(FALSE), 'testBool(FALSE) = '+s);
527
Roger Meier3bef8c22012-10-06 06:58:00 +0000528 s := client.testString('Test');
529 Expect( s = 'Test', 'testString(''Test'') = "'+s+'"');
530
Jens Geyercf892d42017-09-09 10:08:22 +0200531 s := client.testString(''); // empty string
532 Expect( s = '', 'testString('''') = "'+s+'"');
533
Jens Geyer06045cf2013-03-27 20:26:25 +0200534 s := client.testString(HUGE_TEST_STRING);
535 Expect( length(s) = length(HUGE_TEST_STRING),
Konrad Grochowski3b5dacb2014-11-24 10:55:31 +0100536 'testString( length(HUGE_TEST_STRING) = '+IntToStr(Length(HUGE_TEST_STRING))+') '
Jens Geyer06045cf2013-03-27 20:26:25 +0200537 +'=> length(result) = '+IntToStr(Length(s)));
538
Roger Meier3bef8c22012-10-06 06:58:00 +0000539 i8 := client.testByte(1);
540 Expect( i8 = 1, 'testByte(1) = ' + IntToStr( i8 ));
541
542 i32 := client.testI32(-1);
543 Expect( i32 = -1, 'testI32(-1) = ' + IntToStr(i32));
544
545 Console.WriteLine('testI64(-34359738368)');
546 i64 := client.testI64(-34359738368);
547 Expect( i64 = -34359738368, 'testI64(-34359738368) = ' + IntToStr( i64));
548
Jens Geyerd4df9172017-10-25 22:30:23 +0200549 // random binary small
550 binOut := PrepareBinaryData( TRUE, FALSE);
551 Console.WriteLine('testBinary('+BytesToHex(binOut)+')');
552 try
553 binIn := client.testBinary(binOut);
554 Expect( Length(binOut) = Length(binIn), 'testBinary(): length '+IntToStr(Length(binOut))+' = '+IntToStr(Length(binIn)));
555 i32 := Min( Length(binOut), Length(binIn));
556 Expect( CompareMem( binOut, binIn, i32), 'testBinary('+BytesToHex(binOut)+') = '+BytesToHex(binIn));
557 except
558 on e:TApplicationException do Console.WriteLine('testBinary(): '+e.Message);
559 on e:Exception do Expect( FALSE, 'testBinary(): Unexpected exception "'+e.ClassName+'": '+e.Message);
560 end;
561
562 // random binary huge
563 binOut := PrepareBinaryData( TRUE, TRUE);
Jens Geyerfd1b3582014-12-13 23:42:58 +0100564 Console.WriteLine('testBinary('+BytesToHex(binOut)+')');
565 try
566 binIn := client.testBinary(binOut);
567 Expect( Length(binOut) = Length(binIn), 'testBinary(): length '+IntToStr(Length(binOut))+' = '+IntToStr(Length(binIn)));
568 i32 := Min( Length(binOut), Length(binIn));
569 Expect( CompareMem( binOut, binIn, i32), 'testBinary('+BytesToHex(binOut)+') = '+BytesToHex(binIn));
570 except
571 on e:TApplicationException do Console.WriteLine('testBinary(): '+e.Message);
572 on e:Exception do Expect( FALSE, 'testBinary(): Unexpected exception "'+e.ClassName+'": '+e.Message);
573 end;
574
Jens Geyercf892d42017-09-09 10:08:22 +0200575 // empty binary
576 SetLength( binOut, 0);
577 Console.WriteLine('testBinary('+BytesToHex(binOut)+')');
578 try
579 binIn := client.testBinary(binOut);
580 Expect( Length(binOut) = Length(binIn), 'testBinary(): length '+IntToStr(Length(binOut))+' = '+IntToStr(Length(binIn)));
581 i32 := Min( Length(binOut), Length(binIn));
582 Expect( CompareMem( binOut, binIn, i32), 'testBinary('+BytesToHex(binOut)+') = '+BytesToHex(binIn));
583 except
584 on e:TApplicationException do Console.WriteLine('testBinary(): '+e.Message);
585 on e:Exception do Expect( FALSE, 'testBinary(): Unexpected exception "'+e.ClassName+'": '+e.Message);
586 end;
587
Roger Meier3bef8c22012-10-06 06:58:00 +0000588 Console.WriteLine('testDouble(5.325098235)');
589 dub := client.testDouble(5.325098235);
590 Expect( abs(dub-5.325098235) < 1e-14, 'testDouble(5.325098235) = ' + FloatToStr( dub));
591
592 // structs
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200593 StartTestGroup( 'testStruct', test_Structs);
Roger Meier3bef8c22012-10-06 06:58:00 +0000594 Console.WriteLine('testStruct({''Zero'', 1, -3, -5})');
595 o := TXtructImpl.Create;
596 o.String_thing := 'Zero';
597 o.Byte_thing := 1;
598 o.I32_thing := -3;
599 o.I64_thing := -5;
600 i := client.testStruct(o);
601 Expect( i.String_thing = 'Zero', 'i.String_thing = "'+i.String_thing+'"');
602 Expect( i.Byte_thing = 1, 'i.Byte_thing = '+IntToStr(i.Byte_thing));
603 Expect( i.I32_thing = -3, 'i.I32_thing = '+IntToStr(i.I32_thing));
604 Expect( i.I64_thing = -5, 'i.I64_thing = '+IntToStr(i.I64_thing));
605 Expect( i.__isset_String_thing, 'i.__isset_String_thing = '+BoolToString(i.__isset_String_thing));
606 Expect( i.__isset_Byte_thing, 'i.__isset_Byte_thing = '+BoolToString(i.__isset_Byte_thing));
607 Expect( i.__isset_I32_thing, 'i.__isset_I32_thing = '+BoolToString(i.__isset_I32_thing));
608 Expect( i.__isset_I64_thing, 'i.__isset_I64_thing = '+BoolToString(i.__isset_I64_thing));
609
610 // nested structs
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200611 StartTestGroup( 'testNest', test_Structs);
Roger Meier3bef8c22012-10-06 06:58:00 +0000612 Console.WriteLine('testNest({1, {''Zero'', 1, -3, -5}, 5})');
613 o2 := TXtruct2Impl.Create;
614 o2.Byte_thing := 1;
615 o2.Struct_thing := o;
616 o2.I32_thing := 5;
617 i2 := client.testNest(o2);
618 i := i2.Struct_thing;
619 Expect( i.String_thing = 'Zero', 'i.String_thing = "'+i.String_thing+'"');
620 Expect( i.Byte_thing = 1, 'i.Byte_thing = '+IntToStr(i.Byte_thing));
621 Expect( i.I32_thing = -3, 'i.I32_thing = '+IntToStr(i.I32_thing));
622 Expect( i.I64_thing = -5, 'i.I64_thing = '+IntToStr(i.I64_thing));
623 Expect( i2.Byte_thing = 1, 'i2.Byte_thing = '+IntToStr(i2.Byte_thing));
624 Expect( i2.I32_thing = 5, 'i2.I32_thing = '+IntToStr(i2.I32_thing));
625 Expect( i.__isset_String_thing, 'i.__isset_String_thing = '+BoolToString(i.__isset_String_thing));
626 Expect( i.__isset_Byte_thing, 'i.__isset_Byte_thing = '+BoolToString(i.__isset_Byte_thing));
627 Expect( i.__isset_I32_thing, 'i.__isset_I32_thing = '+BoolToString(i.__isset_I32_thing));
628 Expect( i.__isset_I64_thing, 'i.__isset_I64_thing = '+BoolToString(i.__isset_I64_thing));
629 Expect( i2.__isset_Byte_thing, 'i2.__isset_Byte_thing');
630 Expect( i2.__isset_I32_thing, 'i2.__isset_I32_thing');
631
632 // map<type1,type2>: A map of strictly unique keys to values.
633 // Translates to an STL map, Java HashMap, PHP associative array, Python/Ruby dictionary, etc.
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200634 StartTestGroup( 'testMap', test_Containers);
Roger Meier3bef8c22012-10-06 06:58:00 +0000635 mapout := TThriftDictionaryImpl<Integer,Integer>.Create;
636 for j := 0 to 4 do
637 begin
638 mapout.AddOrSetValue( j, j - 10);
639 end;
640 Console.Write('testMap({');
641 first := True;
642 for key in mapout.Keys do
643 begin
644 if first
645 then first := False
646 else Console.Write( ', ' );
647 Console.Write( IntToStr( key) + ' => ' + IntToStr( mapout[key]));
648 end;
649 Console.WriteLine('})');
650
651 mapin := client.testMap( mapout );
652 Expect( mapin.Count = mapout.Count, 'testMap: mapin.Count = mapout.Count');
653 for j := 0 to 4 do
654 begin
655 Expect( mapout.ContainsKey(j), 'testMap: mapout.ContainsKey('+IntToStr(j)+') = '+BoolToString(mapout.ContainsKey(j)));
656 end;
657 for key in mapin.Keys do
658 begin
659 Expect( mapin[key] = mapout[key], 'testMap: '+IntToStr(key) + ' => ' + IntToStr( mapin[key]));
660 Expect( mapin[key] = key - 10, 'testMap: mapin['+IntToStr(key)+'] = '+IntToStr( mapin[key]));
661 end;
662
663
664 // map<type1,type2>: A map of strictly unique keys to values.
665 // Translates to an STL map, Java HashMap, PHP associative array, Python/Ruby dictionary, etc.
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200666 StartTestGroup( 'testStringMap', test_Containers);
Roger Meier3bef8c22012-10-06 06:58:00 +0000667 strmapout := TThriftDictionaryImpl<string,string>.Create;
668 for j := 0 to 4 do
669 begin
670 strmapout.AddOrSetValue( IntToStr(j), IntToStr(j - 10));
671 end;
672 Console.Write('testStringMap({');
673 first := True;
674 for strkey in strmapout.Keys do
675 begin
676 if first
677 then first := False
678 else Console.Write( ', ' );
679 Console.Write( strkey + ' => ' + strmapout[strkey]);
680 end;
681 Console.WriteLine('})');
682
683 strmapin := client.testStringMap( strmapout );
684 Expect( strmapin.Count = strmapout.Count, 'testStringMap: strmapin.Count = strmapout.Count');
685 for j := 0 to 4 do
686 begin
687 Expect( strmapout.ContainsKey(IntToStr(j)),
688 'testStringMap: strmapout.ContainsKey('+IntToStr(j)+') = '
689 + BoolToString(strmapout.ContainsKey(IntToStr(j))));
690 end;
691 for strkey in strmapin.Keys do
692 begin
693 Expect( strmapin[strkey] = strmapout[strkey], 'testStringMap: '+strkey + ' => ' + strmapin[strkey]);
694 Expect( strmapin[strkey] = IntToStr( StrToInt(strkey) - 10), 'testStringMap: strmapin['+strkey+'] = '+strmapin[strkey]);
695 end;
696
697
698 // set<type>: An unordered set of unique elements.
699 // Translates to an STL set, Java HashSet, set in Python, etc.
700 // Note: PHP does not support sets, so it is treated similar to a List
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200701 StartTestGroup( 'testSet', test_Containers);
Roger Meier3bef8c22012-10-06 06:58:00 +0000702 setout := THashSetImpl<Integer>.Create;
703 for j := -2 to 2 do
704 begin
705 setout.Add( j );
706 end;
707 Console.Write('testSet({');
708 first := True;
709 for j in setout do
710 begin
711 if first
712 then first := False
713 else Console.Write(', ');
714 Console.Write(IntToStr( j));
715 end;
716 Console.WriteLine('})');
717
718 setin := client.testSet(setout);
719 Expect( setin.Count = setout.Count, 'testSet: setin.Count = setout.Count');
720 Expect( setin.Count = 5, 'testSet: setin.Count = '+IntToStr(setin.Count));
721 for j := -2 to 2 do // unordered, we can't rely on the order => test for known elements only
722 begin
723 Expect( setin.Contains(j), 'testSet: setin.Contains('+IntToStr(j)+') => '+BoolToString(setin.Contains(j)));
724 end;
725
726 // list<type>: An ordered list of elements.
727 // Translates to an STL vector, Java ArrayList, native arrays in scripting languages, etc.
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200728 StartTestGroup( 'testList', test_Containers);
Roger Meier3bef8c22012-10-06 06:58:00 +0000729 listout := TThriftListImpl<Integer>.Create;
730 listout.Add( +1);
731 listout.Add( -2);
732 listout.Add( +3);
733 listout.Add( -4);
734 listout.Add( 0);
735 Console.Write('testList({');
736 first := True;
737 for j in listout do
738 begin
739 if first
740 then first := False
741 else Console.Write(', ');
742 Console.Write(IntToStr( j));
743 end;
744 Console.WriteLine('})');
745
746 listin := client.testList(listout);
747 Expect( listin.Count = listout.Count, 'testList: listin.Count = listout.Count');
748 Expect( listin.Count = 5, 'testList: listin.Count = '+IntToStr(listin.Count));
749 Expect( listin[0] = +1, 'listin[0] = '+IntToStr( listin[0]));
750 Expect( listin[1] = -2, 'listin[1] = '+IntToStr( listin[1]));
751 Expect( listin[2] = +3, 'listin[2] = '+IntToStr( listin[2]));
752 Expect( listin[3] = -4, 'listin[3] = '+IntToStr( listin[3]));
753 Expect( listin[4] = 0, 'listin[4] = '+IntToStr( listin[4]));
754
755 // enums
756 ret := client.testEnum(TNumberz.ONE);
757 Expect( ret = TNumberz.ONE, 'testEnum(ONE) = '+IntToStr(Ord(ret)));
758
759 ret := client.testEnum(TNumberz.TWO);
760 Expect( ret = TNumberz.TWO, 'testEnum(TWO) = '+IntToStr(Ord(ret)));
761
762 ret := client.testEnum(TNumberz.THREE);
763 Expect( ret = TNumberz.THREE, 'testEnum(THREE) = '+IntToStr(Ord(ret)));
764
765 ret := client.testEnum(TNumberz.FIVE);
766 Expect( ret = TNumberz.FIVE, 'testEnum(FIVE) = '+IntToStr(Ord(ret)));
767
768 ret := client.testEnum(TNumberz.EIGHT);
769 Expect( ret = TNumberz.EIGHT, 'testEnum(EIGHT) = '+IntToStr(Ord(ret)));
770
771
772 // typedef
773 uid := client.testTypedef(309858235082523);
774 Expect( uid = 309858235082523, 'testTypedef(309858235082523) = '+IntToStr(uid));
775
776
777 // maps of maps
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200778 StartTestGroup( 'testMapMap(1)', test_Containers);
Roger Meier3bef8c22012-10-06 06:58:00 +0000779 mm := client.testMapMap(1);
780 Console.Write(' = {');
781 for key in mm.Keys do
782 begin
783 Console.Write( IntToStr( key) + ' => {');
784 m2 := mm[key];
785 for k2 in m2.Keys do
786 begin
787 Console.Write( IntToStr( k2) + ' => ' + IntToStr( m2[k2]) + ', ');
788 end;
789 Console.Write('}, ');
790 end;
791 Console.WriteLine('}');
792
793 // verify result data
794 Expect( mm.Count = 2, 'mm.Count = '+IntToStr(mm.Count));
795 pos := mm[4];
796 neg := mm[-4];
797 for j := 1 to 4 do
798 begin
799 Expect( pos[j] = j, 'pos[j] = '+IntToStr(pos[j]));
800 Expect( neg[-j] = -j, 'neg[-j] = '+IntToStr(neg[-j]));
801 end;
802
803
804
805 // insanity
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200806 StartTestGroup( 'testInsanity', test_Structs);
Roger Meier3bef8c22012-10-06 06:58:00 +0000807 insane := TInsanityImpl.Create;
808 insane.UserMap := TThriftDictionaryImpl<TNumberz, Int64>.Create;
809 insane.UserMap.AddOrSetValue( TNumberz.FIVE, 5000);
810 truck := TXtructImpl.Create;
811 truck.String_thing := 'Truck';
Jens Geyer540e3462016-12-28 14:25:41 +0100812 truck.Byte_thing := -8; // byte is signed
813 truck.I32_thing := 32;
814 truck.I64_thing := 64;
Roger Meier3bef8c22012-10-06 06:58:00 +0000815 insane.Xtructs := TThriftListImpl<IXtruct>.Create;
816 insane.Xtructs.Add( truck );
817 whoa := client.testInsanity( insane );
818 Console.Write(' = {');
819 for key64 in whoa.Keys do
820 begin
821 val := whoa[key64];
822 Console.Write( IntToStr( key64) + ' => {');
823 for k2_2 in val.Keys do
824 begin
825 v2 := val[k2_2];
826 Console.Write( IntToStr( Integer( k2_2)) + ' => {');
827 userMap := v2.UserMap;
828 Console.Write('{');
829 if userMap <> nil then
830 begin
831 for k3 in userMap.Keys do
832 begin
833 Console.Write( IntToStr( Integer( k3)) + ' => ' + IntToStr( userMap[k3]) + ', ');
834 end;
835 end else
836 begin
837 Console.Write('null');
838 end;
839 Console.Write('}, ');
840 xtructs := v2.Xtructs;
841 Console.Write('{');
842
843 if xtructs <> nil then
844 begin
845 for x in xtructs do
846 begin
847 Console.Write('{"' + x.String_thing + '", ' +
848 IntToStr( x.Byte_thing) + ', ' +
849 IntToStr( x.I32_thing) + ', ' +
850 IntToStr( x.I32_thing) + '}, ');
851 end;
852 end else
853 begin
854 Console.Write('null');
855 end;
856 Console.Write('}');
857 Console.Write('}, ');
858 end;
859 Console.Write('}, ');
860 end;
861 Console.WriteLine('}');
862
Jens Geyer540e3462016-12-28 14:25:41 +0100863 (**
864 * So you think you've got this all worked, out eh?
865 *
866 * Creates a the returned map with these values and prints it out:
867 * { 1 => { 2 => argument,
868 * 3 => argument,
869 * },
870 * 2 => { 6 => <empty Insanity struct>, },
871 * }
872 * @return map<UserId, map<Numberz,Insanity>> - a map with the above values
873 *)
874
Roger Meier3bef8c22012-10-06 06:58:00 +0000875 // verify result data
876 Expect( whoa.Count = 2, 'whoa.Count = '+IntToStr(whoa.Count));
877 //
878 first_map := whoa[1];
879 second_map := whoa[2];
880 Expect( first_map.Count = 2, 'first_map.Count = '+IntToStr(first_map.Count));
881 Expect( second_map.Count = 1, 'second_map.Count = '+IntToStr(second_map.Count));
882 //
883 looney := second_map[TNumberz.SIX];
884 Expect( Assigned(looney), 'Assigned(looney) = '+BoolToString(Assigned(looney)));
885 Expect( not looney.__isset_UserMap, 'looney.__isset_UserMap = '+BoolToString(looney.__isset_UserMap));
886 Expect( not looney.__isset_Xtructs, 'looney.__isset_Xtructs = '+BoolToString(looney.__isset_Xtructs));
887 //
888 for ret in [TNumberz.TWO, TNumberz.THREE] do begin
889 crazy := first_map[ret];
890 Console.WriteLine('first_map['+intToStr(Ord(ret))+']');
891
892 Expect( crazy.__isset_UserMap, 'crazy.__isset_UserMap = '+BoolToString(crazy.__isset_UserMap));
893 Expect( crazy.__isset_Xtructs, 'crazy.__isset_Xtructs = '+BoolToString(crazy.__isset_Xtructs));
894
Jens Geyer540e3462016-12-28 14:25:41 +0100895 Expect( crazy.UserMap.Count = insane.UserMap.Count, 'crazy.UserMap.Count = '+IntToStr(crazy.UserMap.Count));
896 for pair in insane.UserMap do begin
897 Expect( crazy.UserMap[pair.Key] = pair.Value, 'crazy.UserMap['+IntToStr(Ord(pair.key))+'] = '+IntToStr(crazy.UserMap[pair.Key]));
898 end;
Roger Meier3bef8c22012-10-06 06:58:00 +0000899
Jens Geyer540e3462016-12-28 14:25:41 +0100900 Expect( crazy.Xtructs.Count = insane.Xtructs.Count, 'crazy.Xtructs.Count = '+IntToStr(crazy.Xtructs.Count));
901 for arg0 := 0 to insane.Xtructs.Count-1 do begin
902 hello := insane.Xtructs[arg0];
903 goodbye := crazy.Xtructs[arg0];
904 Expect( goodbye.String_thing = hello.String_thing, 'goodbye.String_thing = '+goodbye.String_thing);
905 Expect( goodbye.Byte_thing = hello.Byte_thing, 'goodbye.Byte_thing = '+IntToStr(goodbye.Byte_thing));
906 Expect( goodbye.I32_thing = hello.I32_thing, 'goodbye.I32_thing = '+IntToStr(goodbye.I32_thing));
907 Expect( goodbye.I64_thing = hello.I64_thing, 'goodbye.I64_thing = '+IntToStr(goodbye.I64_thing));
908 end;
Roger Meier3bef8c22012-10-06 06:58:00 +0000909 end;
910
911
912 // multi args
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200913 StartTestGroup( 'testMulti', test_BaseTypes);
Roger Meier3bef8c22012-10-06 06:58:00 +0000914 arg0 := 1;
915 arg1 := 2;
916 arg2 := High(Int64);
917 arg3 := TThriftDictionaryImpl<SmallInt, string>.Create;
918 arg3.AddOrSetValue( 1, 'one');
919 arg4 := TNumberz.FIVE;
920 arg5 := 5000000;
921 Console.WriteLine('Test Multi(' + IntToStr( arg0) + ',' +
922 IntToStr( arg1) + ',' + IntToStr( arg2) + ',' +
923 arg3.ToString + ',' + IntToStr( Integer( arg4)) + ',' +
924 IntToStr( arg5) + ')');
925
926 i := client.testMulti( arg0, arg1, arg2, arg3, arg4, arg5);
927 Expect( i.String_thing = 'Hello2', 'testMulti: i.String_thing = "'+i.String_thing+'"');
928 Expect( i.Byte_thing = arg0, 'testMulti: i.Byte_thing = '+IntToStr(i.Byte_thing));
929 Expect( i.I32_thing = arg1, 'testMulti: i.I32_thing = '+IntToStr(i.I32_thing));
930 Expect( i.I64_thing = arg2, 'testMulti: i.I64_thing = '+IntToStr(i.I64_thing));
931 Expect( i.__isset_String_thing, 'testMulti: i.__isset_String_thing = '+BoolToString(i.__isset_String_thing));
932 Expect( i.__isset_Byte_thing, 'testMulti: i.__isset_Byte_thing = '+BoolToString(i.__isset_Byte_thing));
933 Expect( i.__isset_I32_thing, 'testMulti: i.__isset_I32_thing = '+BoolToString(i.__isset_I32_thing));
934 Expect( i.__isset_I64_thing, 'testMulti: i.__isset_I64_thing = '+BoolToString(i.__isset_I64_thing));
935
936 // multi exception
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200937 StartTestGroup( 'testMultiException(1)', test_Exceptions);
Roger Meier3bef8c22012-10-06 06:58:00 +0000938 try
939 i := client.testMultiException( 'need more pizza', 'run out of beer');
940 Expect( i.String_thing = 'run out of beer', 'i.String_thing = "' +i.String_thing+ '"');
941 Expect( i.__isset_String_thing, 'i.__isset_String_thing = '+BoolToString(i.__isset_String_thing));
Jens Geyer6bbbf192014-09-07 01:45:56 +0200942 { this is not necessarily true, these fields are default-serialized
Jens Geyerd5436f52014-10-03 19:50:38 +0200943 Expect( not i.__isset_Byte_thing, 'i.__isset_Byte_thing = '+BoolToString(i.__isset_Byte_thing));
Roger Meier3bef8c22012-10-06 06:58:00 +0000944 Expect( not i.__isset_I32_thing, 'i.__isset_I32_thing = '+BoolToString(i.__isset_I32_thing));
945 Expect( not i.__isset_I64_thing, 'i.__isset_I64_thing = '+BoolToString(i.__isset_I64_thing));
Jens Geyerd5436f52014-10-03 19:50:38 +0200946 }
Roger Meier3bef8c22012-10-06 06:58:00 +0000947 except
948 on e:Exception do Expect( FALSE, 'Unexpected exception "'+e.ClassName+'"');
949 end;
950
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200951 StartTestGroup( 'testMultiException(Xception)', test_Exceptions);
Roger Meier3bef8c22012-10-06 06:58:00 +0000952 try
953 i := client.testMultiException( 'Xception', 'second test');
954 Expect( FALSE, 'testMultiException(''Xception''): must trow an exception');
955 except
956 on x:TXception do begin
957 Expect( x.__isset_ErrorCode, 'x.__isset_ErrorCode = '+BoolToString(x.__isset_ErrorCode));
958 Expect( x.__isset_Message_, 'x.__isset_Message_ = '+BoolToString(x.__isset_Message_));
959 Expect( x.ErrorCode = 1001, 'x.ErrorCode = '+IntToStr(x.ErrorCode));
960 Expect( x.Message_ = 'This is an Xception', 'x.Message = "'+x.Message_+'"');
961 end;
962 on e:Exception do Expect( FALSE, 'Unexpected exception "'+e.ClassName+'"');
963 end;
964
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200965 StartTestGroup( 'testMultiException(Xception2)', test_Exceptions);
Roger Meier3bef8c22012-10-06 06:58:00 +0000966 try
967 i := client.testMultiException( 'Xception2', 'third test');
968 Expect( FALSE, 'testMultiException(''Xception2''): must trow an exception');
969 except
970 on x:TXception2 do begin
971 Expect( x.__isset_ErrorCode, 'x.__isset_ErrorCode = '+BoolToString(x.__isset_ErrorCode));
972 Expect( x.__isset_Struct_thing, 'x.__isset_Struct_thing = '+BoolToString(x.__isset_Struct_thing));
973 Expect( x.ErrorCode = 2002, 'x.ErrorCode = '+IntToStr(x.ErrorCode));
974 Expect( x.Struct_thing.String_thing = 'This is an Xception2', 'x.Struct_thing.String_thing = "'+x.Struct_thing.String_thing+'"');
975 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 +0200976 { this is not necessarily true, these fields are default-serialized
Roger Meier3bef8c22012-10-06 06:58:00 +0000977 Expect( not x.Struct_thing.__isset_Byte_thing, 'x.Struct_thing.__isset_Byte_thing = '+BoolToString(x.Struct_thing.__isset_Byte_thing));
978 Expect( not x.Struct_thing.__isset_I32_thing, 'x.Struct_thing.__isset_I32_thing = '+BoolToString(x.Struct_thing.__isset_I32_thing));
979 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 +0200980 }
Roger Meier3bef8c22012-10-06 06:58:00 +0000981 end;
982 on e:Exception do Expect( FALSE, 'Unexpected exception "'+e.ClassName+'"');
983 end;
984
985
986 // oneway functions
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200987 StartTestGroup( 'Test Oneway(1)', test_Unknown);
Roger Meier3bef8c22012-10-06 06:58:00 +0000988 client.testOneway(1);
989 Expect( TRUE, 'Test Oneway(1)'); // success := no exception
990
991 // call time
Jens Geyer06045cf2013-03-27 20:26:25 +0200992 {$IFDEF PerfTest}
Roger Meier3bef8c22012-10-06 06:58:00 +0000993 StartTestGroup( 'Test Calltime()');
Jens Geyer9f7f11e2016-04-14 21:37:11 +0200994 StartTick := GetTickCount;
Roger Meier3bef8c22012-10-06 06:58:00 +0000995 for k := 0 to 1000 - 1 do
996 begin
997 client.testVoid();
998 end;
999 Console.WriteLine(' = ' + FloatToStr( (GetTickCount - StartTick) / 1000 ) + ' ms a testVoid() call' );
Jens Geyer06045cf2013-03-27 20:26:25 +02001000 {$ENDIF PerfTest}
Roger Meier3bef8c22012-10-06 06:58:00 +00001001
1002 // no more tests here
Jens Geyerf8a1b7a2014-09-24 00:26:46 +02001003 StartTestGroup( '', test_Unknown);
Roger Meier3bef8c22012-10-06 06:58:00 +00001004end;
1005
1006
Jens Geyer718f6ee2013-09-06 21:02:34 +02001007{$IFDEF StressTest}
Jens Geyer06045cf2013-03-27 20:26:25 +02001008procedure TClientThread.StressTest(const client : TThriftTest.Iface);
1009begin
1010 while TRUE do begin
1011 try
1012 if not FTransport.IsOpen then FTransport.Open; // re-open connection, server has already closed
1013 try
1014 client.testString('Test');
1015 Write('.');
1016 finally
1017 if FTransport.IsOpen then FTransport.Close;
1018 end;
1019 except
1020 on e:Exception do Writeln(#10+e.message);
1021 end;
1022 end;
1023end;
Jens Geyer718f6ee2013-09-06 21:02:34 +02001024{$ENDIF}
Jens Geyer06045cf2013-03-27 20:26:25 +02001025
Jens Geyerfd1b3582014-12-13 23:42:58 +01001026
Jens Geyerd4df9172017-10-25 22:30:23 +02001027function TClientThread.PrepareBinaryData( aRandomDist, aHuge : Boolean) : TBytes;
1028var i : Integer;
Jens Geyerfd1b3582014-12-13 23:42:58 +01001029begin
Jens Geyerd4df9172017-10-25 22:30:23 +02001030 if aHuge
1031 then SetLength( result, $12345) // tests for THRIFT-4372
1032 else SetLength( result, $100);
Jens Geyerfd1b3582014-12-13 23:42:58 +01001033 ASSERT( Low(result) = 0);
1034
1035 // linear distribution, unless random is requested
1036 if not aRandomDist then begin
1037 for i := Low(result) to High(result) do begin
1038 result[i] := i;
1039 end;
1040 Exit;
1041 end;
1042
1043 // random distribution of all 256 values
1044 FillChar( result[0], Length(result) * SizeOf(result[0]), $0);
Jens Geyerd4df9172017-10-25 22:30:23 +02001045 for i := Low(result) to High(result) do begin
1046 result[i] := Byte( Random($100));
Jens Geyerfd1b3582014-12-13 23:42:58 +01001047 end;
1048end;
1049
1050
Jens Geyerf7904452017-07-26 15:02:12 +02001051{$IFDEF Win64}
1052procedure TClientThread.UseInterlockedExchangeAdd64;
1053var a,b : Int64;
1054begin
1055 a := 1;
1056 b := 2;
1057 Thrift.Utils.InterlockedExchangeAdd64( a,b);
1058 Expect( a = 3, 'InterlockedExchangeAdd64');
1059end;
1060{$ENDIF}
1061
1062
Roger Meier3bef8c22012-10-06 06:58:00 +00001063procedure TClientThread.JSONProtocolReadWriteTest;
1064// Tests only then read/write procedures of the JSON protocol
1065// All tests succeed, if we can read what we wrote before
1066// Note that passing this test does not imply, that our JSON is really compatible to what
1067// other clients or servers expect as the real JSON. This is beyond the scope of this test.
1068var prot : IProtocol;
1069 stm : TStringStream;
Jens Geyer17c3ad92017-09-05 20:31:27 +02001070 list : TThriftList;
Jens Geyercf892d42017-09-09 10:08:22 +02001071 binary, binRead, emptyBinary : TBytes;
Roger Meier3bef8c22012-10-06 06:58:00 +00001072 i,iErr : Integer;
1073const
1074 TEST_SHORT = ShortInt( $FE);
1075 TEST_SMALL = SmallInt( $FEDC);
1076 TEST_LONG = LongInt( $FEDCBA98);
1077 TEST_I64 = Int64( $FEDCBA9876543210);
1078 TEST_DOUBLE = -1.234e-56;
1079 DELTA_DOUBLE = TEST_DOUBLE * 1e-14;
1080 TEST_STRING = 'abc-'#$00E4#$00f6#$00fc; // german umlauts (en-us: "funny chars")
Phongphan Phutthaa6509f72015-10-31 01:09:47 +07001081 // Test THRIFT-2336 and THRIFT-3404 with U+1D11E (G Clef symbol) and 'Русское Название';
1082 G_CLEF_AND_CYRILLIC_TEXT = #$1d11e' '#$0420#$0443#$0441#$0441#$043a#$043e#$0435' '#$041d#$0430#$0437#$0432#$0430#$043d#$0438#$0435;
1083 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 +01001084 // test both possible solidus encodings
1085 SOLIDUS_JSON_DATA = '"one/two\/three"';
1086 SOLIDUS_EXCPECTED = 'one/two/three';
Roger Meier3bef8c22012-10-06 06:58:00 +00001087begin
1088 stm := TStringStream.Create;
1089 try
Jens Geyerf8a1b7a2014-09-24 00:26:46 +02001090 StartTestGroup( 'JsonProtocolTest', test_Unknown);
Roger Meier3bef8c22012-10-06 06:58:00 +00001091
1092 // prepare binary data
Jens Geyerd4df9172017-10-25 22:30:23 +02001093 binary := PrepareBinaryData( FALSE, FALSE);
Jens Geyercf892d42017-09-09 10:08:22 +02001094 SetLength( emptyBinary, 0); // empty binary data block
Roger Meier3bef8c22012-10-06 06:58:00 +00001095
1096 // output setup
1097 prot := TJSONProtocolImpl.Create(
1098 TStreamTransportImpl.Create(
1099 nil, TThriftStreamAdapterDelphi.Create( stm, FALSE)));
1100
1101 // write
Jens Geyer17c3ad92017-09-05 20:31:27 +02001102 Init( list, TType.String_, 9);
1103 prot.WriteListBegin( list);
Roger Meier3bef8c22012-10-06 06:58:00 +00001104 prot.WriteBool( TRUE);
1105 prot.WriteBool( FALSE);
1106 prot.WriteByte( TEST_SHORT);
1107 prot.WriteI16( TEST_SMALL);
1108 prot.WriteI32( TEST_LONG);
1109 prot.WriteI64( TEST_I64);
1110 prot.WriteDouble( TEST_DOUBLE);
1111 prot.WriteString( TEST_STRING);
1112 prot.WriteBinary( binary);
Jens Geyercf892d42017-09-09 10:08:22 +02001113 prot.WriteString( ''); // empty string
1114 prot.WriteBinary( emptyBinary); // empty binary data block
Roger Meier3bef8c22012-10-06 06:58:00 +00001115 prot.WriteListEnd;
1116
1117 // input setup
1118 Expect( stm.Position = stm.Size, 'Stream position/length after write');
1119 stm.Position := 0;
1120 prot := TJSONProtocolImpl.Create(
1121 TStreamTransportImpl.Create(
1122 TThriftStreamAdapterDelphi.Create( stm, FALSE), nil));
1123
1124 // read and compare
1125 list := prot.ReadListBegin;
1126 Expect( list.ElementType = TType.String_, 'list element type');
1127 Expect( list.Count = 9, 'list element count');
1128 Expect( prot.ReadBool, 'WriteBool/ReadBool: TRUE');
1129 Expect( not prot.ReadBool, 'WriteBool/ReadBool: FALSE');
1130 Expect( prot.ReadByte = TEST_SHORT, 'WriteByte/ReadByte');
1131 Expect( prot.ReadI16 = TEST_SMALL, 'WriteI16/ReadI16');
1132 Expect( prot.ReadI32 = TEST_LONG, 'WriteI32/ReadI32');
1133 Expect( prot.ReadI64 = TEST_I64, 'WriteI64/ReadI64');
1134 Expect( abs(prot.ReadDouble-TEST_DOUBLE) < abs(DELTA_DOUBLE), 'WriteDouble/ReadDouble');
1135 Expect( prot.ReadString = TEST_STRING, 'WriteString/ReadString');
1136 binRead := prot.ReadBinary;
Jens Geyercf892d42017-09-09 10:08:22 +02001137 Expect( Length(prot.ReadString) = 0, 'WriteString/ReadString (empty string)');
1138 Expect( Length(prot.ReadBinary) = 0, 'empty WriteBinary/ReadBinary (empty data block)');
Roger Meier3bef8c22012-10-06 06:58:00 +00001139 prot.ReadListEnd;
1140
1141 // test binary data
1142 Expect( Length(binary) = Length(binRead), 'Binary data length check');
1143 iErr := -1;
1144 for i := Low(binary) to High(binary) do begin
1145 if binary[i] <> binRead[i] then begin
1146 iErr := i;
1147 Break;
1148 end;
1149 end;
1150 if iErr < 0
1151 then Expect( TRUE, 'Binary data check ('+IntToStr(Length(binary))+' Bytes)')
1152 else Expect( FALSE, 'Binary data check at offset '+IntToStr(iErr));
1153
1154 Expect( stm.Position = stm.Size, 'Stream position after read');
1155
Jens Geyer7bb44a32014-02-07 22:24:37 +01001156
Jens Geyer21366942013-12-30 22:04:51 +01001157 // Solidus can be encoded in two ways. Make sure we can read both
1158 stm.Position := 0;
1159 stm.Size := 0;
1160 stm.WriteString(SOLIDUS_JSON_DATA);
1161 stm.Position := 0;
1162 prot := TJSONProtocolImpl.Create(
1163 TStreamTransportImpl.Create(
1164 TThriftStreamAdapterDelphi.Create( stm, FALSE), nil));
1165 Expect( prot.ReadString = SOLIDUS_EXCPECTED, 'Solidus encoding');
1166
1167
Jens Geyer7bb44a32014-02-07 22:24:37 +01001168 // Widechars should work too. Do they?
1169 // After writing, we ensure that we are able to read it back
1170 // We can't assume hex-encoding, since (nearly) any Unicode char is valid JSON
1171 stm.Position := 0;
1172 stm.Size := 0;
1173 prot := TJSONProtocolImpl.Create(
1174 TStreamTransportImpl.Create(
1175 nil, TThriftStreamAdapterDelphi.Create( stm, FALSE)));
Phongphan Phutthaa6509f72015-10-31 01:09:47 +07001176 prot.WriteString( G_CLEF_AND_CYRILLIC_TEXT);
Jens Geyer7bb44a32014-02-07 22:24:37 +01001177 stm.Position := 0;
1178 prot := TJSONProtocolImpl.Create(
1179 TStreamTransportImpl.Create(
1180 TThriftStreamAdapterDelphi.Create( stm, FALSE), nil));
Phongphan Phutthaa6509f72015-10-31 01:09:47 +07001181 Expect( prot.ReadString = G_CLEF_AND_CYRILLIC_TEXT, 'Writing JSON with chars > 8 bit');
Jens Geyer7bb44a32014-02-07 22:24:37 +01001182
1183 // Widechars should work with hex-encoding too. Do they?
1184 stm.Position := 0;
1185 stm.Size := 0;
Phongphan Phutthaa6509f72015-10-31 01:09:47 +07001186 stm.WriteString( G_CLEF_AND_CYRILLIC_JSON);
Jens Geyer7bb44a32014-02-07 22:24:37 +01001187 stm.Position := 0;
1188 prot := TJSONProtocolImpl.Create(
1189 TStreamTransportImpl.Create(
1190 TThriftStreamAdapterDelphi.Create( stm, FALSE), nil));
Phongphan Phutthaa6509f72015-10-31 01:09:47 +07001191 Expect( prot.ReadString = G_CLEF_AND_CYRILLIC_TEXT, 'Reading JSON with chars > 8 bit');
Jens Geyer7bb44a32014-02-07 22:24:37 +01001192
1193
Roger Meier3bef8c22012-10-06 06:58:00 +00001194 finally
1195 stm.Free;
1196 prot := nil; //-> Release
Jens Geyerf8a1b7a2014-09-24 00:26:46 +02001197 StartTestGroup( '', test_Unknown); // no more tests here
Roger Meier3bef8c22012-10-06 06:58:00 +00001198 end;
1199end;
1200
1201
Jens Geyerf8a1b7a2014-09-24 00:26:46 +02001202procedure TClientThread.StartTestGroup( const aGroup : string; const aTest : TTestGroup);
Roger Meier3bef8c22012-10-06 06:58:00 +00001203begin
1204 FTestGroup := aGroup;
Jens Geyerf8a1b7a2014-09-24 00:26:46 +02001205 FCurrentTest := aTest;
1206
1207 Include( FExecuted, aTest);
1208
Roger Meier3bef8c22012-10-06 06:58:00 +00001209 if FTestGroup <> '' then begin
1210 Console.WriteLine('');
1211 Console.WriteLine( aGroup+' tests');
1212 Console.WriteLine( StringOfChar('-',60));
1213 end;
1214end;
1215
1216
1217procedure TClientThread.Expect( aTestResult : Boolean; const aTestInfo : string);
1218begin
1219 if aTestResult then begin
1220 Inc(FSuccesses);
1221 Console.WriteLine( aTestInfo+': passed');
1222 end
1223 else begin
1224 FErrors.Add( FTestGroup+': '+aTestInfo);
Jens Geyerf8a1b7a2014-09-24 00:26:46 +02001225 Include( FFailed, FCurrentTest);
Roger Meier3bef8c22012-10-06 06:58:00 +00001226 Console.WriteLine( aTestInfo+': *** FAILED ***');
1227
1228 // We have a failed test!
1229 // -> issue DebugBreak ONLY if a debugger is attached,
1230 // -> unhandled DebugBreaks would cause Windows to terminate the app otherwise
Jens Geyer9f7f11e2016-04-14 21:37:11 +02001231 if IsDebuggerPresent
1232 then {$IFDEF CPUX64} DebugBreak {$ELSE} asm int 3 end {$ENDIF};
Roger Meier3bef8c22012-10-06 06:58:00 +00001233 end;
1234end;
1235
1236
1237procedure TClientThread.ReportResults;
1238var nTotal : Integer;
1239 sLine : string;
1240begin
1241 // prevent us from stupid DIV/0 errors
1242 nTotal := FSuccesses + FErrors.Count;
1243 if nTotal = 0 then begin
1244 Console.WriteLine('No results logged');
1245 Exit;
1246 end;
1247
1248 Console.WriteLine('');
1249 Console.WriteLine( StringOfChar('=',60));
1250 Console.WriteLine( IntToStr(nTotal)+' tests performed');
1251 Console.WriteLine( IntToStr(FSuccesses)+' tests succeeded ('+IntToStr(round(100*FSuccesses/nTotal))+'%)');
1252 Console.WriteLine( IntToStr(FErrors.Count)+' tests failed ('+IntToStr(round(100*FErrors.Count/nTotal))+'%)');
1253 Console.WriteLine( StringOfChar('=',60));
1254 if FErrors.Count > 0 then begin
1255 Console.WriteLine('FAILED TESTS:');
1256 for sLine in FErrors do Console.WriteLine('- '+sLine);
1257 Console.WriteLine( StringOfChar('=',60));
1258 InterlockedIncrement( ExitCode); // return <> 0 on errors
1259 end;
1260 Console.WriteLine('');
1261end;
1262
1263
Jens Geyerf8a1b7a2014-09-24 00:26:46 +02001264function TClientThread.CalculateExitCode : Byte;
1265var test : TTestGroup;
1266begin
1267 result := EXITCODE_SUCCESS;
1268 for test := Low(TTestGroup) to High(TTestGroup) do begin
1269 if (test in FFailed) or not (test in FExecuted)
1270 then result := result or MAP_FAILURES_TO_EXITCODE_BITS[test];
1271 end;
1272end;
1273
1274
Roger Meier3bef8c22012-10-06 06:58:00 +00001275constructor TClientThread.Create( const ATransport: ITransport; const AProtocol : IProtocol; ANumIteration: Integer);
1276begin
1277 inherited Create( True );
1278 FNumIteration := ANumIteration;
1279 FTransport := ATransport;
1280 FProtocol := AProtocol;
1281 FConsole := TThreadConsole.Create( Self );
Jens Geyerf8a1b7a2014-09-24 00:26:46 +02001282 FCurrentTest := test_Unknown;
Roger Meier3bef8c22012-10-06 06:58:00 +00001283
1284 // error list: keep correct order, allow for duplicates
1285 FErrors := TStringList.Create;
1286 FErrors.Sorted := FALSE;
1287 FErrors.Duplicates := dupAccept;
1288end;
1289
1290destructor TClientThread.Destroy;
1291begin
1292 FreeAndNil( FConsole);
1293 FreeAndNil( FErrors);
1294 inherited;
1295end;
1296
1297procedure TClientThread.Execute;
1298var
1299 i : Integer;
1300 proc : TThreadProcedure;
1301begin
1302 // perform all tests
1303 try
Jens Geyerf7904452017-07-26 15:02:12 +02001304 {$IFDEF Win64}
1305 UseInterlockedExchangeAdd64;
1306 {$ENDIF}
Jens Geyer7bb44a32014-02-07 22:24:37 +01001307 JSONProtocolReadWriteTest;
Jens Geyerf7904452017-07-26 15:02:12 +02001308
Roger Meier3bef8c22012-10-06 06:58:00 +00001309 for i := 0 to FNumIteration - 1 do
1310 begin
1311 ClientTest;
Roger Meier3bef8c22012-10-06 06:58:00 +00001312 end;
1313 except
1314 on e:Exception do Expect( FALSE, 'unexpected exception: "'+e.message+'"');
1315 end;
1316
1317 // report the outcome
1318 ReportResults;
Jens Geyerf8a1b7a2014-09-24 00:26:46 +02001319 SetReturnValue( CalculateExitCode);
Roger Meier3bef8c22012-10-06 06:58:00 +00001320
1321 // shutdown
1322 proc := procedure
1323 begin
1324 if FTransport <> nil then
1325 begin
1326 FTransport.Close;
1327 FTransport := nil;
1328 end;
1329 end;
1330
1331 Synchronize( proc );
1332end;
1333
Jens Geyerf8a1b7a2014-09-24 00:26:46 +02001334
Roger Meier3bef8c22012-10-06 06:58:00 +00001335{ TThreadConsole }
1336
1337constructor TThreadConsole.Create(AThread: TThread);
1338begin
Jens Geyer718f6ee2013-09-06 21:02:34 +02001339 inherited Create;
Roger Meier3bef8c22012-10-06 06:58:00 +00001340 FThread := AThread;
1341end;
1342
1343procedure TThreadConsole.Write(const S: string);
1344var
1345 proc : TThreadProcedure;
1346begin
1347 proc := procedure
1348 begin
1349 Console.Write( S );
1350 end;
1351 TThread.Synchronize( FThread, proc);
1352end;
1353
1354procedure TThreadConsole.WriteLine(const S: string);
1355var
1356 proc : TThreadProcedure;
1357begin
1358 proc := procedure
1359 begin
1360 Console.WriteLine( S );
1361 end;
1362 TThread.Synchronize( FThread, proc);
1363end;
1364
1365initialization
1366begin
1367 TTestClient.FNumIteration := 1;
1368 TTestClient.FNumThread := 1;
1369end;
1370
1371end.