blob: 2f77de8aefcc16582ed0e7859632913cc457b315 [file] [log] [blame]
Roger Meier3bef8c22012-10-06 06:58:00 +00001(*
2 * 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
22interface
23
24uses
25 Windows, SysUtils, Classes,
26 DateUtils,
27 Generics.Collections,
28 TestConstants,
29 Thrift,
30 Thrift.Protocol.JSON,
31 Thrift.Protocol,
32 Thrift.Transport.Pipes,
33 Thrift.Transport,
34 Thrift.Stream,
35 Thrift.Test,
36 Thrift.Collections,
37 Thrift.Console;
38
39type
40 TThreadConsole = class
41 private
42 FThread : TThread;
43 public
44 procedure Write( const S : string);
45 procedure WriteLine( const S : string);
46 constructor Create( AThread: TThread);
47 end;
48
49 TClientThread = class( TThread )
50 private
51 FTransport : ITransport;
52 FProtocol : IProtocol;
53 FNumIteration : Integer;
54 FConsole : TThreadConsole;
55
56 // test reporting, will be refactored out into separate class later
57 FTestGroup : string;
58 FSuccesses : Integer;
59 FErrors : TStringList;
60 procedure StartTestGroup( const aGroup : string);
61 procedure Expect( aTestResult : Boolean; const aTestInfo : string);
62 procedure ReportResults;
63
64 procedure ClientTest;
65 procedure JSONProtocolReadWriteTest;
66 protected
67 procedure Execute; override;
68 public
69 constructor Create( const ATransport: ITransport; const AProtocol : IProtocol; ANumIteration: Integer);
70 destructor Destroy; override;
71 end;
72
73 TTestClient = class
74 private
75 class var
76 FNumIteration : Integer;
77 FNumThread : Integer;
78 public
79 class procedure Execute( const args: array of string);
80 end;
81
82implementation
83
84function BoolToString( b : Boolean) : string;
85// overrides global BoolToString()
86begin
87 if b
88 then result := 'true'
89 else result := 'false';
90end;
91
92// not available in all versions, so make sure we have this one imported
93function IsDebuggerPresent: BOOL; stdcall; external KERNEL32 name 'IsDebuggerPresent';
94
95{ TTestClient }
96
97class procedure TTestClient.Execute(const args: array of string);
98var
99 i : Integer;
100 host : string;
101 port : Integer;
102 url : string;
103 bBuffered : Boolean;
104 bAnonPipe : Boolean;
105 bFramed : Boolean;
106 sPipeName : string;
107 hAnonRead, hAnonWrite : THandle;
108 s : string;
109 n : Integer;
110 threads : array of TThread;
111 dtStart : TDateTime;
112 test : Integer;
113 thread : TThread;
114 trans : ITransport;
115 prot : IProtocol;
116 streamtrans : IStreamTransport;
117 http : IHTTPClient;
118 protType, p : TKnownProtocol;
Jens Geyer0b20cc82013-03-07 20:47:01 +0100119const
120 // pipe timeouts to be used
121 DEBUG_TIMEOUT = 30 * 1000;
122 RELEASE_TIMEOUT = DEFAULT_THRIFT_PIPE_TIMEOUT;
123 TIMEOUT = RELEASE_TIMEOUT;
Roger Meier3bef8c22012-10-06 06:58:00 +0000124begin
125 bBuffered := False;;
126 bFramed := False;
127 protType := prot_Binary;
128 try
129 host := 'localhost';
130 port := 9090;
131 url := '';
132 sPipeName := '';
133 bAnonPipe := FALSE;
134 hAnonRead := INVALID_HANDLE_VALUE;
135 hAnonWrite := INVALID_HANDLE_VALUE;
136 i := 0;
137 try
138 while ( i < Length(args) ) do
139 begin
140
141 try
142 if ( args[i] = '-h') then
143 begin
144 Inc( i );
145 s := args[i];
146 n := Pos( ':', s);
147 if ( n > 0 ) then
148 begin
149 host := Copy( s, 1, n - 1);
150 port := StrToInt( Copy( s, n + 1, MaxInt));
151 end else
152 begin
153 host := s;
154 end;
155 end
156 else if (args[i] = '-u') then
157 begin
158 Inc( i );
159 url := args[i];
160 end
161 else if (args[i] = '-n') then
162 begin
163 Inc( i );
164 FNumIteration := StrToInt( args[i] );
165 end
166 else if (args[i] = '-b') then
167 begin
168 bBuffered := True;
169 Console.WriteLine('Buffered transport');
170 end
171 else if (args[i] = '-f' ) or ( args[i] = '-framed') then
172 begin
173 bFramed := True;
174 Console.WriteLine('Framed transport');
175 end
176 else if (args[i] = '-pipe') then // -pipe <name>
177 begin
178 Console.WriteLine('Named pipes transport');
179 Inc( i );
180 sPipeName := args[i];
181 end
182 else if (args[i] = '-anon') then // -anon <hReadPipe> <hWritePipe>
183 begin
Jens Geyerb64a7742013-01-23 20:58:47 +0100184 if Length(args) <= (i+2) then begin
185 Console.WriteLine('Invalid args: -anon <hRead> <hWrite> or use "server.exe -anon"');
186 Halt(1);
187 end;
Roger Meier3bef8c22012-10-06 06:58:00 +0000188 Console.WriteLine('Anonymous pipes transport');
189 Inc( i);
190 hAnonRead := THandle( StrToIntDef( args[i], Integer(INVALID_HANDLE_VALUE)));
191 Inc( i);
192 hAnonWrite := THandle( StrToIntDef( args[i], Integer(INVALID_HANDLE_VALUE)));
193 bAnonPipe := TRUE;
194 end
195 else if (args[i] = '-t') then
196 begin
197 Inc( i );
198 FNumThread := StrToInt( args[i] );
199 end
200 else if (args[i] = '-prot') then // -prot JSON|binary
201 begin
202 Inc( i );
203 s := args[i];
204 for p:= Low(TKnownProtocol) to High(TKnownProtocol) do begin
205 if SameText( s, KNOWN_PROTOCOLS[p]) then begin
206 protType := p;
207 Console.WriteLine('Using '+KNOWN_PROTOCOLS[protType]+' protocol');
208 Break;
209 end;
210 end;
211 end;
212 finally
213 Inc( i );
214 end;
215
216 end;
217
218 except
219 on E: Exception do
220 begin
221 Console.WriteLine( E.Message );
222 end;
223 end;
224
Roger Meier79655fb2012-10-20 20:59:41 +0000225 // In the anonymous pipes mode the client is launched by the test server
226 // -> behave nicely and allow for attaching a debugger to this process
227 if bAnonPipe and not IsDebuggerPresent
228 then MessageBox( 0, 'Attach Debugger and/or click OK to continue.',
229 'Thrift TestClient (Delphi)',
230 MB_OK or MB_ICONEXCLAMATION);
231
Roger Meier3bef8c22012-10-06 06:58:00 +0000232 SetLength( threads, FNumThread);
233 dtStart := Now;
234
235 for test := 0 to FNumThread - 1 do
236 begin
237 if url = '' then
238 begin
239 if sPipeName <> '' then begin
240 Console.WriteLine('Using named pipe ('+sPipeName+')');
Jens Geyer0b20cc82013-03-07 20:47:01 +0100241 streamtrans := TNamedPipeImpl.Create( sPipeName, 0, nil, TIMEOUT);
Roger Meier3bef8c22012-10-06 06:58:00 +0000242 end
243 else if bAnonPipe then begin
244 Console.WriteLine('Using anonymous pipes ('+IntToStr(Integer(hAnonRead))+' and '+IntToStr(Integer(hAnonWrite))+')');
245 streamtrans := TAnonymousPipeImpl.Create( hAnonRead, hAnonWrite, FALSE);
246 end
247 else begin
248 Console.WriteLine('Using sockets ('+host+' port '+IntToStr(port)+')');
249 streamtrans := TSocketImpl.Create( host, port );
250 end;
251
252 trans := streamtrans;
253
254 if bBuffered then begin
Jens Geyer0b20cc82013-03-07 20:47:01 +0100255 trans := TBufferedTransportImpl.Create( streamtrans, 32); // small buffer to test read()
Roger Meier3bef8c22012-10-06 06:58:00 +0000256 Console.WriteLine('Using buffered transport');
257 end;
258
259 if bFramed then begin
260 trans := TFramedTransportImpl.Create( trans );
261 Console.WriteLine('Using framed transport');
262 end;
263
264 end
265 else begin
266 Console.WriteLine('Using HTTPClient');
267 http := THTTPClientImpl.Create( url );
268 trans := http;
269 end;
270
271 // create protocol instance, default to BinaryProtocol
272 case protType of
Jens Geyer0b20cc82013-03-07 20:47:01 +0100273 prot_Binary: prot := TBinaryProtocolImpl.Create( trans, BINARY_STRICT_READ, BINARY_STRICT_WRITE);
Roger Meier3bef8c22012-10-06 06:58:00 +0000274 prot_JSON : prot := TJSONProtocolImpl.Create( trans);
275 else
276 ASSERT( FALSE); // unhandled case!
Jens Geyer0b20cc82013-03-07 20:47:01 +0100277 prot := TBinaryProtocolImpl.Create( trans, BINARY_STRICT_READ, BINARY_STRICT_WRITE); // use default
Roger Meier3bef8c22012-10-06 06:58:00 +0000278 end;
279
280 thread := TClientThread.Create( trans, prot, FNumIteration);
281 threads[test] := thread;
282{$WARN SYMBOL_DEPRECATED OFF}
283 thread.Resume;
284{$WARN SYMBOL_DEPRECATED ON}
285 end;
286
287 for test := 0 to FNumThread - 1 do
288 begin
289 threads[test].WaitFor;
290 end;
291
292 for test := 0 to FNumThread - 1 do
293 begin
294 threads[test].Free;
295 end;
296
297 Console.Write('Total time: ' + IntToStr( MilliSecondsBetween(Now, dtStart)));
298
299 except
300 on E: Exception do
301 begin
302 Console.WriteLine( E.Message + ' ST: ' + E.StackTrace );
303 end;
304 end;
305
306 Console.WriteLine('');
307 Console.WriteLine('done!');
308end;
309
310{ TClientThread }
311
312procedure TClientThread.ClientTest;
313var
314 client : TThriftTest.Iface;
315 s : string;
316 i8 : ShortInt;
317 i32 : Integer;
318 i64 : Int64;
319 dub : Double;
320 o : IXtruct;
321 o2 : IXtruct2;
322 i : IXtruct;
323 i2 : IXtruct2;
324 mapout : IThriftDictionary<Integer,Integer>;
325 mapin : IThriftDictionary<Integer,Integer>;
326 strmapout : IThriftDictionary<string,string>;
327 strmapin : IThriftDictionary<string,string>;
328 j : Integer;
329 first : Boolean;
330 key : Integer;
331 strkey : string;
332 listout : IThriftList<Integer>;
333 listin : IThriftList<Integer>;
334 setout : IHashSet<Integer>;
335 setin : IHashSet<Integer>;
336 ret : TNumberz;
337 uid : Int64;
338 mm : IThriftDictionary<Integer, IThriftDictionary<Integer, Integer>>;
339 pos : IThriftDictionary<Integer, Integer>;
340 neg : IThriftDictionary<Integer, Integer>;
341 m2 : IThriftDictionary<Integer, Integer>;
342 k2 : Integer;
343 insane : IInsanity;
344 truck : IXtruct;
345 whoa : IThriftDictionary<Int64, IThriftDictionary<TNumberz, IInsanity>>;
346 key64 : Int64;
347 val : IThriftDictionary<TNumberz, IInsanity>;
348 k2_2 : TNumberz;
349 k3 : TNumberz;
350 v2 : IInsanity;
351 userMap : IThriftDictionary<TNumberz, Int64>;
352 xtructs : IThriftList<IXtruct>;
353 x : IXtruct;
354 arg0 : ShortInt;
355 arg1 : Integer;
356 arg2 : Int64;
357 arg3 : IThriftDictionary<SmallInt, string>;
358 arg4 : TNumberz;
359 arg5 : Int64;
360 StartTick : Cardinal;
361 k : Integer;
362 proc : TThreadProcedure;
363 hello, goodbye : IXtruct;
364 crazy : IInsanity;
365 looney : IInsanity;
366 first_map : IThriftDictionary<TNumberz, IInsanity>;
367 second_map : IThriftDictionary<TNumberz, IInsanity>;
368
369begin
370 client := TThriftTest.TClient.Create( FProtocol);
371 FTransport.Open;
372
373 // in-depth exception test
374 // (1) do we get an exception at all?
375 // (2) do we get the right exception?
376 // (3) does the exception contain the expected data?
377 StartTestGroup( 'testException');
378 // case 1: exception type declared in IDL at the function call
379 try
380 client.testException('Xception');
381 Expect( FALSE, 'testException(''Xception''): must trow an exception');
382 except
383 on e:TXception do begin
384 Expect( e.ErrorCode = 1001, 'error code');
385 Expect( e.Message_ = 'Xception', 'error message');
386 Console.WriteLine( ' = ' + IntToStr(e.ErrorCode) + ', ' + e.Message_ );
387 end;
388 on e:TTransportException do Expect( FALSE, 'Unexpected : "'+e.ToString+'"');
389 on e:Exception do Expect( FALSE, 'Unexpected exception type "'+e.ClassName+'"');
390 end;
391
392 // case 2: exception type NOT declared in IDL at the function call
393 // this will close the connection
394 try
395 client.testException('TException');
396 Expect( FALSE, 'testException(''TException''): must trow an exception');
397 except
398 on e:TTransportException do begin
399 Console.WriteLine( e.ClassName+' = '+e.Message); // this is what we get
400 if FTransport.IsOpen then FTransport.Close;
401 FTransport.Open; // re-open connection, server has already closed
402 end;
403 on e:TException do Expect( FALSE, 'Unexpected exception type "'+e.ClassName+'"');
404 on e:Exception do Expect( FALSE, 'Unexpected exception type "'+e.ClassName+'"');
405 end;
406
407 // case 3: no exception
408 try
409 client.testException('something');
410 Expect( TRUE, 'testException(''something''): must not trow an exception');
411 except
412 on e:TTransportException do Expect( FALSE, 'Unexpected : "'+e.ToString+'"');
413 on e:Exception do Expect( FALSE, 'Unexpected exception "'+e.ClassName+'"');
414 end;
415
416
417 // simple things
418 StartTestGroup( 'simple Thrift calls');
419 client.testVoid();
420 Expect( TRUE, 'testVoid()'); // success := no exception
421
422 s := client.testString('Test');
423 Expect( s = 'Test', 'testString(''Test'') = "'+s+'"');
424
425 i8 := client.testByte(1);
426 Expect( i8 = 1, 'testByte(1) = ' + IntToStr( i8 ));
427
428 i32 := client.testI32(-1);
429 Expect( i32 = -1, 'testI32(-1) = ' + IntToStr(i32));
430
431 Console.WriteLine('testI64(-34359738368)');
432 i64 := client.testI64(-34359738368);
433 Expect( i64 = -34359738368, 'testI64(-34359738368) = ' + IntToStr( i64));
434
435 Console.WriteLine('testDouble(5.325098235)');
436 dub := client.testDouble(5.325098235);
437 Expect( abs(dub-5.325098235) < 1e-14, 'testDouble(5.325098235) = ' + FloatToStr( dub));
438
439 // structs
440 StartTestGroup( 'testStruct');
441 Console.WriteLine('testStruct({''Zero'', 1, -3, -5})');
442 o := TXtructImpl.Create;
443 o.String_thing := 'Zero';
444 o.Byte_thing := 1;
445 o.I32_thing := -3;
446 o.I64_thing := -5;
447 i := client.testStruct(o);
448 Expect( i.String_thing = 'Zero', 'i.String_thing = "'+i.String_thing+'"');
449 Expect( i.Byte_thing = 1, 'i.Byte_thing = '+IntToStr(i.Byte_thing));
450 Expect( i.I32_thing = -3, 'i.I32_thing = '+IntToStr(i.I32_thing));
451 Expect( i.I64_thing = -5, 'i.I64_thing = '+IntToStr(i.I64_thing));
452 Expect( i.__isset_String_thing, 'i.__isset_String_thing = '+BoolToString(i.__isset_String_thing));
453 Expect( i.__isset_Byte_thing, 'i.__isset_Byte_thing = '+BoolToString(i.__isset_Byte_thing));
454 Expect( i.__isset_I32_thing, 'i.__isset_I32_thing = '+BoolToString(i.__isset_I32_thing));
455 Expect( i.__isset_I64_thing, 'i.__isset_I64_thing = '+BoolToString(i.__isset_I64_thing));
456
457 // nested structs
458 StartTestGroup( 'testNest');
459 Console.WriteLine('testNest({1, {''Zero'', 1, -3, -5}, 5})');
460 o2 := TXtruct2Impl.Create;
461 o2.Byte_thing := 1;
462 o2.Struct_thing := o;
463 o2.I32_thing := 5;
464 i2 := client.testNest(o2);
465 i := i2.Struct_thing;
466 Expect( i.String_thing = 'Zero', 'i.String_thing = "'+i.String_thing+'"');
467 Expect( i.Byte_thing = 1, 'i.Byte_thing = '+IntToStr(i.Byte_thing));
468 Expect( i.I32_thing = -3, 'i.I32_thing = '+IntToStr(i.I32_thing));
469 Expect( i.I64_thing = -5, 'i.I64_thing = '+IntToStr(i.I64_thing));
470 Expect( i2.Byte_thing = 1, 'i2.Byte_thing = '+IntToStr(i2.Byte_thing));
471 Expect( i2.I32_thing = 5, 'i2.I32_thing = '+IntToStr(i2.I32_thing));
472 Expect( i.__isset_String_thing, 'i.__isset_String_thing = '+BoolToString(i.__isset_String_thing));
473 Expect( i.__isset_Byte_thing, 'i.__isset_Byte_thing = '+BoolToString(i.__isset_Byte_thing));
474 Expect( i.__isset_I32_thing, 'i.__isset_I32_thing = '+BoolToString(i.__isset_I32_thing));
475 Expect( i.__isset_I64_thing, 'i.__isset_I64_thing = '+BoolToString(i.__isset_I64_thing));
476 Expect( i2.__isset_Byte_thing, 'i2.__isset_Byte_thing');
477 Expect( i2.__isset_I32_thing, 'i2.__isset_I32_thing');
478
479 // map<type1,type2>: A map of strictly unique keys to values.
480 // Translates to an STL map, Java HashMap, PHP associative array, Python/Ruby dictionary, etc.
481 StartTestGroup( 'testMap');
482 mapout := TThriftDictionaryImpl<Integer,Integer>.Create;
483 for j := 0 to 4 do
484 begin
485 mapout.AddOrSetValue( j, j - 10);
486 end;
487 Console.Write('testMap({');
488 first := True;
489 for key in mapout.Keys do
490 begin
491 if first
492 then first := False
493 else Console.Write( ', ' );
494 Console.Write( IntToStr( key) + ' => ' + IntToStr( mapout[key]));
495 end;
496 Console.WriteLine('})');
497
498 mapin := client.testMap( mapout );
499 Expect( mapin.Count = mapout.Count, 'testMap: mapin.Count = mapout.Count');
500 for j := 0 to 4 do
501 begin
502 Expect( mapout.ContainsKey(j), 'testMap: mapout.ContainsKey('+IntToStr(j)+') = '+BoolToString(mapout.ContainsKey(j)));
503 end;
504 for key in mapin.Keys do
505 begin
506 Expect( mapin[key] = mapout[key], 'testMap: '+IntToStr(key) + ' => ' + IntToStr( mapin[key]));
507 Expect( mapin[key] = key - 10, 'testMap: mapin['+IntToStr(key)+'] = '+IntToStr( mapin[key]));
508 end;
509
510
511 // map<type1,type2>: A map of strictly unique keys to values.
512 // Translates to an STL map, Java HashMap, PHP associative array, Python/Ruby dictionary, etc.
513 StartTestGroup( 'testStringMap');
514 strmapout := TThriftDictionaryImpl<string,string>.Create;
515 for j := 0 to 4 do
516 begin
517 strmapout.AddOrSetValue( IntToStr(j), IntToStr(j - 10));
518 end;
519 Console.Write('testStringMap({');
520 first := True;
521 for strkey in strmapout.Keys do
522 begin
523 if first
524 then first := False
525 else Console.Write( ', ' );
526 Console.Write( strkey + ' => ' + strmapout[strkey]);
527 end;
528 Console.WriteLine('})');
529
530 strmapin := client.testStringMap( strmapout );
531 Expect( strmapin.Count = strmapout.Count, 'testStringMap: strmapin.Count = strmapout.Count');
532 for j := 0 to 4 do
533 begin
534 Expect( strmapout.ContainsKey(IntToStr(j)),
535 'testStringMap: strmapout.ContainsKey('+IntToStr(j)+') = '
536 + BoolToString(strmapout.ContainsKey(IntToStr(j))));
537 end;
538 for strkey in strmapin.Keys do
539 begin
540 Expect( strmapin[strkey] = strmapout[strkey], 'testStringMap: '+strkey + ' => ' + strmapin[strkey]);
541 Expect( strmapin[strkey] = IntToStr( StrToInt(strkey) - 10), 'testStringMap: strmapin['+strkey+'] = '+strmapin[strkey]);
542 end;
543
544
545 // set<type>: An unordered set of unique elements.
546 // Translates to an STL set, Java HashSet, set in Python, etc.
547 // Note: PHP does not support sets, so it is treated similar to a List
548 StartTestGroup( 'testSet');
549 setout := THashSetImpl<Integer>.Create;
550 for j := -2 to 2 do
551 begin
552 setout.Add( j );
553 end;
554 Console.Write('testSet({');
555 first := True;
556 for j in setout do
557 begin
558 if first
559 then first := False
560 else Console.Write(', ');
561 Console.Write(IntToStr( j));
562 end;
563 Console.WriteLine('})');
564
565 setin := client.testSet(setout);
566 Expect( setin.Count = setout.Count, 'testSet: setin.Count = setout.Count');
567 Expect( setin.Count = 5, 'testSet: setin.Count = '+IntToStr(setin.Count));
568 for j := -2 to 2 do // unordered, we can't rely on the order => test for known elements only
569 begin
570 Expect( setin.Contains(j), 'testSet: setin.Contains('+IntToStr(j)+') => '+BoolToString(setin.Contains(j)));
571 end;
572
573 // list<type>: An ordered list of elements.
574 // Translates to an STL vector, Java ArrayList, native arrays in scripting languages, etc.
575 StartTestGroup( 'testList');
576 listout := TThriftListImpl<Integer>.Create;
577 listout.Add( +1);
578 listout.Add( -2);
579 listout.Add( +3);
580 listout.Add( -4);
581 listout.Add( 0);
582 Console.Write('testList({');
583 first := True;
584 for j in listout do
585 begin
586 if first
587 then first := False
588 else Console.Write(', ');
589 Console.Write(IntToStr( j));
590 end;
591 Console.WriteLine('})');
592
593 listin := client.testList(listout);
594 Expect( listin.Count = listout.Count, 'testList: listin.Count = listout.Count');
595 Expect( listin.Count = 5, 'testList: listin.Count = '+IntToStr(listin.Count));
596 Expect( listin[0] = +1, 'listin[0] = '+IntToStr( listin[0]));
597 Expect( listin[1] = -2, 'listin[1] = '+IntToStr( listin[1]));
598 Expect( listin[2] = +3, 'listin[2] = '+IntToStr( listin[2]));
599 Expect( listin[3] = -4, 'listin[3] = '+IntToStr( listin[3]));
600 Expect( listin[4] = 0, 'listin[4] = '+IntToStr( listin[4]));
601
602 // enums
603 ret := client.testEnum(TNumberz.ONE);
604 Expect( ret = TNumberz.ONE, 'testEnum(ONE) = '+IntToStr(Ord(ret)));
605
606 ret := client.testEnum(TNumberz.TWO);
607 Expect( ret = TNumberz.TWO, 'testEnum(TWO) = '+IntToStr(Ord(ret)));
608
609 ret := client.testEnum(TNumberz.THREE);
610 Expect( ret = TNumberz.THREE, 'testEnum(THREE) = '+IntToStr(Ord(ret)));
611
612 ret := client.testEnum(TNumberz.FIVE);
613 Expect( ret = TNumberz.FIVE, 'testEnum(FIVE) = '+IntToStr(Ord(ret)));
614
615 ret := client.testEnum(TNumberz.EIGHT);
616 Expect( ret = TNumberz.EIGHT, 'testEnum(EIGHT) = '+IntToStr(Ord(ret)));
617
618
619 // typedef
620 uid := client.testTypedef(309858235082523);
621 Expect( uid = 309858235082523, 'testTypedef(309858235082523) = '+IntToStr(uid));
622
623
624 // maps of maps
625 StartTestGroup( 'testMapMap(1)');
626 mm := client.testMapMap(1);
627 Console.Write(' = {');
628 for key in mm.Keys do
629 begin
630 Console.Write( IntToStr( key) + ' => {');
631 m2 := mm[key];
632 for k2 in m2.Keys do
633 begin
634 Console.Write( IntToStr( k2) + ' => ' + IntToStr( m2[k2]) + ', ');
635 end;
636 Console.Write('}, ');
637 end;
638 Console.WriteLine('}');
639
640 // verify result data
641 Expect( mm.Count = 2, 'mm.Count = '+IntToStr(mm.Count));
642 pos := mm[4];
643 neg := mm[-4];
644 for j := 1 to 4 do
645 begin
646 Expect( pos[j] = j, 'pos[j] = '+IntToStr(pos[j]));
647 Expect( neg[-j] = -j, 'neg[-j] = '+IntToStr(neg[-j]));
648 end;
649
650
651
652 // insanity
653 StartTestGroup( 'testInsanity');
654 insane := TInsanityImpl.Create;
655 insane.UserMap := TThriftDictionaryImpl<TNumberz, Int64>.Create;
656 insane.UserMap.AddOrSetValue( TNumberz.FIVE, 5000);
657 truck := TXtructImpl.Create;
658 truck.String_thing := 'Truck';
659 truck.Byte_thing := 8;
660 truck.I32_thing := 8;
661 truck.I64_thing := 8;
662 insane.Xtructs := TThriftListImpl<IXtruct>.Create;
663 insane.Xtructs.Add( truck );
664 whoa := client.testInsanity( insane );
665 Console.Write(' = {');
666 for key64 in whoa.Keys do
667 begin
668 val := whoa[key64];
669 Console.Write( IntToStr( key64) + ' => {');
670 for k2_2 in val.Keys do
671 begin
672 v2 := val[k2_2];
673 Console.Write( IntToStr( Integer( k2_2)) + ' => {');
674 userMap := v2.UserMap;
675 Console.Write('{');
676 if userMap <> nil then
677 begin
678 for k3 in userMap.Keys do
679 begin
680 Console.Write( IntToStr( Integer( k3)) + ' => ' + IntToStr( userMap[k3]) + ', ');
681 end;
682 end else
683 begin
684 Console.Write('null');
685 end;
686 Console.Write('}, ');
687 xtructs := v2.Xtructs;
688 Console.Write('{');
689
690 if xtructs <> nil then
691 begin
692 for x in xtructs do
693 begin
694 Console.Write('{"' + x.String_thing + '", ' +
695 IntToStr( x.Byte_thing) + ', ' +
696 IntToStr( x.I32_thing) + ', ' +
697 IntToStr( x.I32_thing) + '}, ');
698 end;
699 end else
700 begin
701 Console.Write('null');
702 end;
703 Console.Write('}');
704 Console.Write('}, ');
705 end;
706 Console.Write('}, ');
707 end;
708 Console.WriteLine('}');
709
710 // verify result data
711 Expect( whoa.Count = 2, 'whoa.Count = '+IntToStr(whoa.Count));
712 //
713 first_map := whoa[1];
714 second_map := whoa[2];
715 Expect( first_map.Count = 2, 'first_map.Count = '+IntToStr(first_map.Count));
716 Expect( second_map.Count = 1, 'second_map.Count = '+IntToStr(second_map.Count));
717 //
718 looney := second_map[TNumberz.SIX];
719 Expect( Assigned(looney), 'Assigned(looney) = '+BoolToString(Assigned(looney)));
720 Expect( not looney.__isset_UserMap, 'looney.__isset_UserMap = '+BoolToString(looney.__isset_UserMap));
721 Expect( not looney.__isset_Xtructs, 'looney.__isset_Xtructs = '+BoolToString(looney.__isset_Xtructs));
722 //
723 for ret in [TNumberz.TWO, TNumberz.THREE] do begin
724 crazy := first_map[ret];
725 Console.WriteLine('first_map['+intToStr(Ord(ret))+']');
726
727 Expect( crazy.__isset_UserMap, 'crazy.__isset_UserMap = '+BoolToString(crazy.__isset_UserMap));
728 Expect( crazy.__isset_Xtructs, 'crazy.__isset_Xtructs = '+BoolToString(crazy.__isset_Xtructs));
729
730 Expect( crazy.UserMap.Count = 2, 'crazy.UserMap.Count = '+IntToStr(crazy.UserMap.Count));
731 Expect( crazy.UserMap[TNumberz.FIVE] = 5, 'crazy.UserMap[TNumberz.FIVE] = '+IntToStr(crazy.UserMap[TNumberz.FIVE]));
732 Expect( crazy.UserMap[TNumberz.EIGHT] = 8, 'crazy.UserMap[TNumberz.EIGHT] = '+IntToStr(crazy.UserMap[TNumberz.EIGHT]));
733
734 Expect( crazy.Xtructs.Count = 2, 'crazy.Xtructs.Count = '+IntToStr(crazy.Xtructs.Count));
735 goodbye := crazy.Xtructs[0]; // lists are ordered, so we are allowed to assume this order
736 hello := crazy.Xtructs[1];
737
738 Expect( goodbye.String_thing = 'Goodbye4', 'goodbye.String_thing = "'+goodbye.String_thing+'"');
739 Expect( goodbye.Byte_thing = 4, 'goodbye.Byte_thing = '+IntToStr(goodbye.Byte_thing));
740 Expect( goodbye.I32_thing = 4, 'goodbye.I32_thing = '+IntToStr(goodbye.I32_thing));
741 Expect( goodbye.I64_thing = 4, 'goodbye.I64_thing = '+IntToStr(goodbye.I64_thing));
742 Expect( goodbye.__isset_String_thing, 'goodbye.__isset_String_thing = '+BoolToString(goodbye.__isset_String_thing));
743 Expect( goodbye.__isset_Byte_thing, 'goodbye.__isset_Byte_thing = '+BoolToString(goodbye.__isset_Byte_thing));
744 Expect( goodbye.__isset_I32_thing, 'goodbye.__isset_I32_thing = '+BoolToString(goodbye.__isset_I32_thing));
745 Expect( goodbye.__isset_I64_thing, 'goodbye.__isset_I64_thing = '+BoolToString(goodbye.__isset_I64_thing));
746
747 Expect( hello.String_thing = 'Hello2', 'hello.String_thing = "'+hello.String_thing+'"');
748 Expect( hello.Byte_thing = 2, 'hello.Byte_thing = '+IntToStr(hello.Byte_thing));
749 Expect( hello.I32_thing = 2, 'hello.I32_thing = '+IntToStr(hello.I32_thing));
750 Expect( hello.I64_thing = 2, 'hello.I64_thing = '+IntToStr(hello.I64_thing));
751 Expect( hello.__isset_String_thing, 'hello.__isset_String_thing = '+BoolToString(hello.__isset_String_thing));
752 Expect( hello.__isset_Byte_thing, 'hello.__isset_Byte_thing = '+BoolToString(hello.__isset_Byte_thing));
753 Expect( hello.__isset_I32_thing, 'hello.__isset_I32_thing = '+BoolToString(hello.__isset_I32_thing));
754 Expect( hello.__isset_I64_thing, 'hello.__isset_I64_thing = '+BoolToString(hello.__isset_I64_thing));
755 end;
756
757
758 // multi args
759 StartTestGroup( 'testMulti');
760 arg0 := 1;
761 arg1 := 2;
762 arg2 := High(Int64);
763 arg3 := TThriftDictionaryImpl<SmallInt, string>.Create;
764 arg3.AddOrSetValue( 1, 'one');
765 arg4 := TNumberz.FIVE;
766 arg5 := 5000000;
767 Console.WriteLine('Test Multi(' + IntToStr( arg0) + ',' +
768 IntToStr( arg1) + ',' + IntToStr( arg2) + ',' +
769 arg3.ToString + ',' + IntToStr( Integer( arg4)) + ',' +
770 IntToStr( arg5) + ')');
771
772 i := client.testMulti( arg0, arg1, arg2, arg3, arg4, arg5);
773 Expect( i.String_thing = 'Hello2', 'testMulti: i.String_thing = "'+i.String_thing+'"');
774 Expect( i.Byte_thing = arg0, 'testMulti: i.Byte_thing = '+IntToStr(i.Byte_thing));
775 Expect( i.I32_thing = arg1, 'testMulti: i.I32_thing = '+IntToStr(i.I32_thing));
776 Expect( i.I64_thing = arg2, 'testMulti: i.I64_thing = '+IntToStr(i.I64_thing));
777 Expect( i.__isset_String_thing, 'testMulti: i.__isset_String_thing = '+BoolToString(i.__isset_String_thing));
778 Expect( i.__isset_Byte_thing, 'testMulti: i.__isset_Byte_thing = '+BoolToString(i.__isset_Byte_thing));
779 Expect( i.__isset_I32_thing, 'testMulti: i.__isset_I32_thing = '+BoolToString(i.__isset_I32_thing));
780 Expect( i.__isset_I64_thing, 'testMulti: i.__isset_I64_thing = '+BoolToString(i.__isset_I64_thing));
781
782 // multi exception
783 StartTestGroup( 'testMultiException(1)');
784 try
785 i := client.testMultiException( 'need more pizza', 'run out of beer');
786 Expect( i.String_thing = 'run out of beer', 'i.String_thing = "' +i.String_thing+ '"');
787 Expect( i.__isset_String_thing, 'i.__isset_String_thing = '+BoolToString(i.__isset_String_thing));
788 Expect( not i.__isset_Byte_thing, 'i.__isset_Byte_thing = '+BoolToString(i.__isset_Byte_thing));
789 Expect( not i.__isset_I32_thing, 'i.__isset_I32_thing = '+BoolToString(i.__isset_I32_thing));
790 Expect( not i.__isset_I64_thing, 'i.__isset_I64_thing = '+BoolToString(i.__isset_I64_thing));
791 except
792 on e:Exception do Expect( FALSE, 'Unexpected exception "'+e.ClassName+'"');
793 end;
794
795 StartTestGroup( 'testMultiException(Xception)');
796 try
797 i := client.testMultiException( 'Xception', 'second test');
798 Expect( FALSE, 'testMultiException(''Xception''): must trow an exception');
799 except
800 on x:TXception do begin
801 Expect( x.__isset_ErrorCode, 'x.__isset_ErrorCode = '+BoolToString(x.__isset_ErrorCode));
802 Expect( x.__isset_Message_, 'x.__isset_Message_ = '+BoolToString(x.__isset_Message_));
803 Expect( x.ErrorCode = 1001, 'x.ErrorCode = '+IntToStr(x.ErrorCode));
804 Expect( x.Message_ = 'This is an Xception', 'x.Message = "'+x.Message_+'"');
805 end;
806 on e:Exception do Expect( FALSE, 'Unexpected exception "'+e.ClassName+'"');
807 end;
808
809 StartTestGroup( 'testMultiException(Xception2)');
810 try
811 i := client.testMultiException( 'Xception2', 'third test');
812 Expect( FALSE, 'testMultiException(''Xception2''): must trow an exception');
813 except
814 on x:TXception2 do begin
815 Expect( x.__isset_ErrorCode, 'x.__isset_ErrorCode = '+BoolToString(x.__isset_ErrorCode));
816 Expect( x.__isset_Struct_thing, 'x.__isset_Struct_thing = '+BoolToString(x.__isset_Struct_thing));
817 Expect( x.ErrorCode = 2002, 'x.ErrorCode = '+IntToStr(x.ErrorCode));
818 Expect( x.Struct_thing.String_thing = 'This is an Xception2', 'x.Struct_thing.String_thing = "'+x.Struct_thing.String_thing+'"');
819 Expect( x.Struct_thing.__isset_String_thing, 'x.Struct_thing.__isset_String_thing = '+BoolToString(x.Struct_thing.__isset_String_thing));
820 Expect( not x.Struct_thing.__isset_Byte_thing, 'x.Struct_thing.__isset_Byte_thing = '+BoolToString(x.Struct_thing.__isset_Byte_thing));
821 Expect( not x.Struct_thing.__isset_I32_thing, 'x.Struct_thing.__isset_I32_thing = '+BoolToString(x.Struct_thing.__isset_I32_thing));
822 Expect( not x.Struct_thing.__isset_I64_thing, 'x.Struct_thing.__isset_I64_thing = '+BoolToString(x.Struct_thing.__isset_I64_thing));
823 end;
824 on e:Exception do Expect( FALSE, 'Unexpected exception "'+e.ClassName+'"');
825 end;
826
827
828 // oneway functions
829 StartTestGroup( 'Test Oneway(1)');
830 client.testOneway(1);
831 Expect( TRUE, 'Test Oneway(1)'); // success := no exception
832
833 // call time
834 StartTestGroup( 'Test Calltime()');
835 StartTick := GetTIckCount;
836 for k := 0 to 1000 - 1 do
837 begin
838 client.testVoid();
839 end;
840 Console.WriteLine(' = ' + FloatToStr( (GetTickCount - StartTick) / 1000 ) + ' ms a testVoid() call' );
841
842 // no more tests here
843 StartTestGroup( '');
844end;
845
846
847procedure TClientThread.JSONProtocolReadWriteTest;
848// Tests only then read/write procedures of the JSON protocol
849// All tests succeed, if we can read what we wrote before
850// Note that passing this test does not imply, that our JSON is really compatible to what
851// other clients or servers expect as the real JSON. This is beyond the scope of this test.
852var prot : IProtocol;
853 stm : TStringStream;
854 list : IList;
855 binary, binRead : TBytes;
856 i,iErr : Integer;
857const
858 TEST_SHORT = ShortInt( $FE);
859 TEST_SMALL = SmallInt( $FEDC);
860 TEST_LONG = LongInt( $FEDCBA98);
861 TEST_I64 = Int64( $FEDCBA9876543210);
862 TEST_DOUBLE = -1.234e-56;
863 DELTA_DOUBLE = TEST_DOUBLE * 1e-14;
864 TEST_STRING = 'abc-'#$00E4#$00f6#$00fc; // german umlauts (en-us: "funny chars")
865begin
866 stm := TStringStream.Create;
867 try
868 StartTestGroup( 'JsonProtocolTest'); // no more tests here
869
870 // prepare binary data
871 SetLength( binary, $100);
872 for i := Low(binary) to High(binary) do binary[i] := i;
873
874 // output setup
875 prot := TJSONProtocolImpl.Create(
876 TStreamTransportImpl.Create(
877 nil, TThriftStreamAdapterDelphi.Create( stm, FALSE)));
878
879 // write
880 prot.WriteListBegin( TListImpl.Create( TType.String_, 9));
881 prot.WriteBool( TRUE);
882 prot.WriteBool( FALSE);
883 prot.WriteByte( TEST_SHORT);
884 prot.WriteI16( TEST_SMALL);
885 prot.WriteI32( TEST_LONG);
886 prot.WriteI64( TEST_I64);
887 prot.WriteDouble( TEST_DOUBLE);
888 prot.WriteString( TEST_STRING);
889 prot.WriteBinary( binary);
890 prot.WriteListEnd;
891
892 // input setup
893 Expect( stm.Position = stm.Size, 'Stream position/length after write');
894 stm.Position := 0;
895 prot := TJSONProtocolImpl.Create(
896 TStreamTransportImpl.Create(
897 TThriftStreamAdapterDelphi.Create( stm, FALSE), nil));
898
899 // read and compare
900 list := prot.ReadListBegin;
901 Expect( list.ElementType = TType.String_, 'list element type');
902 Expect( list.Count = 9, 'list element count');
903 Expect( prot.ReadBool, 'WriteBool/ReadBool: TRUE');
904 Expect( not prot.ReadBool, 'WriteBool/ReadBool: FALSE');
905 Expect( prot.ReadByte = TEST_SHORT, 'WriteByte/ReadByte');
906 Expect( prot.ReadI16 = TEST_SMALL, 'WriteI16/ReadI16');
907 Expect( prot.ReadI32 = TEST_LONG, 'WriteI32/ReadI32');
908 Expect( prot.ReadI64 = TEST_I64, 'WriteI64/ReadI64');
909 Expect( abs(prot.ReadDouble-TEST_DOUBLE) < abs(DELTA_DOUBLE), 'WriteDouble/ReadDouble');
910 Expect( prot.ReadString = TEST_STRING, 'WriteString/ReadString');
911 binRead := prot.ReadBinary;
912 prot.ReadListEnd;
913
914 // test binary data
915 Expect( Length(binary) = Length(binRead), 'Binary data length check');
916 iErr := -1;
917 for i := Low(binary) to High(binary) do begin
918 if binary[i] <> binRead[i] then begin
919 iErr := i;
920 Break;
921 end;
922 end;
923 if iErr < 0
924 then Expect( TRUE, 'Binary data check ('+IntToStr(Length(binary))+' Bytes)')
925 else Expect( FALSE, 'Binary data check at offset '+IntToStr(iErr));
926
927 Expect( stm.Position = stm.Size, 'Stream position after read');
928
929 finally
930 stm.Free;
931 prot := nil; //-> Release
932 StartTestGroup( ''); // no more tests here
933 end;
934end;
935
936
937procedure TClientThread.StartTestGroup( const aGroup : string);
938begin
939 FTestGroup := aGroup;
940 if FTestGroup <> '' then begin
941 Console.WriteLine('');
942 Console.WriteLine( aGroup+' tests');
943 Console.WriteLine( StringOfChar('-',60));
944 end;
945end;
946
947
948procedure TClientThread.Expect( aTestResult : Boolean; const aTestInfo : string);
949begin
950 if aTestResult then begin
951 Inc(FSuccesses);
952 Console.WriteLine( aTestInfo+': passed');
953 end
954 else begin
955 FErrors.Add( FTestGroup+': '+aTestInfo);
956 Console.WriteLine( aTestInfo+': *** FAILED ***');
957
958 // We have a failed test!
959 // -> issue DebugBreak ONLY if a debugger is attached,
960 // -> unhandled DebugBreaks would cause Windows to terminate the app otherwise
961 if IsDebuggerPresent then asm int 3 end;
962 end;
963end;
964
965
966procedure TClientThread.ReportResults;
967var nTotal : Integer;
968 sLine : string;
969begin
970 // prevent us from stupid DIV/0 errors
971 nTotal := FSuccesses + FErrors.Count;
972 if nTotal = 0 then begin
973 Console.WriteLine('No results logged');
974 Exit;
975 end;
976
977 Console.WriteLine('');
978 Console.WriteLine( StringOfChar('=',60));
979 Console.WriteLine( IntToStr(nTotal)+' tests performed');
980 Console.WriteLine( IntToStr(FSuccesses)+' tests succeeded ('+IntToStr(round(100*FSuccesses/nTotal))+'%)');
981 Console.WriteLine( IntToStr(FErrors.Count)+' tests failed ('+IntToStr(round(100*FErrors.Count/nTotal))+'%)');
982 Console.WriteLine( StringOfChar('=',60));
983 if FErrors.Count > 0 then begin
984 Console.WriteLine('FAILED TESTS:');
985 for sLine in FErrors do Console.WriteLine('- '+sLine);
986 Console.WriteLine( StringOfChar('=',60));
987 InterlockedIncrement( ExitCode); // return <> 0 on errors
988 end;
989 Console.WriteLine('');
990end;
991
992
993constructor TClientThread.Create( const ATransport: ITransport; const AProtocol : IProtocol; ANumIteration: Integer);
994begin
995 inherited Create( True );
996 FNumIteration := ANumIteration;
997 FTransport := ATransport;
998 FProtocol := AProtocol;
999 FConsole := TThreadConsole.Create( Self );
1000
1001 // error list: keep correct order, allow for duplicates
1002 FErrors := TStringList.Create;
1003 FErrors.Sorted := FALSE;
1004 FErrors.Duplicates := dupAccept;
1005end;
1006
1007destructor TClientThread.Destroy;
1008begin
1009 FreeAndNil( FConsole);
1010 FreeAndNil( FErrors);
1011 inherited;
1012end;
1013
1014procedure TClientThread.Execute;
1015var
1016 i : Integer;
1017 proc : TThreadProcedure;
1018begin
1019 // perform all tests
1020 try
1021 for i := 0 to FNumIteration - 1 do
1022 begin
1023 ClientTest;
1024 JSONProtocolReadWriteTest;
1025 end;
1026 except
1027 on e:Exception do Expect( FALSE, 'unexpected exception: "'+e.message+'"');
1028 end;
1029
1030 // report the outcome
1031 ReportResults;
1032
1033 // shutdown
1034 proc := procedure
1035 begin
1036 if FTransport <> nil then
1037 begin
1038 FTransport.Close;
1039 FTransport := nil;
1040 end;
1041 end;
1042
1043 Synchronize( proc );
1044end;
1045
1046{ TThreadConsole }
1047
1048constructor TThreadConsole.Create(AThread: TThread);
1049begin
1050 FThread := AThread;
1051end;
1052
1053procedure TThreadConsole.Write(const S: string);
1054var
1055 proc : TThreadProcedure;
1056begin
1057 proc := procedure
1058 begin
1059 Console.Write( S );
1060 end;
1061 TThread.Synchronize( FThread, proc);
1062end;
1063
1064procedure TThreadConsole.WriteLine(const S: string);
1065var
1066 proc : TThreadProcedure;
1067begin
1068 proc := procedure
1069 begin
1070 Console.WriteLine( S );
1071 end;
1072 TThread.Synchronize( FThread, proc);
1073end;
1074
1075initialization
1076begin
1077 TTestClient.FNumIteration := 1;
1078 TTestClient.FNumThread := 1;
1079end;
1080
1081end.