]>
Commit | Line | Data |
---|---|---|
f67539c2 TL |
1 | (* |
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 | ||
20 | unit TestClient; | |
21 | ||
22 | {$I ../src/Thrift.Defines.inc} | |
23 | ||
24 | {.$DEFINE StressTest} // activate to stress-test the server with frequent connects/disconnects | |
25 | {.$DEFINE PerfTest} // activate the performance test | |
26 | {$DEFINE Exceptions} // activate the exceptions test (or disable while debugging) | |
27 | ||
28 | {$if CompilerVersion >= 28} | |
29 | {$DEFINE SupportsAsync} | |
30 | {$ifend} | |
31 | ||
32 | {$WARN SYMBOL_PLATFORM OFF} // Win32Check | |
33 | ||
34 | interface | |
35 | ||
36 | uses | |
37 | Windows, SysUtils, Classes, Math, ComObj, ActiveX, | |
38 | {$IFDEF SupportsAsync} System.Threading, {$ENDIF} | |
39 | DateUtils, | |
40 | Generics.Collections, | |
41 | TestConstants, | |
42 | ConsoleHelper, | |
43 | PerfTests, | |
44 | Thrift, | |
45 | Thrift.Protocol.Compact, | |
46 | Thrift.Protocol.JSON, | |
47 | Thrift.Protocol, | |
48 | Thrift.Transport.Pipes, | |
49 | Thrift.Transport.WinHTTP, | |
50 | Thrift.Transport.MsxmlHTTP, | |
51 | Thrift.Transport, | |
52 | Thrift.Stream, | |
53 | Thrift.Test, | |
54 | Thrift.WinHTTP, | |
55 | Thrift.Utils, | |
56 | Thrift.Collections; | |
57 | ||
58 | type | |
59 | TThreadConsole = class | |
60 | private | |
61 | FThread : TThread; | |
62 | public | |
63 | procedure Write( const S : string); | |
64 | procedure WriteLine( const S : string); | |
65 | constructor Create( AThread: TThread); | |
66 | end; | |
67 | ||
68 | TTestSetup = record | |
69 | protType : TKnownProtocol; | |
70 | endpoint : TEndpointTransport; | |
71 | layered : TLayeredTransports; | |
72 | useSSL : Boolean; // include where appropriate (TLayeredTransport?) | |
73 | host : string; | |
74 | port : Integer; | |
75 | sPipeName : string; | |
76 | hAnonRead, hAnonWrite : THandle; | |
77 | end; | |
78 | ||
79 | TClientThread = class( TThread ) | |
80 | private type | |
81 | TTestGroup = ( | |
82 | test_Unknown, | |
83 | test_BaseTypes, | |
84 | test_Structs, | |
85 | test_Containers, | |
86 | test_Exceptions | |
87 | // new values here | |
88 | ); | |
89 | TTestGroups = set of TTestGroup; | |
90 | ||
91 | TTestSize = ( | |
92 | Empty, // Edge case: the zero-length empty binary | |
93 | Normal, // Fairly small array of usual size (256 bytes) | |
94 | ByteArrayTest, // THRIFT-4454 Large writes/reads may cause range check errors in debug mode | |
95 | PipeWriteLimit, // THRIFT-4372 Pipe write operations across a network are limited to 65,535 bytes per write. | |
96 | TwentyMB // that's quite a bit of data | |
97 | ); | |
98 | ||
99 | private | |
100 | FSetup : TTestSetup; | |
101 | FTransport : ITransport; | |
102 | FProtocol : IProtocol; | |
103 | FNumIteration : Integer; | |
104 | FConsole : TThreadConsole; | |
105 | ||
106 | // test reporting, will be refactored out into separate class later | |
107 | FTestGroup : string; | |
108 | FCurrentTest : TTestGroup; | |
109 | FSuccesses : Integer; | |
110 | FErrors : TStringList; | |
111 | FFailed : TTestGroups; | |
112 | FExecuted : TTestGroups; | |
113 | procedure StartTestGroup( const aGroup : string; const aTest : TTestGroup); | |
114 | procedure Expect( aTestResult : Boolean; const aTestInfo : string); | |
115 | procedure ReportResults; | |
116 | function CalculateExitCode : Byte; | |
117 | ||
118 | procedure ClientTest; | |
119 | {$IFDEF SupportsAsync} | |
120 | procedure ClientAsyncTest; | |
121 | {$ENDIF} | |
122 | ||
123 | procedure InitializeProtocolTransportStack; | |
124 | procedure ShutdownProtocolTransportStack; | |
125 | function InitializeHttpTransport( const aTimeoutSetting : Integer) : IHTTPClient; | |
126 | ||
127 | procedure JSONProtocolReadWriteTest; | |
128 | function PrepareBinaryData( aRandomDist : Boolean; aSize : TTestSize) : TBytes; | |
129 | {$IFDEF StressTest} | |
130 | procedure StressTest(const client : TThriftTest.Iface); | |
131 | {$ENDIF} | |
132 | {$IFDEF Win64} | |
133 | procedure UseInterlockedExchangeAdd64; | |
134 | {$ENDIF} | |
135 | protected | |
136 | procedure Execute; override; | |
137 | public | |
138 | constructor Create( const aSetup : TTestSetup; const aNumIteration: Integer); | |
139 | destructor Destroy; override; | |
140 | end; | |
141 | ||
142 | TTestClient = class | |
143 | private | |
144 | class var | |
145 | FNumIteration : Integer; | |
146 | FNumThread : Integer; | |
147 | ||
148 | class procedure PrintCmdLineHelp; | |
149 | class procedure InvalidArgs; | |
150 | public | |
151 | class function Execute( const args: array of string) : Byte; | |
152 | end; | |
153 | ||
154 | ||
155 | implementation | |
156 | ||
157 | const | |
158 | EXITCODE_SUCCESS = $00; // no errors bits set | |
159 | // | |
160 | EXITCODE_FAILBIT_BASETYPES = $01; | |
161 | EXITCODE_FAILBIT_STRUCTS = $02; | |
162 | EXITCODE_FAILBIT_CONTAINERS = $04; | |
163 | EXITCODE_FAILBIT_EXCEPTIONS = $08; | |
164 | ||
165 | MAP_FAILURES_TO_EXITCODE_BITS : array[TClientThread.TTestGroup] of Byte = ( | |
166 | EXITCODE_SUCCESS, // no bits here | |
167 | EXITCODE_FAILBIT_BASETYPES, | |
168 | EXITCODE_FAILBIT_STRUCTS, | |
169 | EXITCODE_FAILBIT_CONTAINERS, | |
170 | EXITCODE_FAILBIT_EXCEPTIONS | |
171 | ); | |
172 | ||
173 | ||
174 | ||
175 | function BoolToString( b : Boolean) : string; | |
176 | // overrides global BoolToString() | |
177 | begin | |
178 | if b | |
179 | then result := 'true' | |
180 | else result := 'false'; | |
181 | end; | |
182 | ||
183 | // not available in all versions, so make sure we have this one imported | |
184 | function IsDebuggerPresent: BOOL; stdcall; external KERNEL32 name 'IsDebuggerPresent'; | |
185 | ||
186 | { TTestClient } | |
187 | ||
188 | class procedure TTestClient.PrintCmdLineHelp; | |
189 | const HELPTEXT = ' [options]'#10 | |
190 | + #10 | |
191 | + 'Allowed options:'#10 | |
192 | + ' -h [ --help ] produce help message'#10 | |
193 | + ' --host arg (=localhost) Host to connect'#10 | |
194 | + ' --port arg (=9090) Port number to connect'#10 | |
195 | + ' --domain-socket arg Domain Socket (e.g. /tmp/ThriftTest.thrift),'#10 | |
196 | + ' instead of host and port'#10 | |
197 | + ' --named-pipe arg Windows Named Pipe (e.g. MyThriftPipe)'#10 | |
198 | + ' --anon-pipes hRead hWrite Windows Anonymous Pipes pair (handles)'#10 | |
199 | + ' --transport arg (=sockets) Transport: buffered, framed, http, winhttp'#10 | |
200 | + ' --protocol arg (=binary) Protocol: binary, compact, json'#10 | |
201 | + ' --ssl Encrypted Transport using SSL'#10 | |
202 | + ' -n [ --testloops ] arg (=1) Number of Tests'#10 | |
203 | + ' -t [ --threads ] arg (=1) Number of Test threads'#10 | |
204 | + ' --performance Run the built-in performance test (no other arguments)'#10 | |
205 | ; | |
206 | begin | |
207 | Writeln( ChangeFileExt(ExtractFileName(ParamStr(0)),'') + HELPTEXT); | |
208 | end; | |
209 | ||
210 | class procedure TTestClient.InvalidArgs; | |
211 | begin | |
212 | Console.WriteLine( 'Invalid args.'); | |
213 | Console.WriteLine( ChangeFileExt(ExtractFileName(ParamStr(0)),'') + ' -h for more information'); | |
214 | Abort; | |
215 | end; | |
216 | ||
217 | class function TTestClient.Execute(const args: array of string) : Byte; | |
218 | var | |
219 | i : Integer; | |
220 | threadExitCode : Byte; | |
221 | s : string; | |
222 | threads : array of TThread; | |
223 | dtStart : TDateTime; | |
224 | test : Integer; | |
225 | thread : TThread; | |
226 | setup : TTestSetup; | |
227 | begin | |
228 | // init record | |
229 | with setup do begin | |
230 | protType := prot_Binary; | |
231 | endpoint := trns_Sockets; | |
232 | layered := []; | |
233 | useSSL := FALSE; | |
234 | host := 'localhost'; | |
235 | port := 9090; | |
236 | sPipeName := ''; | |
237 | hAnonRead := INVALID_HANDLE_VALUE; | |
238 | hAnonWrite := INVALID_HANDLE_VALUE; | |
239 | end; | |
240 | ||
241 | try | |
242 | i := 0; | |
243 | while ( i < Length(args) ) do begin | |
244 | s := args[i]; | |
245 | Inc( i); | |
246 | ||
247 | if (s = '-h') or (s = '--help') then begin | |
248 | // -h [ --help ] produce help message | |
249 | PrintCmdLineHelp; | |
250 | result := $FF; // all tests failed | |
251 | Exit; | |
252 | end | |
253 | else if s = '--host' then begin | |
254 | // --host arg (=localhost) Host to connect | |
255 | setup.host := args[i]; | |
256 | Inc( i); | |
257 | end | |
258 | else if s = '--port' then begin | |
259 | // --port arg (=9090) Port number to connect | |
260 | s := args[i]; | |
261 | Inc( i); | |
262 | setup.port := StrToIntDef(s,0); | |
263 | if setup.port <= 0 then InvalidArgs; | |
264 | end | |
265 | else if s = '--domain-socket' then begin | |
266 | // --domain-socket arg Domain Socket (e.g. /tmp/ThriftTest.thrift), instead of host and port | |
267 | raise Exception.Create('domain-socket not supported'); | |
268 | end | |
269 | else if s = '--named-pipe' then begin | |
270 | // --named-pipe arg Windows Named Pipe (e.g. MyThriftPipe) | |
271 | setup.endpoint := trns_NamedPipes; | |
272 | setup.sPipeName := args[i]; | |
273 | Inc( i); | |
274 | Console.WriteLine('Using named pipe ('+setup.sPipeName+')'); | |
275 | end | |
276 | else if s = '--anon-pipes' then begin | |
277 | // --anon-pipes hRead hWrite Windows Anonymous Pipes pair (handles) | |
278 | setup.endpoint := trns_AnonPipes; | |
279 | setup.hAnonRead := THandle( StrToIntDef( args[i], Integer(INVALID_HANDLE_VALUE))); | |
280 | Inc( i); | |
281 | setup.hAnonWrite := THandle( StrToIntDef( args[i], Integer(INVALID_HANDLE_VALUE))); | |
282 | Inc( i); | |
283 | Console.WriteLine('Using anonymous pipes ('+IntToStr(Integer(setup.hAnonRead))+' and '+IntToStr(Integer(setup.hAnonWrite))+')'); | |
284 | end | |
285 | else if s = '--transport' then begin | |
286 | // --transport arg (=sockets) Transport: buffered, framed, http, winhttp, evhttp | |
287 | s := args[i]; | |
288 | Inc( i); | |
289 | ||
290 | if s = 'buffered' then Include( setup.layered, trns_Buffered) | |
291 | else if s = 'framed' then Include( setup.layered, trns_Framed) | |
292 | else if s = 'http' then setup.endpoint := trns_MsXmlHttp | |
293 | else if s = 'winhttp' then setup.endpoint := trns_WinHttp | |
294 | else if s = 'evhttp' then setup.endpoint := trns_EvHttp // recognized, but not supported | |
295 | else InvalidArgs; | |
296 | end | |
297 | else if s = '--protocol' then begin | |
298 | // --protocol arg (=binary) Protocol: binary, compact, json | |
299 | s := args[i]; | |
300 | Inc( i); | |
301 | ||
302 | if s = 'binary' then setup.protType := prot_Binary | |
303 | else if s = 'compact' then setup.protType := prot_Compact | |
304 | else if s = 'json' then setup.protType := prot_JSON | |
305 | else InvalidArgs; | |
306 | end | |
307 | else if s = '--ssl' then begin | |
308 | // --ssl Encrypted Transport using SSL | |
309 | setup.useSSL := TRUE; | |
310 | ||
311 | end | |
312 | else if (s = '-n') or (s = '--testloops') then begin | |
313 | // -n [ --testloops ] arg (=1) Number of Tests | |
314 | FNumIteration := StrToIntDef( args[i], 0); | |
315 | Inc( i); | |
316 | if FNumIteration <= 0 | |
317 | then InvalidArgs; | |
318 | ||
319 | end | |
320 | else if (s = '-t') or (s = '--threads') then begin | |
321 | // -t [ --threads ] arg (=1) Number of Test threads | |
322 | FNumThread := StrToIntDef( args[i], 0); | |
323 | Inc( i); | |
324 | if FNumThread <= 0 | |
325 | then InvalidArgs; | |
326 | end | |
327 | else if (s = '--performance') then begin | |
328 | result := TPerformanceTests.Execute; | |
329 | Exit; | |
330 | end | |
331 | else begin | |
332 | InvalidArgs; | |
333 | end; | |
334 | end; | |
335 | ||
336 | ||
337 | // In the anonymous pipes mode the client is launched by the test server | |
338 | // -> behave nicely and allow for attaching a debugger to this process | |
339 | if (setup.endpoint = trns_AnonPipes) and not IsDebuggerPresent | |
340 | then MessageBox( 0, 'Attach Debugger and/or click OK to continue.', | |
341 | 'Thrift TestClient (Delphi)', | |
342 | MB_OK or MB_ICONEXCLAMATION); | |
343 | ||
344 | SetLength( threads, FNumThread); | |
345 | dtStart := Now; | |
346 | ||
347 | // layered transports are not really meant to be stacked upon each other | |
348 | if (trns_Framed in setup.layered) then begin | |
349 | Console.WriteLine('Using framed transport'); | |
350 | end | |
351 | else if (trns_Buffered in setup.layered) then begin | |
352 | Console.WriteLine('Using buffered transport'); | |
353 | end; | |
354 | ||
355 | Console.WriteLine(THRIFT_PROTOCOLS[setup.protType]+' protocol'); | |
356 | ||
357 | for test := 0 to FNumThread - 1 do begin | |
358 | thread := TClientThread.Create( setup, FNumIteration); | |
359 | threads[test] := thread; | |
360 | thread.Start; | |
361 | end; | |
362 | ||
363 | result := 0; | |
364 | for test := 0 to FNumThread - 1 do begin | |
365 | threadExitCode := threads[test].WaitFor; | |
366 | result := result or threadExitCode; | |
367 | threads[test].Free; | |
368 | threads[test] := nil; | |
369 | end; | |
370 | ||
371 | Console.Write('Total time: ' + IntToStr( MilliSecondsBetween(Now, dtStart))); | |
372 | ||
373 | except | |
374 | on E: EAbort do raise; | |
375 | on E: Exception do begin | |
376 | Console.WriteLine( E.Message + #10 + E.StackTrace); | |
377 | raise; | |
378 | end; | |
379 | end; | |
380 | ||
381 | Console.WriteLine(''); | |
382 | Console.WriteLine('done!'); | |
383 | end; | |
384 | ||
385 | { TClientThread } | |
386 | ||
387 | procedure TClientThread.ClientTest; | |
388 | var | |
389 | client : TThriftTest.Iface; | |
390 | s : string; | |
391 | i8 : ShortInt; | |
392 | i32 : Integer; | |
393 | i64 : Int64; | |
394 | binOut,binIn : TBytes; | |
395 | dub : Double; | |
396 | o : IXtruct; | |
397 | o2 : IXtruct2; | |
398 | i : IXtruct; | |
399 | i2 : IXtruct2; | |
400 | mapout : IThriftDictionary<Integer,Integer>; | |
401 | mapin : IThriftDictionary<Integer,Integer>; | |
402 | strmapout : IThriftDictionary<string,string>; | |
403 | strmapin : IThriftDictionary<string,string>; | |
404 | j : Integer; | |
405 | first : Boolean; | |
406 | key : Integer; | |
407 | strkey : string; | |
408 | listout : IThriftList<Integer>; | |
409 | listin : IThriftList<Integer>; | |
410 | setout : IHashSet<Integer>; | |
411 | setin : IHashSet<Integer>; | |
412 | ret : TNumberz; | |
413 | uid : Int64; | |
414 | mm : IThriftDictionary<Integer, IThriftDictionary<Integer, Integer>>; | |
415 | pos : IThriftDictionary<Integer, Integer>; | |
416 | neg : IThriftDictionary<Integer, Integer>; | |
417 | m2 : IThriftDictionary<Integer, Integer>; | |
418 | k2 : Integer; | |
419 | insane : IInsanity; | |
420 | truck : IXtruct; | |
421 | whoa : IThriftDictionary<Int64, IThriftDictionary<TNumberz, IInsanity>>; | |
422 | key64 : Int64; | |
423 | val : IThriftDictionary<TNumberz, IInsanity>; | |
424 | k2_2 : TNumberz; | |
425 | k3 : TNumberz; | |
426 | v2 : IInsanity; | |
427 | userMap : IThriftDictionary<TNumberz, Int64>; | |
428 | xtructs : IThriftList<IXtruct>; | |
429 | x : IXtruct; | |
430 | arg0 : ShortInt; | |
431 | arg1 : Integer; | |
432 | arg2 : Int64; | |
433 | arg3 : IThriftDictionary<SmallInt, string>; | |
434 | arg4 : TNumberz; | |
435 | arg5 : Int64; | |
436 | {$IFDEF PerfTest} | |
437 | StartTick : Cardinal; | |
438 | k : Integer; | |
439 | {$ENDIF} | |
440 | hello, goodbye : IXtruct; | |
441 | crazy : IInsanity; | |
442 | looney : IInsanity; | |
443 | first_map : IThriftDictionary<TNumberz, IInsanity>; | |
444 | second_map : IThriftDictionary<TNumberz, IInsanity>; | |
445 | pair : TPair<TNumberz, TUserId>; | |
446 | testsize : TTestSize; | |
447 | begin | |
448 | client := TThriftTest.TClient.Create( FProtocol); | |
449 | FTransport.Open; | |
450 | ||
451 | {$IFDEF StressTest} | |
452 | StressTest( client); | |
453 | {$ENDIF StressTest} | |
454 | ||
455 | {$IFDEF Exceptions} | |
456 | // in-depth exception test | |
457 | // (1) do we get an exception at all? | |
458 | // (2) do we get the right exception? | |
459 | // (3) does the exception contain the expected data? | |
460 | StartTestGroup( 'testException', test_Exceptions); | |
461 | // case 1: exception type declared in IDL at the function call | |
462 | try | |
463 | client.testException('Xception'); | |
464 | Expect( FALSE, 'testException(''Xception''): must trow an exception'); | |
465 | except | |
466 | on e:TXception do begin | |
467 | Expect( e.ErrorCode = 1001, 'error code'); | |
468 | Expect( e.Message_ = 'Xception', 'error message'); | |
469 | Console.WriteLine( ' = ' + IntToStr(e.ErrorCode) + ', ' + e.Message_ ); | |
470 | end; | |
471 | on e:TTransportException do Expect( FALSE, 'Unexpected : "'+e.ToString+'"'); | |
472 | on e:Exception do Expect( FALSE, 'Unexpected exception "'+e.ClassName+'": '+e.Message); | |
473 | end; | |
474 | ||
475 | // case 2: exception type NOT declared in IDL at the function call | |
476 | // this will close the connection | |
477 | try | |
478 | client.testException('TException'); | |
479 | Expect( FALSE, 'testException(''TException''): must trow an exception'); | |
480 | except | |
481 | on e:TTransportException do begin | |
482 | Console.WriteLine( e.ClassName+' = '+e.Message); // this is what we get | |
483 | end; | |
484 | on e:TApplicationException do begin | |
485 | Console.WriteLine( e.ClassName+' = '+e.Message); // this is what we get | |
486 | end; | |
487 | on e:TException do Expect( FALSE, 'Unexpected exception "'+e.ClassName+'": '+e.Message); | |
488 | on e:Exception do Expect( FALSE, 'Unexpected exception "'+e.ClassName+'": '+e.Message); | |
489 | end; | |
490 | ||
491 | ||
492 | if FTransport.IsOpen then FTransport.Close; | |
493 | FTransport.Open; // re-open connection, server has already closed | |
494 | ||
495 | ||
496 | // case 3: no exception | |
497 | try | |
498 | client.testException('something'); | |
499 | Expect( TRUE, 'testException(''something''): must not trow an exception'); | |
500 | except | |
501 | on e:TTransportException do Expect( FALSE, 'Unexpected : "'+e.ToString+'"'); | |
502 | on e:Exception do Expect( FALSE, 'Unexpected exception "'+e.ClassName+'": '+e.Message); | |
503 | end; | |
504 | {$ENDIF Exceptions} | |
505 | ||
506 | ||
507 | // simple things | |
508 | StartTestGroup( 'simple Thrift calls', test_BaseTypes); | |
509 | client.testVoid(); | |
510 | Expect( TRUE, 'testVoid()'); // success := no exception | |
511 | ||
512 | s := BoolToString( client.testBool(TRUE)); | |
513 | Expect( s = BoolToString(TRUE), 'testBool(TRUE) = '+s); | |
514 | s := BoolToString( client.testBool(FALSE)); | |
515 | Expect( s = BoolToString(FALSE), 'testBool(FALSE) = '+s); | |
516 | ||
517 | s := client.testString('Test'); | |
518 | Expect( s = 'Test', 'testString(''Test'') = "'+s+'"'); | |
519 | ||
520 | s := client.testString(''); // empty string | |
521 | Expect( s = '', 'testString('''') = "'+s+'"'); | |
522 | ||
523 | s := client.testString(HUGE_TEST_STRING); | |
524 | Expect( length(s) = length(HUGE_TEST_STRING), | |
525 | 'testString( length(HUGE_TEST_STRING) = '+IntToStr(Length(HUGE_TEST_STRING))+') ' | |
526 | +'=> length(result) = '+IntToStr(Length(s))); | |
527 | ||
528 | i8 := client.testByte(1); | |
529 | Expect( i8 = 1, 'testByte(1) = ' + IntToStr( i8 )); | |
530 | ||
531 | i32 := client.testI32(-1); | |
532 | Expect( i32 = -1, 'testI32(-1) = ' + IntToStr(i32)); | |
533 | ||
534 | Console.WriteLine('testI64(-34359738368)'); | |
535 | i64 := client.testI64(-34359738368); | |
536 | Expect( i64 = -34359738368, 'testI64(-34359738368) = ' + IntToStr( i64)); | |
537 | ||
538 | // random binary small | |
539 | for testsize := Low(TTestSize) to High(TTestSize) do begin | |
540 | binOut := PrepareBinaryData( TRUE, testsize); | |
541 | Console.WriteLine('testBinary('+IntToStr(Length(binOut))+' bytes)'); | |
542 | try | |
543 | binIn := client.testBinary(binOut); | |
544 | Expect( Length(binOut) = Length(binIn), 'testBinary('+IntToStr(Length(binOut))+' bytes): '+IntToStr(Length(binIn))+' bytes received'); | |
545 | i32 := Min( Length(binOut), Length(binIn)); | |
546 | Expect( CompareMem( binOut, binIn, i32), 'testBinary('+IntToStr(Length(binOut))+' bytes): validating received data'); | |
547 | except | |
548 | on e:TApplicationException do Console.WriteLine('testBinary(): '+e.Message); | |
549 | on e:Exception do Expect( FALSE, 'testBinary(): Unexpected exception "'+e.ClassName+'": '+e.Message); | |
550 | end; | |
551 | end; | |
552 | ||
553 | Console.WriteLine('testDouble(5.325098235)'); | |
554 | dub := client.testDouble(5.325098235); | |
555 | Expect( abs(dub-5.325098235) < 1e-14, 'testDouble(5.325098235) = ' + FloatToStr( dub)); | |
556 | ||
557 | // structs | |
558 | StartTestGroup( 'testStruct', test_Structs); | |
559 | Console.WriteLine('testStruct({''Zero'', 1, -3, -5})'); | |
560 | o := TXtructImpl.Create; | |
561 | o.String_thing := 'Zero'; | |
562 | o.Byte_thing := 1; | |
563 | o.I32_thing := -3; | |
564 | o.I64_thing := -5; | |
565 | i := client.testStruct(o); | |
566 | Expect( i.String_thing = 'Zero', 'i.String_thing = "'+i.String_thing+'"'); | |
567 | Expect( i.Byte_thing = 1, 'i.Byte_thing = '+IntToStr(i.Byte_thing)); | |
568 | Expect( i.I32_thing = -3, 'i.I32_thing = '+IntToStr(i.I32_thing)); | |
569 | Expect( i.I64_thing = -5, 'i.I64_thing = '+IntToStr(i.I64_thing)); | |
570 | Expect( i.__isset_String_thing, 'i.__isset_String_thing = '+BoolToString(i.__isset_String_thing)); | |
571 | Expect( i.__isset_Byte_thing, 'i.__isset_Byte_thing = '+BoolToString(i.__isset_Byte_thing)); | |
572 | Expect( i.__isset_I32_thing, 'i.__isset_I32_thing = '+BoolToString(i.__isset_I32_thing)); | |
573 | Expect( i.__isset_I64_thing, 'i.__isset_I64_thing = '+BoolToString(i.__isset_I64_thing)); | |
574 | ||
575 | // nested structs | |
576 | StartTestGroup( 'testNest', test_Structs); | |
577 | Console.WriteLine('testNest({1, {''Zero'', 1, -3, -5}, 5})'); | |
578 | o2 := TXtruct2Impl.Create; | |
579 | o2.Byte_thing := 1; | |
580 | o2.Struct_thing := o; | |
581 | o2.I32_thing := 5; | |
582 | i2 := client.testNest(o2); | |
583 | i := i2.Struct_thing; | |
584 | Expect( i.String_thing = 'Zero', 'i.String_thing = "'+i.String_thing+'"'); | |
585 | Expect( i.Byte_thing = 1, 'i.Byte_thing = '+IntToStr(i.Byte_thing)); | |
586 | Expect( i.I32_thing = -3, 'i.I32_thing = '+IntToStr(i.I32_thing)); | |
587 | Expect( i.I64_thing = -5, 'i.I64_thing = '+IntToStr(i.I64_thing)); | |
588 | Expect( i2.Byte_thing = 1, 'i2.Byte_thing = '+IntToStr(i2.Byte_thing)); | |
589 | Expect( i2.I32_thing = 5, 'i2.I32_thing = '+IntToStr(i2.I32_thing)); | |
590 | Expect( i.__isset_String_thing, 'i.__isset_String_thing = '+BoolToString(i.__isset_String_thing)); | |
591 | Expect( i.__isset_Byte_thing, 'i.__isset_Byte_thing = '+BoolToString(i.__isset_Byte_thing)); | |
592 | Expect( i.__isset_I32_thing, 'i.__isset_I32_thing = '+BoolToString(i.__isset_I32_thing)); | |
593 | Expect( i.__isset_I64_thing, 'i.__isset_I64_thing = '+BoolToString(i.__isset_I64_thing)); | |
594 | Expect( i2.__isset_Byte_thing, 'i2.__isset_Byte_thing'); | |
595 | Expect( i2.__isset_I32_thing, 'i2.__isset_I32_thing'); | |
596 | ||
597 | // map<type1,type2>: A map of strictly unique keys to values. | |
598 | // Translates to an STL map, Java HashMap, PHP associative array, Python/Ruby dictionary, etc. | |
599 | StartTestGroup( 'testMap', test_Containers); | |
600 | mapout := TThriftDictionaryImpl<Integer,Integer>.Create; | |
601 | for j := 0 to 4 do | |
602 | begin | |
603 | mapout.AddOrSetValue( j, j - 10); | |
604 | end; | |
605 | Console.Write('testMap({'); | |
606 | first := True; | |
607 | for key in mapout.Keys do | |
608 | begin | |
609 | if first | |
610 | then first := False | |
611 | else Console.Write( ', ' ); | |
612 | Console.Write( IntToStr( key) + ' => ' + IntToStr( mapout[key])); | |
613 | end; | |
614 | Console.WriteLine('})'); | |
615 | ||
616 | mapin := client.testMap( mapout ); | |
617 | Expect( mapin.Count = mapout.Count, 'testMap: mapin.Count = mapout.Count'); | |
618 | for j := 0 to 4 do | |
619 | begin | |
620 | Expect( mapout.ContainsKey(j), 'testMap: mapout.ContainsKey('+IntToStr(j)+') = '+BoolToString(mapout.ContainsKey(j))); | |
621 | end; | |
622 | for key in mapin.Keys do | |
623 | begin | |
624 | Expect( mapin[key] = mapout[key], 'testMap: '+IntToStr(key) + ' => ' + IntToStr( mapin[key])); | |
625 | Expect( mapin[key] = key - 10, 'testMap: mapin['+IntToStr(key)+'] = '+IntToStr( mapin[key])); | |
626 | end; | |
627 | ||
628 | ||
629 | // map<type1,type2>: A map of strictly unique keys to values. | |
630 | // Translates to an STL map, Java HashMap, PHP associative array, Python/Ruby dictionary, etc. | |
631 | StartTestGroup( 'testStringMap', test_Containers); | |
632 | strmapout := TThriftDictionaryImpl<string,string>.Create; | |
633 | for j := 0 to 4 do | |
634 | begin | |
635 | strmapout.AddOrSetValue( IntToStr(j), IntToStr(j - 10)); | |
636 | end; | |
637 | Console.Write('testStringMap({'); | |
638 | first := True; | |
639 | for strkey in strmapout.Keys do | |
640 | begin | |
641 | if first | |
642 | then first := False | |
643 | else Console.Write( ', ' ); | |
644 | Console.Write( strkey + ' => ' + strmapout[strkey]); | |
645 | end; | |
646 | Console.WriteLine('})'); | |
647 | ||
648 | strmapin := client.testStringMap( strmapout ); | |
649 | Expect( strmapin.Count = strmapout.Count, 'testStringMap: strmapin.Count = strmapout.Count'); | |
650 | for j := 0 to 4 do | |
651 | begin | |
652 | Expect( strmapout.ContainsKey(IntToStr(j)), | |
653 | 'testStringMap: strmapout.ContainsKey('+IntToStr(j)+') = ' | |
654 | + BoolToString(strmapout.ContainsKey(IntToStr(j)))); | |
655 | end; | |
656 | for strkey in strmapin.Keys do | |
657 | begin | |
658 | Expect( strmapin[strkey] = strmapout[strkey], 'testStringMap: '+strkey + ' => ' + strmapin[strkey]); | |
659 | Expect( strmapin[strkey] = IntToStr( StrToInt(strkey) - 10), 'testStringMap: strmapin['+strkey+'] = '+strmapin[strkey]); | |
660 | end; | |
661 | ||
662 | ||
663 | // set<type>: An unordered set of unique elements. | |
664 | // Translates to an STL set, Java HashSet, set in Python, etc. | |
665 | // Note: PHP does not support sets, so it is treated similar to a List | |
666 | StartTestGroup( 'testSet', test_Containers); | |
667 | setout := THashSetImpl<Integer>.Create; | |
668 | for j := -2 to 2 do | |
669 | begin | |
670 | setout.Add( j ); | |
671 | end; | |
672 | Console.Write('testSet({'); | |
673 | first := True; | |
674 | for j in setout do | |
675 | begin | |
676 | if first | |
677 | then first := False | |
678 | else Console.Write(', '); | |
679 | Console.Write(IntToStr( j)); | |
680 | end; | |
681 | Console.WriteLine('})'); | |
682 | ||
683 | setin := client.testSet(setout); | |
684 | Expect( setin.Count = setout.Count, 'testSet: setin.Count = setout.Count'); | |
685 | Expect( setin.Count = 5, 'testSet: setin.Count = '+IntToStr(setin.Count)); | |
686 | for j := -2 to 2 do // unordered, we can't rely on the order => test for known elements only | |
687 | begin | |
688 | Expect( setin.Contains(j), 'testSet: setin.Contains('+IntToStr(j)+') => '+BoolToString(setin.Contains(j))); | |
689 | end; | |
690 | ||
691 | // list<type>: An ordered list of elements. | |
692 | // Translates to an STL vector, Java ArrayList, native arrays in scripting languages, etc. | |
693 | StartTestGroup( 'testList', test_Containers); | |
694 | listout := TThriftListImpl<Integer>.Create; | |
695 | listout.Add( +1); | |
696 | listout.Add( -2); | |
697 | listout.Add( +3); | |
698 | listout.Add( -4); | |
699 | listout.Add( 0); | |
700 | Console.Write('testList({'); | |
701 | first := True; | |
702 | for j in listout do | |
703 | begin | |
704 | if first | |
705 | then first := False | |
706 | else Console.Write(', '); | |
707 | Console.Write(IntToStr( j)); | |
708 | end; | |
709 | Console.WriteLine('})'); | |
710 | ||
711 | listin := client.testList(listout); | |
712 | Expect( listin.Count = listout.Count, 'testList: listin.Count = listout.Count'); | |
713 | Expect( listin.Count = 5, 'testList: listin.Count = '+IntToStr(listin.Count)); | |
714 | Expect( listin[0] = +1, 'listin[0] = '+IntToStr( listin[0])); | |
715 | Expect( listin[1] = -2, 'listin[1] = '+IntToStr( listin[1])); | |
716 | Expect( listin[2] = +3, 'listin[2] = '+IntToStr( listin[2])); | |
717 | Expect( listin[3] = -4, 'listin[3] = '+IntToStr( listin[3])); | |
718 | Expect( listin[4] = 0, 'listin[4] = '+IntToStr( listin[4])); | |
719 | ||
720 | // enums | |
721 | ret := client.testEnum(TNumberz.ONE); | |
722 | Expect( ret = TNumberz.ONE, 'testEnum(ONE) = '+IntToStr(Ord(ret))); | |
723 | ||
724 | ret := client.testEnum(TNumberz.TWO); | |
725 | Expect( ret = TNumberz.TWO, 'testEnum(TWO) = '+IntToStr(Ord(ret))); | |
726 | ||
727 | ret := client.testEnum(TNumberz.THREE); | |
728 | Expect( ret = TNumberz.THREE, 'testEnum(THREE) = '+IntToStr(Ord(ret))); | |
729 | ||
730 | ret := client.testEnum(TNumberz.FIVE); | |
731 | Expect( ret = TNumberz.FIVE, 'testEnum(FIVE) = '+IntToStr(Ord(ret))); | |
732 | ||
733 | ret := client.testEnum(TNumberz.EIGHT); | |
734 | Expect( ret = TNumberz.EIGHT, 'testEnum(EIGHT) = '+IntToStr(Ord(ret))); | |
735 | ||
736 | ||
737 | // typedef | |
738 | uid := client.testTypedef(309858235082523); | |
739 | Expect( uid = 309858235082523, 'testTypedef(309858235082523) = '+IntToStr(uid)); | |
740 | ||
741 | ||
742 | // maps of maps | |
743 | StartTestGroup( 'testMapMap(1)', test_Containers); | |
744 | mm := client.testMapMap(1); | |
745 | Console.Write(' = {'); | |
746 | for key in mm.Keys do | |
747 | begin | |
748 | Console.Write( IntToStr( key) + ' => {'); | |
749 | m2 := mm[key]; | |
750 | for k2 in m2.Keys do | |
751 | begin | |
752 | Console.Write( IntToStr( k2) + ' => ' + IntToStr( m2[k2]) + ', '); | |
753 | end; | |
754 | Console.Write('}, '); | |
755 | end; | |
756 | Console.WriteLine('}'); | |
757 | ||
758 | // verify result data | |
759 | Expect( mm.Count = 2, 'mm.Count = '+IntToStr(mm.Count)); | |
760 | pos := mm[4]; | |
761 | neg := mm[-4]; | |
762 | for j := 1 to 4 do | |
763 | begin | |
764 | Expect( pos[j] = j, 'pos[j] = '+IntToStr(pos[j])); | |
765 | Expect( neg[-j] = -j, 'neg[-j] = '+IntToStr(neg[-j])); | |
766 | end; | |
767 | ||
768 | ||
769 | ||
770 | // insanity | |
771 | StartTestGroup( 'testInsanity', test_Structs); | |
772 | insane := TInsanityImpl.Create; | |
773 | insane.UserMap := TThriftDictionaryImpl<TNumberz, Int64>.Create; | |
774 | insane.UserMap.AddOrSetValue( TNumberz.FIVE, 5000); | |
775 | truck := TXtructImpl.Create; | |
776 | truck.String_thing := 'Truck'; | |
777 | truck.Byte_thing := -8; // byte is signed | |
778 | truck.I32_thing := 32; | |
779 | truck.I64_thing := 64; | |
780 | insane.Xtructs := TThriftListImpl<IXtruct>.Create; | |
781 | insane.Xtructs.Add( truck ); | |
782 | whoa := client.testInsanity( insane ); | |
783 | Console.Write(' = {'); | |
784 | for key64 in whoa.Keys do | |
785 | begin | |
786 | val := whoa[key64]; | |
787 | Console.Write( IntToStr( key64) + ' => {'); | |
788 | for k2_2 in val.Keys do | |
789 | begin | |
790 | v2 := val[k2_2]; | |
791 | Console.Write( IntToStr( Integer( k2_2)) + ' => {'); | |
792 | userMap := v2.UserMap; | |
793 | Console.Write('{'); | |
794 | if userMap <> nil then | |
795 | begin | |
796 | for k3 in userMap.Keys do | |
797 | begin | |
798 | Console.Write( IntToStr( Integer( k3)) + ' => ' + IntToStr( userMap[k3]) + ', '); | |
799 | end; | |
800 | end else | |
801 | begin | |
802 | Console.Write('null'); | |
803 | end; | |
804 | Console.Write('}, '); | |
805 | xtructs := v2.Xtructs; | |
806 | Console.Write('{'); | |
807 | ||
808 | if xtructs <> nil then | |
809 | begin | |
810 | for x in xtructs do | |
811 | begin | |
812 | Console.Write('{"' + x.String_thing + '", ' + | |
813 | IntToStr( x.Byte_thing) + ', ' + | |
814 | IntToStr( x.I32_thing) + ', ' + | |
815 | IntToStr( x.I32_thing) + '}, '); | |
816 | end; | |
817 | end else | |
818 | begin | |
819 | Console.Write('null'); | |
820 | end; | |
821 | Console.Write('}'); | |
822 | Console.Write('}, '); | |
823 | end; | |
824 | Console.Write('}, '); | |
825 | end; | |
826 | Console.WriteLine('}'); | |
827 | ||
828 | (** | |
829 | * So you think you've got this all worked, out eh? | |
830 | * | |
831 | * Creates a the returned map with these values and prints it out: | |
832 | * { 1 => { 2 => argument, | |
833 | * 3 => argument, | |
834 | * }, | |
835 | * 2 => { 6 => <empty Insanity struct>, }, | |
836 | * } | |
837 | * @return map<UserId, map<Numberz,Insanity>> - a map with the above values | |
838 | *) | |
839 | ||
840 | // verify result data | |
841 | Expect( whoa.Count = 2, 'whoa.Count = '+IntToStr(whoa.Count)); | |
842 | // | |
843 | first_map := whoa[1]; | |
844 | second_map := whoa[2]; | |
845 | Expect( first_map.Count = 2, 'first_map.Count = '+IntToStr(first_map.Count)); | |
846 | Expect( second_map.Count = 1, 'second_map.Count = '+IntToStr(second_map.Count)); | |
847 | // | |
848 | looney := second_map[TNumberz.SIX]; | |
849 | Expect( Assigned(looney), 'Assigned(looney) = '+BoolToString(Assigned(looney))); | |
850 | Expect( not looney.__isset_UserMap, 'looney.__isset_UserMap = '+BoolToString(looney.__isset_UserMap)); | |
851 | Expect( not looney.__isset_Xtructs, 'looney.__isset_Xtructs = '+BoolToString(looney.__isset_Xtructs)); | |
852 | // | |
853 | for ret in [TNumberz.TWO, TNumberz.THREE] do begin | |
854 | crazy := first_map[ret]; | |
855 | Console.WriteLine('first_map['+intToStr(Ord(ret))+']'); | |
856 | ||
857 | Expect( crazy.__isset_UserMap, 'crazy.__isset_UserMap = '+BoolToString(crazy.__isset_UserMap)); | |
858 | Expect( crazy.__isset_Xtructs, 'crazy.__isset_Xtructs = '+BoolToString(crazy.__isset_Xtructs)); | |
859 | ||
860 | Expect( crazy.UserMap.Count = insane.UserMap.Count, 'crazy.UserMap.Count = '+IntToStr(crazy.UserMap.Count)); | |
861 | for pair in insane.UserMap do begin | |
862 | Expect( crazy.UserMap[pair.Key] = pair.Value, 'crazy.UserMap['+IntToStr(Ord(pair.key))+'] = '+IntToStr(crazy.UserMap[pair.Key])); | |
863 | end; | |
864 | ||
865 | Expect( crazy.Xtructs.Count = insane.Xtructs.Count, 'crazy.Xtructs.Count = '+IntToStr(crazy.Xtructs.Count)); | |
866 | for arg0 := 0 to insane.Xtructs.Count-1 do begin | |
867 | hello := insane.Xtructs[arg0]; | |
868 | goodbye := crazy.Xtructs[arg0]; | |
869 | Expect( goodbye.String_thing = hello.String_thing, 'goodbye.String_thing = '+goodbye.String_thing); | |
870 | Expect( goodbye.Byte_thing = hello.Byte_thing, 'goodbye.Byte_thing = '+IntToStr(goodbye.Byte_thing)); | |
871 | Expect( goodbye.I32_thing = hello.I32_thing, 'goodbye.I32_thing = '+IntToStr(goodbye.I32_thing)); | |
872 | Expect( goodbye.I64_thing = hello.I64_thing, 'goodbye.I64_thing = '+IntToStr(goodbye.I64_thing)); | |
873 | end; | |
874 | end; | |
875 | ||
876 | ||
877 | // multi args | |
878 | StartTestGroup( 'testMulti', test_BaseTypes); | |
879 | arg0 := 1; | |
880 | arg1 := 2; | |
881 | arg2 := High(Int64); | |
882 | arg3 := TThriftDictionaryImpl<SmallInt, string>.Create; | |
883 | arg3.AddOrSetValue( 1, 'one'); | |
884 | arg4 := TNumberz.FIVE; | |
885 | arg5 := 5000000; | |
886 | Console.WriteLine('Test Multi(' + IntToStr( arg0) + ',' + | |
887 | IntToStr( arg1) + ',' + IntToStr( arg2) + ',' + | |
888 | arg3.ToString + ',' + IntToStr( Integer( arg4)) + ',' + | |
889 | IntToStr( arg5) + ')'); | |
890 | ||
891 | i := client.testMulti( arg0, arg1, arg2, arg3, arg4, arg5); | |
892 | Expect( i.String_thing = 'Hello2', 'testMulti: i.String_thing = "'+i.String_thing+'"'); | |
893 | Expect( i.Byte_thing = arg0, 'testMulti: i.Byte_thing = '+IntToStr(i.Byte_thing)); | |
894 | Expect( i.I32_thing = arg1, 'testMulti: i.I32_thing = '+IntToStr(i.I32_thing)); | |
895 | Expect( i.I64_thing = arg2, 'testMulti: i.I64_thing = '+IntToStr(i.I64_thing)); | |
896 | Expect( i.__isset_String_thing, 'testMulti: i.__isset_String_thing = '+BoolToString(i.__isset_String_thing)); | |
897 | Expect( i.__isset_Byte_thing, 'testMulti: i.__isset_Byte_thing = '+BoolToString(i.__isset_Byte_thing)); | |
898 | Expect( i.__isset_I32_thing, 'testMulti: i.__isset_I32_thing = '+BoolToString(i.__isset_I32_thing)); | |
899 | Expect( i.__isset_I64_thing, 'testMulti: i.__isset_I64_thing = '+BoolToString(i.__isset_I64_thing)); | |
900 | ||
901 | // multi exception | |
902 | StartTestGroup( 'testMultiException(1)', test_Exceptions); | |
903 | try | |
904 | i := client.testMultiException( 'need more pizza', 'run out of beer'); | |
905 | Expect( i.String_thing = 'run out of beer', 'i.String_thing = "' +i.String_thing+ '"'); | |
906 | Expect( i.__isset_String_thing, 'i.__isset_String_thing = '+BoolToString(i.__isset_String_thing)); | |
907 | { this is not necessarily true, these fields are default-serialized | |
908 | Expect( not i.__isset_Byte_thing, 'i.__isset_Byte_thing = '+BoolToString(i.__isset_Byte_thing)); | |
909 | Expect( not i.__isset_I32_thing, 'i.__isset_I32_thing = '+BoolToString(i.__isset_I32_thing)); | |
910 | Expect( not i.__isset_I64_thing, 'i.__isset_I64_thing = '+BoolToString(i.__isset_I64_thing)); | |
911 | } | |
912 | except | |
913 | on e:Exception do Expect( FALSE, 'Unexpected exception "'+e.ClassName+'": '+e.Message); | |
914 | end; | |
915 | ||
916 | StartTestGroup( 'testMultiException(Xception)', test_Exceptions); | |
917 | try | |
918 | i := client.testMultiException( 'Xception', 'second test'); | |
919 | Expect( FALSE, 'testMultiException(''Xception''): must trow an exception'); | |
920 | except | |
921 | on x:TXception do begin | |
922 | Expect( x.__isset_ErrorCode, 'x.__isset_ErrorCode = '+BoolToString(x.__isset_ErrorCode)); | |
923 | Expect( x.__isset_Message_, 'x.__isset_Message_ = '+BoolToString(x.__isset_Message_)); | |
924 | Expect( x.ErrorCode = 1001, 'x.ErrorCode = '+IntToStr(x.ErrorCode)); | |
925 | Expect( x.Message_ = 'This is an Xception', 'x.Message = "'+x.Message_+'"'); | |
926 | end; | |
927 | on e:Exception do Expect( FALSE, 'Unexpected exception "'+e.ClassName+'": '+e.Message); | |
928 | end; | |
929 | ||
930 | StartTestGroup( 'testMultiException(Xception2)', test_Exceptions); | |
931 | try | |
932 | i := client.testMultiException( 'Xception2', 'third test'); | |
933 | Expect( FALSE, 'testMultiException(''Xception2''): must trow an exception'); | |
934 | except | |
935 | on x:TXception2 do begin | |
936 | Expect( x.__isset_ErrorCode, 'x.__isset_ErrorCode = '+BoolToString(x.__isset_ErrorCode)); | |
937 | Expect( x.__isset_Struct_thing, 'x.__isset_Struct_thing = '+BoolToString(x.__isset_Struct_thing)); | |
938 | Expect( x.ErrorCode = 2002, 'x.ErrorCode = '+IntToStr(x.ErrorCode)); | |
939 | Expect( x.Struct_thing.String_thing = 'This is an Xception2', 'x.Struct_thing.String_thing = "'+x.Struct_thing.String_thing+'"'); | |
940 | Expect( x.Struct_thing.__isset_String_thing, 'x.Struct_thing.__isset_String_thing = '+BoolToString(x.Struct_thing.__isset_String_thing)); | |
941 | { this is not necessarily true, these fields are default-serialized | |
942 | Expect( not x.Struct_thing.__isset_Byte_thing, 'x.Struct_thing.__isset_Byte_thing = '+BoolToString(x.Struct_thing.__isset_Byte_thing)); | |
943 | Expect( not x.Struct_thing.__isset_I32_thing, 'x.Struct_thing.__isset_I32_thing = '+BoolToString(x.Struct_thing.__isset_I32_thing)); | |
944 | Expect( not x.Struct_thing.__isset_I64_thing, 'x.Struct_thing.__isset_I64_thing = '+BoolToString(x.Struct_thing.__isset_I64_thing)); | |
945 | } | |
946 | end; | |
947 | on e:Exception do Expect( FALSE, 'Unexpected exception "'+e.ClassName+'": '+e.Message); | |
948 | end; | |
949 | ||
950 | ||
951 | // oneway functions | |
952 | StartTestGroup( 'Test Oneway(1)', test_Unknown); | |
953 | client.testOneway(1); | |
954 | Expect( TRUE, 'Test Oneway(1)'); // success := no exception | |
955 | ||
956 | // call time | |
957 | {$IFDEF PerfTest} | |
958 | StartTestGroup( 'Test Calltime()'); | |
959 | StartTick := GetTickCount; | |
960 | for k := 0 to 1000 - 1 do | |
961 | begin | |
962 | client.testVoid(); | |
963 | end; | |
964 | Console.WriteLine(' = ' + FloatToStr( (GetTickCount - StartTick) / 1000 ) + ' ms a testVoid() call' ); | |
965 | {$ENDIF PerfTest} | |
966 | ||
967 | // no more tests here | |
968 | StartTestGroup( '', test_Unknown); | |
969 | end; | |
970 | ||
971 | ||
972 | {$IFDEF SupportsAsync} | |
973 | procedure TClientThread.ClientAsyncTest; | |
974 | var | |
975 | client : TThriftTest.IAsync; | |
976 | s : string; | |
977 | i8 : ShortInt; | |
978 | begin | |
979 | StartTestGroup( 'Async Tests', test_Unknown); | |
980 | client := TThriftTest.TClient.Create( FProtocol); | |
981 | FTransport.Open; | |
982 | ||
983 | // oneway void functions | |
984 | client.testOnewayAsync(1).Wait; | |
985 | Expect( TRUE, 'Test Oneway(1)'); // success := no exception | |
986 | ||
987 | // normal functions | |
988 | s := client.testStringAsync(HUGE_TEST_STRING).Value; | |
989 | Expect( length(s) = length(HUGE_TEST_STRING), | |
990 | 'testString( length(HUGE_TEST_STRING) = '+IntToStr(Length(HUGE_TEST_STRING))+') ' | |
991 | +'=> length(result) = '+IntToStr(Length(s))); | |
992 | ||
993 | i8 := client.testByte(1).Value; | |
994 | Expect( i8 = 1, 'testByte(1) = ' + IntToStr( i8 )); | |
995 | end; | |
996 | {$ENDIF} | |
997 | ||
998 | ||
999 | {$IFDEF StressTest} | |
1000 | procedure TClientThread.StressTest(const client : TThriftTest.Iface); | |
1001 | begin | |
1002 | while TRUE do begin | |
1003 | try | |
1004 | if not FTransport.IsOpen then FTransport.Open; // re-open connection, server has already closed | |
1005 | try | |
1006 | client.testString('Test'); | |
1007 | Write('.'); | |
1008 | finally | |
1009 | if FTransport.IsOpen then FTransport.Close; | |
1010 | end; | |
1011 | except | |
1012 | on e:Exception do Writeln(#10+e.message); | |
1013 | end; | |
1014 | end; | |
1015 | end; | |
1016 | {$ENDIF} | |
1017 | ||
1018 | ||
1019 | function TClientThread.PrepareBinaryData( aRandomDist : Boolean; aSize : TTestSize) : TBytes; | |
1020 | var i : Integer; | |
1021 | begin | |
1022 | case aSize of | |
1023 | Empty : SetLength( result, 0); | |
1024 | Normal : SetLength( result, $100); | |
1025 | ByteArrayTest : SetLength( result, SizeOf(TByteArray) + 128); | |
1026 | PipeWriteLimit : SetLength( result, 65535 + 128); | |
1027 | TwentyMB : SetLength( result, 20 * 1024 * 1024); | |
1028 | else | |
1029 | raise EArgumentException.Create('aSize'); | |
1030 | end; | |
1031 | ||
1032 | ASSERT( Low(result) = 0); | |
1033 | if Length(result) = 0 then Exit; | |
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 mod $100; | |
1039 | end; | |
1040 | Exit; | |
1041 | end; | |
1042 | ||
1043 | // random distribution of all 256 values | |
1044 | FillChar( result[0], Length(result) * SizeOf(result[0]), $0); | |
1045 | for i := Low(result) to High(result) do begin | |
1046 | result[i] := Byte( Random($100)); | |
1047 | end; | |
1048 | end; | |
1049 | ||
1050 | ||
1051 | {$IFDEF Win64} | |
1052 | procedure TClientThread.UseInterlockedExchangeAdd64; | |
1053 | var a,b : Int64; | |
1054 | begin | |
1055 | a := 1; | |
1056 | b := 2; | |
1057 | Thrift.Utils.InterlockedExchangeAdd64( a,b); | |
1058 | Expect( a = 3, 'InterlockedExchangeAdd64'); | |
1059 | end; | |
1060 | {$ENDIF} | |
1061 | ||
1062 | ||
1063 | procedure 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. | |
1068 | var prot : IProtocol; | |
1069 | stm : TStringStream; | |
1070 | list : TThriftList; | |
1071 | binary, binRead, emptyBinary : TBytes; | |
1072 | i,iErr : Integer; | |
1073 | const | |
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") | |
1081 | // 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"'; | |
1084 | // test both possible solidus encodings | |
1085 | SOLIDUS_JSON_DATA = '"one/two\/three"'; | |
1086 | SOLIDUS_EXCPECTED = 'one/two/three'; | |
1087 | begin | |
1088 | stm := TStringStream.Create; | |
1089 | try | |
1090 | StartTestGroup( 'JsonProtocolTest', test_Unknown); | |
1091 | ||
1092 | // prepare binary data | |
1093 | binary := PrepareBinaryData( FALSE, Normal); | |
1094 | SetLength( emptyBinary, 0); // empty binary data block | |
1095 | ||
1096 | // output setup | |
1097 | prot := TJSONProtocolImpl.Create( | |
1098 | TStreamTransportImpl.Create( | |
1099 | nil, TThriftStreamAdapterDelphi.Create( stm, FALSE))); | |
1100 | ||
1101 | // write | |
1102 | Init( list, TType.String_, 9); | |
1103 | prot.WriteListBegin( list); | |
1104 | 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); | |
1113 | prot.WriteString( ''); // empty string | |
1114 | prot.WriteBinary( emptyBinary); // empty binary data block | |
1115 | 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; | |
1137 | Expect( Length(prot.ReadString) = 0, 'WriteString/ReadString (empty string)'); | |
1138 | Expect( Length(prot.ReadBinary) = 0, 'empty WriteBinary/ReadBinary (empty data block)'); | |
1139 | 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 | ||
1156 | ||
1157 | // 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 | ||
1168 | // 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))); | |
1176 | prot.WriteString( G_CLEF_AND_CYRILLIC_TEXT); | |
1177 | stm.Position := 0; | |
1178 | prot := TJSONProtocolImpl.Create( | |
1179 | TStreamTransportImpl.Create( | |
1180 | TThriftStreamAdapterDelphi.Create( stm, FALSE), nil)); | |
1181 | Expect( prot.ReadString = G_CLEF_AND_CYRILLIC_TEXT, 'Writing JSON with chars > 8 bit'); | |
1182 | ||
1183 | // Widechars should work with hex-encoding too. Do they? | |
1184 | stm.Position := 0; | |
1185 | stm.Size := 0; | |
1186 | stm.WriteString( G_CLEF_AND_CYRILLIC_JSON); | |
1187 | stm.Position := 0; | |
1188 | prot := TJSONProtocolImpl.Create( | |
1189 | TStreamTransportImpl.Create( | |
1190 | TThriftStreamAdapterDelphi.Create( stm, FALSE), nil)); | |
1191 | Expect( prot.ReadString = G_CLEF_AND_CYRILLIC_TEXT, 'Reading JSON with chars > 8 bit'); | |
1192 | ||
1193 | ||
1194 | finally | |
1195 | stm.Free; | |
1196 | prot := nil; //-> Release | |
1197 | StartTestGroup( '', test_Unknown); // no more tests here | |
1198 | end; | |
1199 | end; | |
1200 | ||
1201 | ||
1202 | procedure TClientThread.StartTestGroup( const aGroup : string; const aTest : TTestGroup); | |
1203 | begin | |
1204 | FTestGroup := aGroup; | |
1205 | FCurrentTest := aTest; | |
1206 | ||
1207 | Include( FExecuted, aTest); | |
1208 | ||
1209 | if FTestGroup <> '' then begin | |
1210 | Console.WriteLine(''); | |
1211 | Console.WriteLine( aGroup+' tests'); | |
1212 | Console.WriteLine( StringOfChar('-',60)); | |
1213 | end; | |
1214 | end; | |
1215 | ||
1216 | ||
1217 | procedure TClientThread.Expect( aTestResult : Boolean; const aTestInfo : string); | |
1218 | begin | |
1219 | if aTestResult then begin | |
1220 | Inc(FSuccesses); | |
1221 | Console.WriteLine( aTestInfo+': passed'); | |
1222 | end | |
1223 | else begin | |
1224 | FErrors.Add( FTestGroup+': '+aTestInfo); | |
1225 | Include( FFailed, FCurrentTest); | |
1226 | 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 | |
1231 | if IsDebuggerPresent | |
1232 | then {$IFDEF CPUX64} DebugBreak {$ELSE} asm int 3 end {$ENDIF}; | |
1233 | end; | |
1234 | end; | |
1235 | ||
1236 | ||
1237 | procedure TClientThread.ReportResults; | |
1238 | var nTotal : Integer; | |
1239 | sLine : string; | |
1240 | begin | |
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(''); | |
1261 | end; | |
1262 | ||
1263 | ||
1264 | function TClientThread.CalculateExitCode : Byte; | |
1265 | var test : TTestGroup; | |
1266 | begin | |
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; | |
1272 | end; | |
1273 | ||
1274 | ||
1275 | constructor TClientThread.Create( const aSetup : TTestSetup; const aNumIteration: Integer); | |
1276 | begin | |
1277 | FSetup := aSetup; | |
1278 | FNumIteration := ANumIteration; | |
1279 | ||
1280 | FConsole := TThreadConsole.Create( Self ); | |
1281 | FCurrentTest := test_Unknown; | |
1282 | ||
1283 | // error list: keep correct order, allow for duplicates | |
1284 | FErrors := TStringList.Create; | |
1285 | FErrors.Sorted := FALSE; | |
1286 | FErrors.Duplicates := dupAccept; | |
1287 | ||
1288 | inherited Create( TRUE); | |
1289 | end; | |
1290 | ||
1291 | destructor TClientThread.Destroy; | |
1292 | begin | |
1293 | FreeAndNil( FConsole); | |
1294 | FreeAndNil( FErrors); | |
1295 | inherited; | |
1296 | end; | |
1297 | ||
1298 | procedure TClientThread.Execute; | |
1299 | var | |
1300 | i : Integer; | |
1301 | begin | |
1302 | // perform all tests | |
1303 | try | |
1304 | {$IFDEF Win64} | |
1305 | UseInterlockedExchangeAdd64; | |
1306 | {$ENDIF} | |
1307 | JSONProtocolReadWriteTest; | |
1308 | ||
1309 | // must be run in the context of the thread | |
1310 | InitializeProtocolTransportStack; | |
1311 | try | |
1312 | for i := 0 to FNumIteration - 1 do begin | |
1313 | ClientTest; | |
1314 | {$IFDEF SupportsAsync} | |
1315 | ClientAsyncTest; | |
1316 | {$ENDIF} | |
1317 | end; | |
1318 | ||
1319 | // report the outcome | |
1320 | ReportResults; | |
1321 | SetReturnValue( CalculateExitCode); | |
1322 | ||
1323 | finally | |
1324 | ShutdownProtocolTransportStack; | |
1325 | end; | |
1326 | ||
1327 | except | |
1328 | on e:Exception do Expect( FALSE, 'unexpected exception: "'+e.message+'"'); | |
1329 | end; | |
1330 | end; | |
1331 | ||
1332 | ||
1333 | function TClientThread.InitializeHttpTransport( const aTimeoutSetting : Integer) : IHTTPClient; | |
1334 | var sUrl : string; | |
1335 | comps : URL_COMPONENTS; | |
1336 | dwChars : DWORD; | |
1337 | begin | |
1338 | ASSERT( FSetup.endpoint in [trns_MsxmlHttp, trns_WinHttp]); | |
1339 | ||
1340 | if FSetup.useSSL | |
1341 | then sUrl := 'https://' | |
1342 | else sUrl := 'http://'; | |
1343 | ||
1344 | sUrl := sUrl + FSetup.host; | |
1345 | ||
1346 | // add the port number if necessary and at the right place | |
1347 | FillChar( comps, SizeOf(comps), 0); | |
1348 | comps.dwStructSize := SizeOf(comps); | |
1349 | comps.dwSchemeLength := MAXINT; | |
1350 | comps.dwHostNameLength := MAXINT; | |
1351 | comps.dwUserNameLength := MAXINT; | |
1352 | comps.dwPasswordLength := MAXINT; | |
1353 | comps.dwUrlPathLength := MAXINT; | |
1354 | comps.dwExtraInfoLength := MAXINT; | |
1355 | Win32Check( WinHttpCrackUrl( PChar(sUrl), Length(sUrl), 0, comps)); | |
1356 | case FSetup.port of | |
1357 | 80 : if FSetup.useSSL then comps.nPort := FSetup.port; | |
1358 | 443 : if not FSetup.useSSL then comps.nPort := FSetup.port; | |
1359 | else | |
1360 | if FSetup.port > 0 then comps.nPort := FSetup.port; | |
1361 | end; | |
1362 | dwChars := Length(sUrl) + 64; | |
1363 | SetLength( sUrl, dwChars); | |
1364 | Win32Check( WinHttpCreateUrl( comps, 0, @sUrl[1], dwChars)); | |
1365 | SetLength( sUrl, dwChars); | |
1366 | ||
1367 | ||
1368 | Console.WriteLine('Target URL: '+sUrl); | |
1369 | case FSetup.endpoint of | |
1370 | trns_MsxmlHttp : result := TMsxmlHTTPClientImpl.Create( sUrl); | |
1371 | trns_WinHttp : result := TWinHTTPClientImpl.Create( sUrl); | |
1372 | else | |
1373 | raise Exception.Create(ENDPOINT_TRANSPORTS[FSetup.endpoint]+' unhandled case'); | |
1374 | end; | |
1375 | ||
1376 | result.DnsResolveTimeout := aTimeoutSetting; | |
1377 | result.ConnectionTimeout := aTimeoutSetting; | |
1378 | result.SendTimeout := aTimeoutSetting; | |
1379 | result.ReadTimeout := aTimeoutSetting; | |
1380 | end; | |
1381 | ||
1382 | ||
1383 | procedure TClientThread.InitializeProtocolTransportStack; | |
1384 | var streamtrans : IStreamTransport; | |
1385 | canSSL : Boolean; | |
1386 | const | |
1387 | DEBUG_TIMEOUT = 30 * 1000; | |
1388 | RELEASE_TIMEOUT = DEFAULT_THRIFT_TIMEOUT; | |
1389 | PIPE_TIMEOUT = RELEASE_TIMEOUT; | |
1390 | HTTP_TIMEOUTS = 10 * 1000; | |
1391 | begin | |
1392 | // needed for HTTP clients as they utilize the MSXML COM components | |
1393 | OleCheck( CoInitialize( nil)); | |
1394 | ||
1395 | canSSL := FALSE; | |
1396 | case FSetup.endpoint of | |
1397 | trns_Sockets: begin | |
1398 | Console.WriteLine('Using sockets ('+FSetup.host+' port '+IntToStr(FSetup.port)+')'); | |
1399 | streamtrans := TSocketImpl.Create( FSetup.host, FSetup.port ); | |
1400 | FTransport := streamtrans; | |
1401 | end; | |
1402 | ||
1403 | trns_MsxmlHttp, | |
1404 | trns_WinHttp: begin | |
1405 | Console.WriteLine('Using HTTPClient'); | |
1406 | FTransport := InitializeHttpTransport( HTTP_TIMEOUTS); | |
1407 | canSSL := TRUE; | |
1408 | end; | |
1409 | ||
1410 | trns_EvHttp: begin | |
1411 | raise Exception.Create(ENDPOINT_TRANSPORTS[FSetup.endpoint]+' transport not implemented'); | |
1412 | end; | |
1413 | ||
1414 | trns_NamedPipes: begin | |
1415 | streamtrans := TNamedPipeTransportClientEndImpl.Create( FSetup.sPipeName, 0, nil, PIPE_TIMEOUT, PIPE_TIMEOUT); | |
1416 | FTransport := streamtrans; | |
1417 | end; | |
1418 | ||
1419 | trns_AnonPipes: begin | |
1420 | streamtrans := TAnonymousPipeTransportImpl.Create( FSetup.hAnonRead, FSetup.hAnonWrite, FALSE); | |
1421 | FTransport := streamtrans; | |
1422 | end; | |
1423 | ||
1424 | else | |
1425 | raise Exception.Create('Unhandled endpoint transport'); | |
1426 | end; | |
1427 | ASSERT( FTransport <> nil); | |
1428 | ||
1429 | // layered transports are not really meant to be stacked upon each other | |
1430 | if (trns_Framed in FSetup.layered) then begin | |
1431 | FTransport := TFramedTransportImpl.Create( FTransport); | |
1432 | end | |
1433 | else if (trns_Buffered in FSetup.layered) and (streamtrans <> nil) then begin | |
1434 | FTransport := TBufferedTransportImpl.Create( streamtrans, 32); // small buffer to test read() | |
1435 | end; | |
1436 | ||
1437 | if FSetup.useSSL and not canSSL then begin | |
1438 | raise Exception.Create('SSL/TLS not implemented'); | |
1439 | end; | |
1440 | ||
1441 | // create protocol instance, default to BinaryProtocol | |
1442 | case FSetup.protType of | |
1443 | prot_Binary : FProtocol := TBinaryProtocolImpl.Create( FTransport, BINARY_STRICT_READ, BINARY_STRICT_WRITE); | |
1444 | prot_JSON : FProtocol := TJSONProtocolImpl.Create( FTransport); | |
1445 | prot_Compact : FProtocol := TCompactProtocolImpl.Create( FTransport); | |
1446 | else | |
1447 | raise Exception.Create('Unhandled protocol'); | |
1448 | end; | |
1449 | ||
1450 | ASSERT( (FTransport <> nil) and (FProtocol <> nil)); | |
1451 | end; | |
1452 | ||
1453 | ||
1454 | procedure TClientThread.ShutdownProtocolTransportStack; | |
1455 | begin | |
1456 | try | |
1457 | FProtocol := nil; | |
1458 | ||
1459 | if FTransport <> nil then begin | |
1460 | FTransport.Close; | |
1461 | FTransport := nil; | |
1462 | end; | |
1463 | ||
1464 | finally | |
1465 | CoUninitialize; | |
1466 | end; | |
1467 | end; | |
1468 | ||
1469 | ||
1470 | { TThreadConsole } | |
1471 | ||
1472 | constructor TThreadConsole.Create(AThread: TThread); | |
1473 | begin | |
1474 | inherited Create; | |
1475 | FThread := AThread; | |
1476 | end; | |
1477 | ||
1478 | procedure TThreadConsole.Write(const S: string); | |
1479 | var | |
1480 | proc : TThreadProcedure; | |
1481 | begin | |
1482 | proc := procedure | |
1483 | begin | |
1484 | Console.Write( S ); | |
1485 | end; | |
1486 | TThread.Synchronize( FThread, proc); | |
1487 | end; | |
1488 | ||
1489 | procedure TThreadConsole.WriteLine(const S: string); | |
1490 | var | |
1491 | proc : TThreadProcedure; | |
1492 | begin | |
1493 | proc := procedure | |
1494 | begin | |
1495 | Console.WriteLine( S ); | |
1496 | end; | |
1497 | TThread.Synchronize( FThread, proc); | |
1498 | end; | |
1499 | ||
1500 | initialization | |
1501 | begin | |
1502 | TTestClient.FNumIteration := 1; | |
1503 | TTestClient.FNumThread := 1; | |
1504 | end; | |
1505 | ||
1506 | end. |