blob: aca64410c179ea1fcc59dbc849760e83704c633f [file] [log] [blame]
Jens Geyer7bb44a32014-02-07 22:24:37 +01001(*
Roger Meier3bef8c22012-10-06 06:58:00 +00002 * Licensed to the Apache Software Foundation (ASF) under one
3 * or more contributor license agreements. See the NOTICE file
4 * distributed with this work for additional information
5 * regarding copyright ownership. The ASF licenses this file
6 * to you under the Apache License, Version 2.0 (the
7 * "License"); you may not use this file except in compliance
8 * with the License. You may obtain a copy of the License at
9 *
10 * http://www.apache.org/licenses/LICENSE-2.0
11 *
12 * Unless required by applicable law or agreed to in writing,
13 * software distributed under the License is distributed on an
14 * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
15 * KIND, either express or implied. See the License for the
16 * specific language governing permissions and limitations
17 * under the License.
18 *)
19
20unit TestClient;
21
Jens Geyer9f7f11e2016-04-14 21:37:11 +020022{$I ../src/Thrift.Defines.inc}
23
Jens Geyer06045cf2013-03-27 20:26:25 +020024{.$DEFINE StressTest} // activate to stress-test the server with frequent connects/disconnects
Jens Geyer17c3ad92017-09-05 20:31:27 +020025{.$DEFINE PerfTest} // activate the performance test
26{$DEFINE Exceptions} // activate the exceptions test (or disable while debugging)
Jens Geyer06045cf2013-03-27 20:26:25 +020027
Jens Geyer14f5d502017-12-09 13:47:09 +010028{$if CompilerVersion >= 28}
29{$DEFINE SupportsAsync}
30{$ifend}
31
Jens Geyer47f63172019-06-06 22:42:58 +020032{$WARN SYMBOL_PLATFORM OFF} // Win32Check
33
Roger Meier3bef8c22012-10-06 06:58:00 +000034interface
35
36uses
Jens Geyer62445c12022-06-29 00:00:00 +020037 Classes, Windows, SysUtils, Math, ActiveX, ComObj,
Jens Geyer14f5d502017-12-09 13:47:09 +010038 {$IFDEF SupportsAsync} System.Threading, {$ENDIF}
Roger Meier3bef8c22012-10-06 06:58:00 +000039 DateUtils,
40 Generics.Collections,
41 TestConstants,
Jens Geyer82fc93e2024-05-24 23:36:07 +020042 TestLogger,
Jens Geyer3d556242018-01-24 19:14:32 +010043 ConsoleHelper,
Jens Geyerb342bd92019-06-03 20:27:00 +020044 PerfTests,
Jens Geyer82fc93e2024-05-24 23:36:07 +020045 UnitTests,
Roger Meier3bef8c22012-10-06 06:58:00 +000046 Thrift,
Jens Geyerf0e63312015-03-01 18:47:49 +010047 Thrift.Protocol.Compact,
Roger Meier3bef8c22012-10-06 06:58:00 +000048 Thrift.Protocol.JSON,
49 Thrift.Protocol,
50 Thrift.Transport.Pipes,
Jens Geyer02230912019-04-03 01:12:51 +020051 Thrift.Transport.WinHTTP,
52 Thrift.Transport.MsxmlHTTP,
Roger Meier3bef8c22012-10-06 06:58:00 +000053 Thrift.Transport,
54 Thrift.Stream,
55 Thrift.Test,
Jens Geyer83ff7532019-06-06 22:46:03 +020056 Thrift.WinHTTP,
Jens Geyerf7904452017-07-26 15:02:12 +020057 Thrift.Utils,
Jens Geyera019cda2019-11-09 23:24:52 +010058 Thrift.Configuration,
Jens Geyer3d556242018-01-24 19:14:32 +010059 Thrift.Collections;
Roger Meier3bef8c22012-10-06 06:58:00 +000060
61type
Jens Geyer48d3bef2022-09-08 21:48:41 +020062 TClientThread = class;
63
64 TThreadConsole = class(TThriftConsole)
65 strict private
66 FThread : TClientThread;
67 FLogThreadID : Boolean;
Roger Meier3bef8c22012-10-06 06:58:00 +000068 public
Jens Geyer48d3bef2022-09-08 21:48:41 +020069 constructor Create( const aThread: TClientThread; const aLogThreadID : Boolean);
70
71 procedure Write( const S: string); override;
72 procedure WriteLine( const S: string); override;
Roger Meier3bef8c22012-10-06 06:58:00 +000073 end;
74
Jens Geyeraf7ecd62018-06-22 22:41:27 +020075 TTestSetup = record
76 protType : TKnownProtocol;
77 endpoint : TEndpointTransport;
78 layered : TLayeredTransports;
79 useSSL : Boolean; // include where appropriate (TLayeredTransport?)
80 host : string;
81 port : Integer;
82 sPipeName : string;
83 hAnonRead, hAnonWrite : THandle;
84 end;
85
Roger Meier3bef8c22012-10-06 06:58:00 +000086 TClientThread = class( TThread )
Jens Geyer48d3bef2022-09-08 21:48:41 +020087 strict private
Jens Geyeraf7ecd62018-06-22 22:41:27 +020088 FSetup : TTestSetup;
Roger Meier3bef8c22012-10-06 06:58:00 +000089 FTransport : ITransport;
90 FProtocol : IProtocol;
Jens Geyer48d3bef2022-09-08 21:48:41 +020091 FNumIterations : Integer;
92
93 FThreadNo : Integer;
Roger Meier3bef8c22012-10-06 06:58:00 +000094 FConsole : TThreadConsole;
Jens Geyer82fc93e2024-05-24 23:36:07 +020095 FLogger : ITestLogger;
Roger Meier3bef8c22012-10-06 06:58:00 +000096
97 procedure ClientTest;
Jens Geyer14f5d502017-12-09 13:47:09 +010098 {$IFDEF SupportsAsync}
99 procedure ClientAsyncTest;
100 {$ENDIF}
101
Jens Geyeraf7ecd62018-06-22 22:41:27 +0200102 procedure InitializeProtocolTransportStack;
103 procedure ShutdownProtocolTransportStack;
Jens Geyera019cda2019-11-09 23:24:52 +0100104 function InitializeHttpTransport( const aTimeoutSetting : Integer; const aConfig : IThriftConfiguration = nil) : IHTTPClient;
Jens Geyeraf7ecd62018-06-22 22:41:27 +0200105
Jens Geyer718f6ee2013-09-06 21:02:34 +0200106 {$IFDEF StressTest}
Jens Geyer06045cf2013-03-27 20:26:25 +0200107 procedure StressTest(const client : TThriftTest.Iface);
Jens Geyer718f6ee2013-09-06 21:02:34 +0200108 {$ENDIF}
Jens Geyer82fc93e2024-05-24 23:36:07 +0200109
110 procedure StartTestGroup( const aGroup : string; const aTest : TClientTestGroup); inline;
111 procedure Expect( aTestResult : Boolean; const aTestInfo : string); inline;
112 function CalculateExitCode : Byte;
Jens Geyer48d3bef2022-09-08 21:48:41 +0200113
114 strict protected
Roger Meier3bef8c22012-10-06 06:58:00 +0000115 procedure Execute; override;
Jens Geyer48d3bef2022-09-08 21:48:41 +0200116 property Console : TThreadConsole read FConsole;
117
Roger Meier3bef8c22012-10-06 06:58:00 +0000118 public
Jens Geyer48d3bef2022-09-08 21:48:41 +0200119 constructor Create( const aSetup : TTestSetup; const aNumIteration, aThreadNo: Integer; const aLogThreadID : Boolean);
Roger Meier3bef8c22012-10-06 06:58:00 +0000120 destructor Destroy; override;
Jens Geyer48d3bef2022-09-08 21:48:41 +0200121
122 property ThreadNo : Integer read FThreadNo;
Roger Meier3bef8c22012-10-06 06:58:00 +0000123 end;
124
125 TTestClient = class
126 private
127 class var
Jens Geyer48d3bef2022-09-08 21:48:41 +0200128 FNumIterations : Integer;
129 FNumThreads : Integer;
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200130
131 class procedure PrintCmdLineHelp;
132 class procedure InvalidArgs;
Roger Meier3bef8c22012-10-06 06:58:00 +0000133 public
Jens Geyeraeda9872020-03-22 15:01:28 +0100134 class function Execute( const arguments: array of string) : Byte;
Roger Meier3bef8c22012-10-06 06:58:00 +0000135 end;
136
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200137
Roger Meier3bef8c22012-10-06 06:58:00 +0000138implementation
139
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200140const
141 EXITCODE_SUCCESS = $00; // no errors bits set
142 //
143 EXITCODE_FAILBIT_BASETYPES = $01;
144 EXITCODE_FAILBIT_STRUCTS = $02;
145 EXITCODE_FAILBIT_CONTAINERS = $04;
146 EXITCODE_FAILBIT_EXCEPTIONS = $08;
147
Jens Geyer82fc93e2024-05-24 23:36:07 +0200148 MAP_FAILURES_TO_EXITCODE_BITS : array[TClientTestGroup] of Byte = (
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200149 EXITCODE_SUCCESS, // no bits here
150 EXITCODE_FAILBIT_BASETYPES,
151 EXITCODE_FAILBIT_STRUCTS,
152 EXITCODE_FAILBIT_CONTAINERS,
153 EXITCODE_FAILBIT_EXCEPTIONS
154 );
155
156
157
Roger Meier3bef8c22012-10-06 06:58:00 +0000158function BoolToString( b : Boolean) : string;
159// overrides global BoolToString()
160begin
161 if b
162 then result := 'true'
163 else result := 'false';
164end;
165
166// not available in all versions, so make sure we have this one imported
167function IsDebuggerPresent: BOOL; stdcall; external KERNEL32 name 'IsDebuggerPresent';
168
169{ TTestClient }
170
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200171class procedure TTestClient.PrintCmdLineHelp;
172const HELPTEXT = ' [options]'#10
173 + #10
174 + 'Allowed options:'#10
Jens Geyeraeda9872020-03-22 15:01:28 +0100175 + ' -h | --help Produces this help message'#10
176 + ' --host=arg (localhost) Host to connect'#10
177 + ' --port=arg (9090) Port number to connect'#10
178 + ' --pipe=arg Windows Named Pipe (e.g. MyThriftPipe)'#10
179 + ' --anon-pipes hRead hWrite Windows Anonymous Pipes pair (handles)'#10
180 + ' --transport=arg (sockets) Transport: buffered, framed, http, winhttp'#10
181 + ' --protocol=arg (binary) Protocol: binary, compact, json'#10
182 + ' --ssl Encrypted Transport using SSL'#10
183 + ' -n=num | --testloops=num (1) Number of Tests'#10
184 + ' -t=num | --threads=num (1) Number of Test threads'#10
185 + ' --performance Run the built-in performance test (no other arguments)'#10
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200186 ;
187begin
188 Writeln( ChangeFileExt(ExtractFileName(ParamStr(0)),'') + HELPTEXT);
189end;
190
191class procedure TTestClient.InvalidArgs;
192begin
193 Console.WriteLine( 'Invalid args.');
194 Console.WriteLine( ChangeFileExt(ExtractFileName(ParamStr(0)),'') + ' -h for more information');
195 Abort;
196end;
197
Jens Geyeraeda9872020-03-22 15:01:28 +0100198class function TTestClient.Execute(const arguments: array of string) : Byte;
199
200 function IsSwitch( const aArgument, aSwitch : string; out sValue : string) : Boolean;
201 begin
202 sValue := '';
203 result := (Copy( aArgument, 1, Length(aSwitch)) = aSwitch);
204 if result then begin
205 if (Copy( aArgument, 1, Length(aSwitch)+1) = (aSwitch+'='))
206 then sValue := Copy( aArgument, Length(aSwitch)+2, MAXINT);
207 end;
208 end;
209
Roger Meier3bef8c22012-10-06 06:58:00 +0000210var
Jens Geyeraeda9872020-03-22 15:01:28 +0100211 iArg : Integer;
Jens Geyer14f5d502017-12-09 13:47:09 +0100212 threadExitCode : Byte;
Jens Geyeraeda9872020-03-22 15:01:28 +0100213 sArg, sValue : string;
Roger Meier3bef8c22012-10-06 06:58:00 +0000214 threads : array of TThread;
215 dtStart : TDateTime;
216 test : Integer;
217 thread : TThread;
Jens Geyeraf7ecd62018-06-22 22:41:27 +0200218 setup : TTestSetup;
Roger Meier3bef8c22012-10-06 06:58:00 +0000219begin
Jens Geyeraf7ecd62018-06-22 22:41:27 +0200220 // init record
221 with setup do begin
222 protType := prot_Binary;
223 endpoint := trns_Sockets;
224 layered := [];
225 useSSL := FALSE;
226 host := 'localhost';
227 port := 9090;
228 sPipeName := '';
229 hAnonRead := INVALID_HANDLE_VALUE;
230 hAnonWrite := INVALID_HANDLE_VALUE;
231 end;
232
Roger Meier3bef8c22012-10-06 06:58:00 +0000233 try
Jens Geyeraeda9872020-03-22 15:01:28 +0100234 iArg := 0;
235 while iArg < Length(arguments) do begin
236 sArg := arguments[iArg];
237 Inc(iArg);
Roger Meier3bef8c22012-10-06 06:58:00 +0000238
Jens Geyeraeda9872020-03-22 15:01:28 +0100239 if IsSwitch( sArg, '-h', sValue)
240 or IsSwitch( sArg, '--help', sValue)
241 then begin
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200242 // -h [ --help ] produce help message
243 PrintCmdLineHelp;
244 result := $FF; // all tests failed
245 Exit;
246 end
Jens Geyeraeda9872020-03-22 15:01:28 +0100247 else if IsSwitch( sArg, '--host', sValue) then begin
Jens Geyerb360b652014-09-28 01:55:46 +0200248 // --host arg (=localhost) Host to connect
Jens Geyeraeda9872020-03-22 15:01:28 +0100249 setup.host := sValue;
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200250 end
Jens Geyeraeda9872020-03-22 15:01:28 +0100251 else if IsSwitch( sArg, '--port', sValue) then begin
Jens Geyerb360b652014-09-28 01:55:46 +0200252 // --port arg (=9090) Port number to connect
Jens Geyeraeda9872020-03-22 15:01:28 +0100253 setup.port := StrToIntDef(sValue,0);
Jens Geyeraf7ecd62018-06-22 22:41:27 +0200254 if setup.port <= 0 then InvalidArgs;
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200255 end
Jens Geyeraeda9872020-03-22 15:01:28 +0100256 else if IsSwitch( sArg, '--domain-socket', sValue) then begin
Jens Geyerb360b652014-09-28 01:55:46 +0200257 // --domain-socket arg Domain Socket (e.g. /tmp/ThriftTest.thrift), instead of host and port
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200258 raise Exception.Create('domain-socket not supported');
259 end
Jens Geyeraeda9872020-03-22 15:01:28 +0100260 // --pipe arg Windows Named Pipe (e.g. MyThriftPipe)
261 else if IsSwitch( sArg, '--pipe', sValue) then begin
Jens Geyer4a33b182020-03-22 13:46:34 +0100262 // --pipe arg Windows Named Pipe (e.g. MyThriftPipe)
Jens Geyeraf7ecd62018-06-22 22:41:27 +0200263 setup.endpoint := trns_NamedPipes;
Jens Geyeraeda9872020-03-22 15:01:28 +0100264 setup.sPipeName := sValue;
Jens Geyeraf7ecd62018-06-22 22:41:27 +0200265 Console.WriteLine('Using named pipe ('+setup.sPipeName+')');
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200266 end
Jens Geyeraeda9872020-03-22 15:01:28 +0100267 else if IsSwitch( sArg, '--anon-pipes', sValue) then begin
Jens Geyerb360b652014-09-28 01:55:46 +0200268 // --anon-pipes hRead hWrite Windows Anonymous Pipes pair (handles)
Jens Geyeraf7ecd62018-06-22 22:41:27 +0200269 setup.endpoint := trns_AnonPipes;
Jens Geyeraeda9872020-03-22 15:01:28 +0100270 setup.hAnonRead := THandle( StrToIntDef( arguments[iArg], Integer(INVALID_HANDLE_VALUE)));
271 Inc(iArg);
272 setup.hAnonWrite := THandle( StrToIntDef( arguments[iArg], Integer(INVALID_HANDLE_VALUE)));
273 Inc(iArg);
Jens Geyeraf7ecd62018-06-22 22:41:27 +0200274 Console.WriteLine('Using anonymous pipes ('+IntToStr(Integer(setup.hAnonRead))+' and '+IntToStr(Integer(setup.hAnonWrite))+')');
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200275 end
Jens Geyeraeda9872020-03-22 15:01:28 +0100276 else if IsSwitch( sArg, '--transport', sValue) then begin
Jens Geyer02230912019-04-03 01:12:51 +0200277 // --transport arg (=sockets) Transport: buffered, framed, http, winhttp, evhttp
Jens Geyeraeda9872020-03-22 15:01:28 +0100278 if sValue = 'buffered' then Include( setup.layered, trns_Buffered)
279 else if sValue = 'framed' then Include( setup.layered, trns_Framed)
280 else if sValue = 'http' then setup.endpoint := trns_MsXmlHttp
281 else if sValue = 'winhttp' then setup.endpoint := trns_WinHttp
282 else if sValue = 'evhttp' then setup.endpoint := trns_EvHttp // recognized, but not supported
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200283 else InvalidArgs;
284 end
Jens Geyeraeda9872020-03-22 15:01:28 +0100285 else if IsSwitch( sArg, '--protocol', sValue) then begin
Jens Geyerb360b652014-09-28 01:55:46 +0200286 // --protocol arg (=binary) Protocol: binary, compact, json
Jens Geyeraeda9872020-03-22 15:01:28 +0100287 if sValue = 'binary' then setup.protType := prot_Binary
288 else if sValue = 'compact' then setup.protType := prot_Compact
289 else if sValue = 'json' then setup.protType := prot_JSON
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200290 else InvalidArgs;
291 end
Jens Geyeraeda9872020-03-22 15:01:28 +0100292 else if IsSwitch( sArg, '--ssl', sValue) then begin
Jens Geyerb360b652014-09-28 01:55:46 +0200293 // --ssl Encrypted Transport using SSL
Jens Geyeraf7ecd62018-06-22 22:41:27 +0200294 setup.useSSL := TRUE;
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200295
296 end
Jens Geyeraeda9872020-03-22 15:01:28 +0100297 else if IsSwitch( sArg, '-n', sValue) or IsSwitch( sArg, '--testloops', sValue) then begin
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200298 // -n [ --testloops ] arg (=1) Number of Tests
Jens Geyer48d3bef2022-09-08 21:48:41 +0200299 FNumIterations := StrToIntDef( sValue, 0);
300 if FNumIterations <= 0
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200301 then InvalidArgs;
302
303 end
Jens Geyeraeda9872020-03-22 15:01:28 +0100304 else if IsSwitch( sArg, '-t', sValue) or IsSwitch( sArg, '--threads', sValue) then begin
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200305 // -t [ --threads ] arg (=1) Number of Test threads
Jens Geyer48d3bef2022-09-08 21:48:41 +0200306 FNumThreads := StrToIntDef( sValue, 0);
307 if FNumThreads <= 0
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200308 then InvalidArgs;
309 end
Jens Geyeraeda9872020-03-22 15:01:28 +0100310 else if IsSwitch( sArg, '--performance', sValue) then begin
Jens Geyerb342bd92019-06-03 20:27:00 +0200311 result := TPerformanceTests.Execute;
312 Exit;
313 end
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200314 else begin
315 InvalidArgs;
Roger Meier3bef8c22012-10-06 06:58:00 +0000316 end;
317 end;
318
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200319
Roger Meier79655fb2012-10-20 20:59:41 +0000320 // In the anonymous pipes mode the client is launched by the test server
321 // -> behave nicely and allow for attaching a debugger to this process
Jens Geyeraf7ecd62018-06-22 22:41:27 +0200322 if (setup.endpoint = trns_AnonPipes) and not IsDebuggerPresent
Roger Meier79655fb2012-10-20 20:59:41 +0000323 then MessageBox( 0, 'Attach Debugger and/or click OK to continue.',
324 'Thrift TestClient (Delphi)',
325 MB_OK or MB_ICONEXCLAMATION);
326
Jens Geyer48d3bef2022-09-08 21:48:41 +0200327 SetLength( threads, FNumThreads);
Roger Meier3bef8c22012-10-06 06:58:00 +0000328 dtStart := Now;
329
Jens Geyeraf7ecd62018-06-22 22:41:27 +0200330 // layered transports are not really meant to be stacked upon each other
331 if (trns_Framed in setup.layered) then begin
332 Console.WriteLine('Using framed transport');
333 end
334 else if (trns_Buffered in setup.layered) then begin
335 Console.WriteLine('Using buffered transport');
336 end;
Roger Meier3bef8c22012-10-06 06:58:00 +0000337
Jens Geyeraf7ecd62018-06-22 22:41:27 +0200338 Console.WriteLine(THRIFT_PROTOCOLS[setup.protType]+' protocol');
Roger Meier3bef8c22012-10-06 06:58:00 +0000339
Jens Geyer48d3bef2022-09-08 21:48:41 +0200340 if FNumThreads <> 1
341 then Console.WriteLine(IntToStr(FNumThreads)+' client threads');
342
343 if FNumIterations <> 1
344 then Console.WriteLine(IntToStr(FNumIterations)+' iterations');
345
346 for test := 0 to FNumThreads - 1 do begin
347 thread := TClientThread.Create( setup, FNumIterations, test, FNumThreads<>1);
Roger Meier3bef8c22012-10-06 06:58:00 +0000348 threads[test] := thread;
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200349 thread.Start;
Roger Meier3bef8c22012-10-06 06:58:00 +0000350 end;
351
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200352 result := 0;
Jens Geyer48d3bef2022-09-08 21:48:41 +0200353 for test := 0 to FNumThreads - 1 do begin
Jens Geyer14f5d502017-12-09 13:47:09 +0100354 threadExitCode := threads[test].WaitFor;
355 result := result or threadExitCode;
Jens Geyer14f5d502017-12-09 13:47:09 +0100356 threads[test].Free;
Jens Geyeraf7ecd62018-06-22 22:41:27 +0200357 threads[test] := nil;
Jens Geyer14f5d502017-12-09 13:47:09 +0100358 end;
Roger Meier3bef8c22012-10-06 06:58:00 +0000359
360 Console.Write('Total time: ' + IntToStr( MilliSecondsBetween(Now, dtStart)));
361
362 except
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200363 on E: EAbort do raise;
364 on E: Exception do begin
365 Console.WriteLine( E.Message + #10 + E.StackTrace);
366 raise;
Roger Meier3bef8c22012-10-06 06:58:00 +0000367 end;
368 end;
369
370 Console.WriteLine('');
371 Console.WriteLine('done!');
372end;
373
374{ TClientThread }
375
376procedure TClientThread.ClientTest;
377var
378 client : TThriftTest.Iface;
379 s : string;
380 i8 : ShortInt;
381 i32 : Integer;
382 i64 : Int64;
Jens Geyerfd1b3582014-12-13 23:42:58 +0100383 binOut,binIn : TBytes;
Jens Geyer62445c12022-06-29 00:00:00 +0200384 guidIn, guidOut : TGuid;
Roger Meier3bef8c22012-10-06 06:58:00 +0000385 dub : Double;
386 o : IXtruct;
387 o2 : IXtruct2;
388 i : IXtruct;
389 i2 : IXtruct2;
390 mapout : IThriftDictionary<Integer,Integer>;
391 mapin : IThriftDictionary<Integer,Integer>;
392 strmapout : IThriftDictionary<string,string>;
393 strmapin : IThriftDictionary<string,string>;
394 j : Integer;
395 first : Boolean;
396 key : Integer;
397 strkey : string;
398 listout : IThriftList<Integer>;
399 listin : IThriftList<Integer>;
Jens Geyer6a797b92022-09-05 13:55:37 +0200400 setout : IThriftHashSet<Integer>;
401 setin : IThriftHashSet<Integer>;
Roger Meier3bef8c22012-10-06 06:58:00 +0000402 ret : TNumberz;
403 uid : Int64;
404 mm : IThriftDictionary<Integer, IThriftDictionary<Integer, Integer>>;
405 pos : IThriftDictionary<Integer, Integer>;
406 neg : IThriftDictionary<Integer, Integer>;
407 m2 : IThriftDictionary<Integer, Integer>;
408 k2 : Integer;
409 insane : IInsanity;
410 truck : IXtruct;
411 whoa : IThriftDictionary<Int64, IThriftDictionary<TNumberz, IInsanity>>;
412 key64 : Int64;
413 val : IThriftDictionary<TNumberz, IInsanity>;
414 k2_2 : TNumberz;
415 k3 : TNumberz;
416 v2 : IInsanity;
417 userMap : IThriftDictionary<TNumberz, Int64>;
418 xtructs : IThriftList<IXtruct>;
419 x : IXtruct;
420 arg0 : ShortInt;
421 arg1 : Integer;
422 arg2 : Int64;
423 arg3 : IThriftDictionary<SmallInt, string>;
424 arg4 : TNumberz;
425 arg5 : Int64;
Jens Geyer9f7f11e2016-04-14 21:37:11 +0200426 {$IFDEF PerfTest}
Roger Meier3bef8c22012-10-06 06:58:00 +0000427 StartTick : Cardinal;
428 k : Integer;
Jens Geyer9f7f11e2016-04-14 21:37:11 +0200429 {$ENDIF}
Roger Meier3bef8c22012-10-06 06:58:00 +0000430 hello, goodbye : IXtruct;
431 crazy : IInsanity;
432 looney : IInsanity;
433 first_map : IThriftDictionary<TNumberz, IInsanity>;
434 second_map : IThriftDictionary<TNumberz, IInsanity>;
Jens Geyer540e3462016-12-28 14:25:41 +0100435 pair : TPair<TNumberz, TUserId>;
Jens Geyer85827152018-01-12 21:20:59 +0100436 testsize : TTestSize;
Roger Meier3bef8c22012-10-06 06:58:00 +0000437begin
438 client := TThriftTest.TClient.Create( FProtocol);
439 FTransport.Open;
440
Jens Geyer06045cf2013-03-27 20:26:25 +0200441 {$IFDEF StressTest}
442 StressTest( client);
443 {$ENDIF StressTest}
444
Jens Geyer17c3ad92017-09-05 20:31:27 +0200445 {$IFDEF Exceptions}
Roger Meier3bef8c22012-10-06 06:58:00 +0000446 // in-depth exception test
447 // (1) do we get an exception at all?
448 // (2) do we get the right exception?
449 // (3) does the exception contain the expected data?
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200450 StartTestGroup( 'testException', test_Exceptions);
Roger Meier3bef8c22012-10-06 06:58:00 +0000451 // case 1: exception type declared in IDL at the function call
452 try
453 client.testException('Xception');
454 Expect( FALSE, 'testException(''Xception''): must trow an exception');
455 except
456 on e:TXception do begin
457 Expect( e.ErrorCode = 1001, 'error code');
458 Expect( e.Message_ = 'Xception', 'error message');
459 Console.WriteLine( ' = ' + IntToStr(e.ErrorCode) + ', ' + e.Message_ );
460 end;
461 on e:TTransportException do Expect( FALSE, 'Unexpected : "'+e.ToString+'"');
Jens Geyeraf7ecd62018-06-22 22:41:27 +0200462 on e:Exception do Expect( FALSE, 'Unexpected exception "'+e.ClassName+'": '+e.Message);
Roger Meier3bef8c22012-10-06 06:58:00 +0000463 end;
464
Jens Geyercc8c2c62021-03-29 22:38:30 +0200465 // re-open connection if needed
466 if not FTransport.IsOpen
467 then FTransport.Open;
468
Roger Meier3bef8c22012-10-06 06:58:00 +0000469 // case 2: exception type NOT declared in IDL at the function call
470 // this will close the connection
471 try
472 client.testException('TException');
473 Expect( FALSE, 'testException(''TException''): must trow an exception');
474 except
475 on e:TTransportException do begin
476 Console.WriteLine( e.ClassName+' = '+e.Message); // this is what we get
Roger Meier3bef8c22012-10-06 06:58:00 +0000477 end;
Jens Geyer6bbbf192014-09-07 01:45:56 +0200478 on e:TApplicationException do begin
479 Console.WriteLine( e.ClassName+' = '+e.Message); // this is what we get
Jens Geyer6bbbf192014-09-07 01:45:56 +0200480 end;
Jens Geyeraf7ecd62018-06-22 22:41:27 +0200481 on e:TException do Expect( FALSE, 'Unexpected exception "'+e.ClassName+'": '+e.Message);
482 on e:Exception do Expect( FALSE, 'Unexpected exception "'+e.ClassName+'": '+e.Message);
Roger Meier3bef8c22012-10-06 06:58:00 +0000483 end;
484
Jens Geyer6f6aa8a2016-03-10 19:47:12 +0100485
Jens Geyer2ad6c302015-02-26 19:38:53 +0100486 if FTransport.IsOpen then FTransport.Close;
487 FTransport.Open; // re-open connection, server has already closed
Jens Geyer6f6aa8a2016-03-10 19:47:12 +0100488
Jens Geyer2ad6c302015-02-26 19:38:53 +0100489
Roger Meier3bef8c22012-10-06 06:58:00 +0000490 // case 3: no exception
491 try
492 client.testException('something');
493 Expect( TRUE, 'testException(''something''): must not trow an exception');
494 except
495 on e:TTransportException do Expect( FALSE, 'Unexpected : "'+e.ToString+'"');
Jens Geyeraf7ecd62018-06-22 22:41:27 +0200496 on e:Exception do Expect( FALSE, 'Unexpected exception "'+e.ClassName+'": '+e.Message);
Roger Meier3bef8c22012-10-06 06:58:00 +0000497 end;
Jens Geyer17c3ad92017-09-05 20:31:27 +0200498 {$ENDIF Exceptions}
Roger Meier3bef8c22012-10-06 06:58:00 +0000499
Jens Geyercc8c2c62021-03-29 22:38:30 +0200500 // re-open connection if needed
501 if not FTransport.IsOpen
502 then FTransport.Open;
Roger Meier3bef8c22012-10-06 06:58:00 +0000503
504 // simple things
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200505 StartTestGroup( 'simple Thrift calls', test_BaseTypes);
Roger Meier3bef8c22012-10-06 06:58:00 +0000506 client.testVoid();
507 Expect( TRUE, 'testVoid()'); // success := no exception
508
Jens Geyer39ba6b72015-09-22 00:00:49 +0200509 s := BoolToString( client.testBool(TRUE));
510 Expect( s = BoolToString(TRUE), 'testBool(TRUE) = '+s);
511 s := BoolToString( client.testBool(FALSE));
512 Expect( s = BoolToString(FALSE), 'testBool(FALSE) = '+s);
513
Roger Meier3bef8c22012-10-06 06:58:00 +0000514 s := client.testString('Test');
515 Expect( s = 'Test', 'testString(''Test'') = "'+s+'"');
516
Jens Geyercf892d42017-09-09 10:08:22 +0200517 s := client.testString(''); // empty string
518 Expect( s = '', 'testString('''') = "'+s+'"');
519
Jens Geyer06045cf2013-03-27 20:26:25 +0200520 s := client.testString(HUGE_TEST_STRING);
521 Expect( length(s) = length(HUGE_TEST_STRING),
Konrad Grochowski3b5dacb2014-11-24 10:55:31 +0100522 'testString( length(HUGE_TEST_STRING) = '+IntToStr(Length(HUGE_TEST_STRING))+') '
Jens Geyer06045cf2013-03-27 20:26:25 +0200523 +'=> length(result) = '+IntToStr(Length(s)));
524
Roger Meier3bef8c22012-10-06 06:58:00 +0000525 i8 := client.testByte(1);
526 Expect( i8 = 1, 'testByte(1) = ' + IntToStr( i8 ));
527
528 i32 := client.testI32(-1);
529 Expect( i32 = -1, 'testI32(-1) = ' + IntToStr(i32));
530
531 Console.WriteLine('testI64(-34359738368)');
532 i64 := client.testI64(-34359738368);
533 Expect( i64 = -34359738368, 'testI64(-34359738368) = ' + IntToStr( i64));
534
Jens Geyer62445c12022-06-29 00:00:00 +0200535 guidOut := StringToGUID('{00112233-4455-6677-8899-AABBCCDDEEFF}');
536 Console.WriteLine('testUuid('+GUIDToString(guidOut)+')');
537 try
538 guidIn := client.testUuid(guidOut);
539 Expect( IsEqualGUID(guidIn, guidOut), 'testUuid('+GUIDToString(guidOut)+') = '+GUIDToString(guidIn));
540 except
541 on e:TApplicationException do Console.WriteLine('testUuid(): '+e.Message);
542 on e:Exception do Expect( FALSE, 'testUuid(): Unexpected exception "'+e.ClassName+'": '+e.Message);
543 end;
544
Jens Geyerd4df9172017-10-25 22:30:23 +0200545 // random binary small
Jens Geyer85827152018-01-12 21:20:59 +0100546 for testsize := Low(TTestSize) to High(TTestSize) do begin
547 binOut := PrepareBinaryData( TRUE, testsize);
Jens Geyerbd1a2732019-06-26 22:52:44 +0200548 Console.WriteLine('testBinary('+IntToStr(Length(binOut))+' bytes)');
Jens Geyer85827152018-01-12 21:20:59 +0100549 try
550 binIn := client.testBinary(binOut);
Jens Geyerbd1a2732019-06-26 22:52:44 +0200551 Expect( Length(binOut) = Length(binIn), 'testBinary('+IntToStr(Length(binOut))+' bytes): '+IntToStr(Length(binIn))+' bytes received');
Jens Geyer85827152018-01-12 21:20:59 +0100552 i32 := Min( Length(binOut), Length(binIn));
Jens Geyerbd1a2732019-06-26 22:52:44 +0200553 Expect( CompareMem( binOut, binIn, i32), 'testBinary('+IntToStr(Length(binOut))+' bytes): validating received data');
Jens Geyer85827152018-01-12 21:20:59 +0100554 except
555 on e:TApplicationException do Console.WriteLine('testBinary(): '+e.Message);
556 on e:Exception do Expect( FALSE, 'testBinary(): Unexpected exception "'+e.ClassName+'": '+e.Message);
557 end;
Jens Geyercf892d42017-09-09 10:08:22 +0200558 end;
559
Roger Meier3bef8c22012-10-06 06:58:00 +0000560 Console.WriteLine('testDouble(5.325098235)');
561 dub := client.testDouble(5.325098235);
562 Expect( abs(dub-5.325098235) < 1e-14, 'testDouble(5.325098235) = ' + FloatToStr( dub));
563
564 // structs
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200565 StartTestGroup( 'testStruct', test_Structs);
Roger Meier3bef8c22012-10-06 06:58:00 +0000566 Console.WriteLine('testStruct({''Zero'', 1, -3, -5})');
567 o := TXtructImpl.Create;
568 o.String_thing := 'Zero';
569 o.Byte_thing := 1;
570 o.I32_thing := -3;
571 o.I64_thing := -5;
572 i := client.testStruct(o);
573 Expect( i.String_thing = 'Zero', 'i.String_thing = "'+i.String_thing+'"');
574 Expect( i.Byte_thing = 1, 'i.Byte_thing = '+IntToStr(i.Byte_thing));
575 Expect( i.I32_thing = -3, 'i.I32_thing = '+IntToStr(i.I32_thing));
576 Expect( i.I64_thing = -5, 'i.I64_thing = '+IntToStr(i.I64_thing));
577 Expect( i.__isset_String_thing, 'i.__isset_String_thing = '+BoolToString(i.__isset_String_thing));
578 Expect( i.__isset_Byte_thing, 'i.__isset_Byte_thing = '+BoolToString(i.__isset_Byte_thing));
579 Expect( i.__isset_I32_thing, 'i.__isset_I32_thing = '+BoolToString(i.__isset_I32_thing));
580 Expect( i.__isset_I64_thing, 'i.__isset_I64_thing = '+BoolToString(i.__isset_I64_thing));
581
582 // nested structs
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200583 StartTestGroup( 'testNest', test_Structs);
Roger Meier3bef8c22012-10-06 06:58:00 +0000584 Console.WriteLine('testNest({1, {''Zero'', 1, -3, -5}, 5})');
585 o2 := TXtruct2Impl.Create;
586 o2.Byte_thing := 1;
587 o2.Struct_thing := o;
588 o2.I32_thing := 5;
589 i2 := client.testNest(o2);
590 i := i2.Struct_thing;
591 Expect( i.String_thing = 'Zero', 'i.String_thing = "'+i.String_thing+'"');
592 Expect( i.Byte_thing = 1, 'i.Byte_thing = '+IntToStr(i.Byte_thing));
593 Expect( i.I32_thing = -3, 'i.I32_thing = '+IntToStr(i.I32_thing));
594 Expect( i.I64_thing = -5, 'i.I64_thing = '+IntToStr(i.I64_thing));
595 Expect( i2.Byte_thing = 1, 'i2.Byte_thing = '+IntToStr(i2.Byte_thing));
596 Expect( i2.I32_thing = 5, 'i2.I32_thing = '+IntToStr(i2.I32_thing));
597 Expect( i.__isset_String_thing, 'i.__isset_String_thing = '+BoolToString(i.__isset_String_thing));
598 Expect( i.__isset_Byte_thing, 'i.__isset_Byte_thing = '+BoolToString(i.__isset_Byte_thing));
599 Expect( i.__isset_I32_thing, 'i.__isset_I32_thing = '+BoolToString(i.__isset_I32_thing));
600 Expect( i.__isset_I64_thing, 'i.__isset_I64_thing = '+BoolToString(i.__isset_I64_thing));
601 Expect( i2.__isset_Byte_thing, 'i2.__isset_Byte_thing');
602 Expect( i2.__isset_I32_thing, 'i2.__isset_I32_thing');
603
604 // map<type1,type2>: A map of strictly unique keys to values.
605 // Translates to an STL map, Java HashMap, PHP associative array, Python/Ruby dictionary, etc.
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200606 StartTestGroup( 'testMap', test_Containers);
Roger Meier3bef8c22012-10-06 06:58:00 +0000607 mapout := TThriftDictionaryImpl<Integer,Integer>.Create;
608 for j := 0 to 4 do
609 begin
610 mapout.AddOrSetValue( j, j - 10);
611 end;
612 Console.Write('testMap({');
613 first := True;
614 for key in mapout.Keys do
615 begin
616 if first
617 then first := False
618 else Console.Write( ', ' );
619 Console.Write( IntToStr( key) + ' => ' + IntToStr( mapout[key]));
620 end;
621 Console.WriteLine('})');
622
623 mapin := client.testMap( mapout );
624 Expect( mapin.Count = mapout.Count, 'testMap: mapin.Count = mapout.Count');
625 for j := 0 to 4 do
626 begin
627 Expect( mapout.ContainsKey(j), 'testMap: mapout.ContainsKey('+IntToStr(j)+') = '+BoolToString(mapout.ContainsKey(j)));
628 end;
629 for key in mapin.Keys do
630 begin
631 Expect( mapin[key] = mapout[key], 'testMap: '+IntToStr(key) + ' => ' + IntToStr( mapin[key]));
632 Expect( mapin[key] = key - 10, 'testMap: mapin['+IntToStr(key)+'] = '+IntToStr( mapin[key]));
633 end;
634
635
636 // map<type1,type2>: A map of strictly unique keys to values.
637 // Translates to an STL map, Java HashMap, PHP associative array, Python/Ruby dictionary, etc.
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200638 StartTestGroup( 'testStringMap', test_Containers);
Roger Meier3bef8c22012-10-06 06:58:00 +0000639 strmapout := TThriftDictionaryImpl<string,string>.Create;
640 for j := 0 to 4 do
641 begin
642 strmapout.AddOrSetValue( IntToStr(j), IntToStr(j - 10));
643 end;
644 Console.Write('testStringMap({');
645 first := True;
646 for strkey in strmapout.Keys do
647 begin
648 if first
649 then first := False
650 else Console.Write( ', ' );
651 Console.Write( strkey + ' => ' + strmapout[strkey]);
652 end;
653 Console.WriteLine('})');
654
655 strmapin := client.testStringMap( strmapout );
656 Expect( strmapin.Count = strmapout.Count, 'testStringMap: strmapin.Count = strmapout.Count');
657 for j := 0 to 4 do
658 begin
659 Expect( strmapout.ContainsKey(IntToStr(j)),
660 'testStringMap: strmapout.ContainsKey('+IntToStr(j)+') = '
661 + BoolToString(strmapout.ContainsKey(IntToStr(j))));
662 end;
663 for strkey in strmapin.Keys do
664 begin
665 Expect( strmapin[strkey] = strmapout[strkey], 'testStringMap: '+strkey + ' => ' + strmapin[strkey]);
666 Expect( strmapin[strkey] = IntToStr( StrToInt(strkey) - 10), 'testStringMap: strmapin['+strkey+'] = '+strmapin[strkey]);
667 end;
668
669
670 // set<type>: An unordered set of unique elements.
671 // Translates to an STL set, Java HashSet, set in Python, etc.
672 // Note: PHP does not support sets, so it is treated similar to a List
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200673 StartTestGroup( 'testSet', test_Containers);
Jens Geyer6a797b92022-09-05 13:55:37 +0200674 setout := TThriftHashSetImpl<Integer>.Create;
Roger Meier3bef8c22012-10-06 06:58:00 +0000675 for j := -2 to 2 do
676 begin
677 setout.Add( j );
678 end;
679 Console.Write('testSet({');
680 first := True;
681 for j in setout do
682 begin
683 if first
684 then first := False
685 else Console.Write(', ');
686 Console.Write(IntToStr( j));
687 end;
688 Console.WriteLine('})');
689
690 setin := client.testSet(setout);
691 Expect( setin.Count = setout.Count, 'testSet: setin.Count = setout.Count');
692 Expect( setin.Count = 5, 'testSet: setin.Count = '+IntToStr(setin.Count));
693 for j := -2 to 2 do // unordered, we can't rely on the order => test for known elements only
694 begin
695 Expect( setin.Contains(j), 'testSet: setin.Contains('+IntToStr(j)+') => '+BoolToString(setin.Contains(j)));
696 end;
697
698 // list<type>: An ordered list of elements.
699 // Translates to an STL vector, Java ArrayList, native arrays in scripting languages, etc.
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200700 StartTestGroup( 'testList', test_Containers);
Roger Meier3bef8c22012-10-06 06:58:00 +0000701 listout := TThriftListImpl<Integer>.Create;
702 listout.Add( +1);
703 listout.Add( -2);
704 listout.Add( +3);
705 listout.Add( -4);
706 listout.Add( 0);
707 Console.Write('testList({');
708 first := True;
709 for j in listout do
710 begin
711 if first
712 then first := False
713 else Console.Write(', ');
714 Console.Write(IntToStr( j));
715 end;
716 Console.WriteLine('})');
717
718 listin := client.testList(listout);
719 Expect( listin.Count = listout.Count, 'testList: listin.Count = listout.Count');
720 Expect( listin.Count = 5, 'testList: listin.Count = '+IntToStr(listin.Count));
721 Expect( listin[0] = +1, 'listin[0] = '+IntToStr( listin[0]));
722 Expect( listin[1] = -2, 'listin[1] = '+IntToStr( listin[1]));
723 Expect( listin[2] = +3, 'listin[2] = '+IntToStr( listin[2]));
724 Expect( listin[3] = -4, 'listin[3] = '+IntToStr( listin[3]));
725 Expect( listin[4] = 0, 'listin[4] = '+IntToStr( listin[4]));
726
727 // enums
728 ret := client.testEnum(TNumberz.ONE);
729 Expect( ret = TNumberz.ONE, 'testEnum(ONE) = '+IntToStr(Ord(ret)));
730
731 ret := client.testEnum(TNumberz.TWO);
732 Expect( ret = TNumberz.TWO, 'testEnum(TWO) = '+IntToStr(Ord(ret)));
733
734 ret := client.testEnum(TNumberz.THREE);
735 Expect( ret = TNumberz.THREE, 'testEnum(THREE) = '+IntToStr(Ord(ret)));
736
737 ret := client.testEnum(TNumberz.FIVE);
738 Expect( ret = TNumberz.FIVE, 'testEnum(FIVE) = '+IntToStr(Ord(ret)));
739
740 ret := client.testEnum(TNumberz.EIGHT);
741 Expect( ret = TNumberz.EIGHT, 'testEnum(EIGHT) = '+IntToStr(Ord(ret)));
742
743
744 // typedef
745 uid := client.testTypedef(309858235082523);
746 Expect( uid = 309858235082523, 'testTypedef(309858235082523) = '+IntToStr(uid));
747
748
749 // maps of maps
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200750 StartTestGroup( 'testMapMap(1)', test_Containers);
Roger Meier3bef8c22012-10-06 06:58:00 +0000751 mm := client.testMapMap(1);
752 Console.Write(' = {');
753 for key in mm.Keys do
754 begin
755 Console.Write( IntToStr( key) + ' => {');
756 m2 := mm[key];
757 for k2 in m2.Keys do
758 begin
759 Console.Write( IntToStr( k2) + ' => ' + IntToStr( m2[k2]) + ', ');
760 end;
761 Console.Write('}, ');
762 end;
763 Console.WriteLine('}');
764
765 // verify result data
766 Expect( mm.Count = 2, 'mm.Count = '+IntToStr(mm.Count));
767 pos := mm[4];
768 neg := mm[-4];
769 for j := 1 to 4 do
770 begin
771 Expect( pos[j] = j, 'pos[j] = '+IntToStr(pos[j]));
772 Expect( neg[-j] = -j, 'neg[-j] = '+IntToStr(neg[-j]));
773 end;
774
775
776
777 // insanity
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200778 StartTestGroup( 'testInsanity', test_Structs);
Roger Meier3bef8c22012-10-06 06:58:00 +0000779 insane := TInsanityImpl.Create;
780 insane.UserMap := TThriftDictionaryImpl<TNumberz, Int64>.Create;
781 insane.UserMap.AddOrSetValue( TNumberz.FIVE, 5000);
782 truck := TXtructImpl.Create;
783 truck.String_thing := 'Truck';
Jens Geyer540e3462016-12-28 14:25:41 +0100784 truck.Byte_thing := -8; // byte is signed
785 truck.I32_thing := 32;
786 truck.I64_thing := 64;
Roger Meier3bef8c22012-10-06 06:58:00 +0000787 insane.Xtructs := TThriftListImpl<IXtruct>.Create;
788 insane.Xtructs.Add( truck );
789 whoa := client.testInsanity( insane );
790 Console.Write(' = {');
791 for key64 in whoa.Keys do
792 begin
793 val := whoa[key64];
794 Console.Write( IntToStr( key64) + ' => {');
795 for k2_2 in val.Keys do
796 begin
797 v2 := val[k2_2];
798 Console.Write( IntToStr( Integer( k2_2)) + ' => {');
799 userMap := v2.UserMap;
800 Console.Write('{');
801 if userMap <> nil then
802 begin
803 for k3 in userMap.Keys do
804 begin
805 Console.Write( IntToStr( Integer( k3)) + ' => ' + IntToStr( userMap[k3]) + ', ');
806 end;
807 end else
808 begin
809 Console.Write('null');
810 end;
811 Console.Write('}, ');
812 xtructs := v2.Xtructs;
813 Console.Write('{');
814
815 if xtructs <> nil then
816 begin
817 for x in xtructs do
818 begin
819 Console.Write('{"' + x.String_thing + '", ' +
820 IntToStr( x.Byte_thing) + ', ' +
821 IntToStr( x.I32_thing) + ', ' +
822 IntToStr( x.I32_thing) + '}, ');
823 end;
824 end else
825 begin
826 Console.Write('null');
827 end;
828 Console.Write('}');
829 Console.Write('}, ');
830 end;
831 Console.Write('}, ');
832 end;
833 Console.WriteLine('}');
834
Jens Geyer540e3462016-12-28 14:25:41 +0100835 (**
836 * So you think you've got this all worked, out eh?
837 *
838 * Creates a the returned map with these values and prints it out:
839 * { 1 => { 2 => argument,
840 * 3 => argument,
841 * },
842 * 2 => { 6 => <empty Insanity struct>, },
843 * }
844 * @return map<UserId, map<Numberz,Insanity>> - a map with the above values
845 *)
846
Roger Meier3bef8c22012-10-06 06:58:00 +0000847 // verify result data
848 Expect( whoa.Count = 2, 'whoa.Count = '+IntToStr(whoa.Count));
849 //
850 first_map := whoa[1];
851 second_map := whoa[2];
852 Expect( first_map.Count = 2, 'first_map.Count = '+IntToStr(first_map.Count));
853 Expect( second_map.Count = 1, 'second_map.Count = '+IntToStr(second_map.Count));
854 //
855 looney := second_map[TNumberz.SIX];
856 Expect( Assigned(looney), 'Assigned(looney) = '+BoolToString(Assigned(looney)));
857 Expect( not looney.__isset_UserMap, 'looney.__isset_UserMap = '+BoolToString(looney.__isset_UserMap));
858 Expect( not looney.__isset_Xtructs, 'looney.__isset_Xtructs = '+BoolToString(looney.__isset_Xtructs));
859 //
860 for ret in [TNumberz.TWO, TNumberz.THREE] do begin
861 crazy := first_map[ret];
862 Console.WriteLine('first_map['+intToStr(Ord(ret))+']');
863
864 Expect( crazy.__isset_UserMap, 'crazy.__isset_UserMap = '+BoolToString(crazy.__isset_UserMap));
865 Expect( crazy.__isset_Xtructs, 'crazy.__isset_Xtructs = '+BoolToString(crazy.__isset_Xtructs));
866
Jens Geyer540e3462016-12-28 14:25:41 +0100867 Expect( crazy.UserMap.Count = insane.UserMap.Count, 'crazy.UserMap.Count = '+IntToStr(crazy.UserMap.Count));
868 for pair in insane.UserMap do begin
869 Expect( crazy.UserMap[pair.Key] = pair.Value, 'crazy.UserMap['+IntToStr(Ord(pair.key))+'] = '+IntToStr(crazy.UserMap[pair.Key]));
870 end;
Roger Meier3bef8c22012-10-06 06:58:00 +0000871
Jens Geyer540e3462016-12-28 14:25:41 +0100872 Expect( crazy.Xtructs.Count = insane.Xtructs.Count, 'crazy.Xtructs.Count = '+IntToStr(crazy.Xtructs.Count));
873 for arg0 := 0 to insane.Xtructs.Count-1 do begin
874 hello := insane.Xtructs[arg0];
875 goodbye := crazy.Xtructs[arg0];
876 Expect( goodbye.String_thing = hello.String_thing, 'goodbye.String_thing = '+goodbye.String_thing);
877 Expect( goodbye.Byte_thing = hello.Byte_thing, 'goodbye.Byte_thing = '+IntToStr(goodbye.Byte_thing));
878 Expect( goodbye.I32_thing = hello.I32_thing, 'goodbye.I32_thing = '+IntToStr(goodbye.I32_thing));
879 Expect( goodbye.I64_thing = hello.I64_thing, 'goodbye.I64_thing = '+IntToStr(goodbye.I64_thing));
880 end;
Roger Meier3bef8c22012-10-06 06:58:00 +0000881 end;
882
883
884 // multi args
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200885 StartTestGroup( 'testMulti', test_BaseTypes);
Roger Meier3bef8c22012-10-06 06:58:00 +0000886 arg0 := 1;
887 arg1 := 2;
888 arg2 := High(Int64);
889 arg3 := TThriftDictionaryImpl<SmallInt, string>.Create;
890 arg3.AddOrSetValue( 1, 'one');
891 arg4 := TNumberz.FIVE;
892 arg5 := 5000000;
893 Console.WriteLine('Test Multi(' + IntToStr( arg0) + ',' +
894 IntToStr( arg1) + ',' + IntToStr( arg2) + ',' +
895 arg3.ToString + ',' + IntToStr( Integer( arg4)) + ',' +
896 IntToStr( arg5) + ')');
897
898 i := client.testMulti( arg0, arg1, arg2, arg3, arg4, arg5);
899 Expect( i.String_thing = 'Hello2', 'testMulti: i.String_thing = "'+i.String_thing+'"');
900 Expect( i.Byte_thing = arg0, 'testMulti: i.Byte_thing = '+IntToStr(i.Byte_thing));
901 Expect( i.I32_thing = arg1, 'testMulti: i.I32_thing = '+IntToStr(i.I32_thing));
902 Expect( i.I64_thing = arg2, 'testMulti: i.I64_thing = '+IntToStr(i.I64_thing));
903 Expect( i.__isset_String_thing, 'testMulti: i.__isset_String_thing = '+BoolToString(i.__isset_String_thing));
904 Expect( i.__isset_Byte_thing, 'testMulti: i.__isset_Byte_thing = '+BoolToString(i.__isset_Byte_thing));
905 Expect( i.__isset_I32_thing, 'testMulti: i.__isset_I32_thing = '+BoolToString(i.__isset_I32_thing));
906 Expect( i.__isset_I64_thing, 'testMulti: i.__isset_I64_thing = '+BoolToString(i.__isset_I64_thing));
907
908 // multi exception
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200909 StartTestGroup( 'testMultiException(1)', test_Exceptions);
Roger Meier3bef8c22012-10-06 06:58:00 +0000910 try
911 i := client.testMultiException( 'need more pizza', 'run out of beer');
912 Expect( i.String_thing = 'run out of beer', 'i.String_thing = "' +i.String_thing+ '"');
913 Expect( i.__isset_String_thing, 'i.__isset_String_thing = '+BoolToString(i.__isset_String_thing));
Jens Geyer6bbbf192014-09-07 01:45:56 +0200914 { this is not necessarily true, these fields are default-serialized
Jens Geyerd5436f52014-10-03 19:50:38 +0200915 Expect( not i.__isset_Byte_thing, 'i.__isset_Byte_thing = '+BoolToString(i.__isset_Byte_thing));
Roger Meier3bef8c22012-10-06 06:58:00 +0000916 Expect( not i.__isset_I32_thing, 'i.__isset_I32_thing = '+BoolToString(i.__isset_I32_thing));
917 Expect( not i.__isset_I64_thing, 'i.__isset_I64_thing = '+BoolToString(i.__isset_I64_thing));
Jens Geyerd5436f52014-10-03 19:50:38 +0200918 }
Roger Meier3bef8c22012-10-06 06:58:00 +0000919 except
Jens Geyeraf7ecd62018-06-22 22:41:27 +0200920 on e:Exception do Expect( FALSE, 'Unexpected exception "'+e.ClassName+'": '+e.Message);
Roger Meier3bef8c22012-10-06 06:58:00 +0000921 end;
922
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200923 StartTestGroup( 'testMultiException(Xception)', test_Exceptions);
Roger Meier3bef8c22012-10-06 06:58:00 +0000924 try
925 i := client.testMultiException( 'Xception', 'second test');
926 Expect( FALSE, 'testMultiException(''Xception''): must trow an exception');
927 except
928 on x:TXception do begin
929 Expect( x.__isset_ErrorCode, 'x.__isset_ErrorCode = '+BoolToString(x.__isset_ErrorCode));
Jens Geyercd7a2aa2022-10-17 14:21:18 +0200930 Expect( x.__isset_Message, 'x.__isset_Message = '+BoolToString(x.__isset_Message));
Roger Meier3bef8c22012-10-06 06:58:00 +0000931 Expect( x.ErrorCode = 1001, 'x.ErrorCode = '+IntToStr(x.ErrorCode));
932 Expect( x.Message_ = 'This is an Xception', 'x.Message = "'+x.Message_+'"');
933 end;
Jens Geyeraf7ecd62018-06-22 22:41:27 +0200934 on e:Exception do Expect( FALSE, 'Unexpected exception "'+e.ClassName+'": '+e.Message);
Roger Meier3bef8c22012-10-06 06:58:00 +0000935 end;
936
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200937 StartTestGroup( 'testMultiException(Xception2)', test_Exceptions);
Roger Meier3bef8c22012-10-06 06:58:00 +0000938 try
939 i := client.testMultiException( 'Xception2', 'third test');
940 Expect( FALSE, 'testMultiException(''Xception2''): must trow an exception');
941 except
942 on x:TXception2 do begin
943 Expect( x.__isset_ErrorCode, 'x.__isset_ErrorCode = '+BoolToString(x.__isset_ErrorCode));
944 Expect( x.__isset_Struct_thing, 'x.__isset_Struct_thing = '+BoolToString(x.__isset_Struct_thing));
945 Expect( x.ErrorCode = 2002, 'x.ErrorCode = '+IntToStr(x.ErrorCode));
946 Expect( x.Struct_thing.String_thing = 'This is an Xception2', 'x.Struct_thing.String_thing = "'+x.Struct_thing.String_thing+'"');
947 Expect( x.Struct_thing.__isset_String_thing, 'x.Struct_thing.__isset_String_thing = '+BoolToString(x.Struct_thing.__isset_String_thing));
Jens Geyer6bbbf192014-09-07 01:45:56 +0200948 { this is not necessarily true, these fields are default-serialized
Roger Meier3bef8c22012-10-06 06:58:00 +0000949 Expect( not x.Struct_thing.__isset_Byte_thing, 'x.Struct_thing.__isset_Byte_thing = '+BoolToString(x.Struct_thing.__isset_Byte_thing));
950 Expect( not x.Struct_thing.__isset_I32_thing, 'x.Struct_thing.__isset_I32_thing = '+BoolToString(x.Struct_thing.__isset_I32_thing));
951 Expect( not x.Struct_thing.__isset_I64_thing, 'x.Struct_thing.__isset_I64_thing = '+BoolToString(x.Struct_thing.__isset_I64_thing));
Jens Geyerd5436f52014-10-03 19:50:38 +0200952 }
Roger Meier3bef8c22012-10-06 06:58:00 +0000953 end;
Jens Geyeraf7ecd62018-06-22 22:41:27 +0200954 on e:Exception do Expect( FALSE, 'Unexpected exception "'+e.ClassName+'": '+e.Message);
Roger Meier3bef8c22012-10-06 06:58:00 +0000955 end;
956
957
958 // oneway functions
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200959 StartTestGroup( 'Test Oneway(1)', test_Unknown);
Roger Meier3bef8c22012-10-06 06:58:00 +0000960 client.testOneway(1);
961 Expect( TRUE, 'Test Oneway(1)'); // success := no exception
962
963 // call time
Jens Geyer06045cf2013-03-27 20:26:25 +0200964 {$IFDEF PerfTest}
Roger Meier3bef8c22012-10-06 06:58:00 +0000965 StartTestGroup( 'Test Calltime()');
Jens Geyer9f7f11e2016-04-14 21:37:11 +0200966 StartTick := GetTickCount;
Roger Meier3bef8c22012-10-06 06:58:00 +0000967 for k := 0 to 1000 - 1 do
968 begin
969 client.testVoid();
970 end;
971 Console.WriteLine(' = ' + FloatToStr( (GetTickCount - StartTick) / 1000 ) + ' ms a testVoid() call' );
Jens Geyer06045cf2013-03-27 20:26:25 +0200972 {$ENDIF PerfTest}
Roger Meier3bef8c22012-10-06 06:58:00 +0000973
974 // no more tests here
Jens Geyerf8a1b7a2014-09-24 00:26:46 +0200975 StartTestGroup( '', test_Unknown);
Roger Meier3bef8c22012-10-06 06:58:00 +0000976end;
977
978
Jens Geyer14f5d502017-12-09 13:47:09 +0100979{$IFDEF SupportsAsync}
980procedure TClientThread.ClientAsyncTest;
981var
982 client : TThriftTest.IAsync;
983 s : string;
984 i8 : ShortInt;
985begin
986 StartTestGroup( 'Async Tests', test_Unknown);
987 client := TThriftTest.TClient.Create( FProtocol);
988 FTransport.Open;
989
990 // oneway void functions
991 client.testOnewayAsync(1).Wait;
992 Expect( TRUE, 'Test Oneway(1)'); // success := no exception
993
994 // normal functions
995 s := client.testStringAsync(HUGE_TEST_STRING).Value;
996 Expect( length(s) = length(HUGE_TEST_STRING),
997 'testString( length(HUGE_TEST_STRING) = '+IntToStr(Length(HUGE_TEST_STRING))+') '
998 +'=> length(result) = '+IntToStr(Length(s)));
999
1000 i8 := client.testByte(1).Value;
1001 Expect( i8 = 1, 'testByte(1) = ' + IntToStr( i8 ));
1002end;
1003{$ENDIF}
1004
1005
Jens Geyer718f6ee2013-09-06 21:02:34 +02001006{$IFDEF StressTest}
Jens Geyer06045cf2013-03-27 20:26:25 +02001007procedure TClientThread.StressTest(const client : TThriftTest.Iface);
1008begin
1009 while TRUE do begin
1010 try
1011 if not FTransport.IsOpen then FTransport.Open; // re-open connection, server has already closed
1012 try
1013 client.testString('Test');
1014 Write('.');
1015 finally
1016 if FTransport.IsOpen then FTransport.Close;
1017 end;
1018 except
1019 on e:Exception do Writeln(#10+e.message);
1020 end;
1021 end;
1022end;
Jens Geyer718f6ee2013-09-06 21:02:34 +02001023{$ENDIF}
Jens Geyer06045cf2013-03-27 20:26:25 +02001024
Jens Geyerfd1b3582014-12-13 23:42:58 +01001025
Jens Geyer82fc93e2024-05-24 23:36:07 +02001026procedure TClientThread.StartTestGroup( const aGroup : string; const aTest : TClientTestGroup);
Jens Geyerfd1b3582014-12-13 23:42:58 +01001027begin
Jens Geyer82fc93e2024-05-24 23:36:07 +02001028 FLogger.StartTestGroup( aGroup, aTest);
Roger Meier3bef8c22012-10-06 06:58:00 +00001029end;
1030
1031
1032procedure TClientThread.Expect( aTestResult : Boolean; const aTestInfo : string);
1033begin
Jens Geyer82fc93e2024-05-24 23:36:07 +02001034 FLogger.Expect( aTestResult, aTestInfo);
Roger Meier3bef8c22012-10-06 06:58:00 +00001035end;
1036
1037
Jens Geyerf8a1b7a2014-09-24 00:26:46 +02001038function TClientThread.CalculateExitCode : Byte;
Jens Geyer82fc93e2024-05-24 23:36:07 +02001039var test : TClientTestGroup;
1040 failed, executed : TClientTestGroups;
Jens Geyerf8a1b7a2014-09-24 00:26:46 +02001041begin
1042 result := EXITCODE_SUCCESS;
Jens Geyer82fc93e2024-05-24 23:36:07 +02001043 FLogger.QueryTestStats( failed, executed);
1044 for test := Low(TClientTestGroup) to High(TClientTestGroup) do begin
1045 if (test in failed) or not (test in executed)
Jens Geyerf8a1b7a2014-09-24 00:26:46 +02001046 then result := result or MAP_FAILURES_TO_EXITCODE_BITS[test];
1047 end;
1048end;
1049
1050
Jens Geyer48d3bef2022-09-08 21:48:41 +02001051constructor TClientThread.Create( const aSetup : TTestSetup; const aNumIteration, aThreadNo: Integer; const aLogThreadID : Boolean);
Roger Meier3bef8c22012-10-06 06:58:00 +00001052begin
Jens Geyeraf7ecd62018-06-22 22:41:27 +02001053 FSetup := aSetup;
Jens Geyer48d3bef2022-09-08 21:48:41 +02001054 FThreadNo := aThreadNo;
1055 FNumIterations := aNumIteration;
Jens Geyeraf7ecd62018-06-22 22:41:27 +02001056
Jens Geyer48d3bef2022-09-08 21:48:41 +02001057 FConsole := TThreadConsole.Create( Self, aLogThreadID);
Jens Geyer82fc93e2024-05-24 23:36:07 +02001058 FLogger := TTestLoggerImpl.Create;
Jens Geyeraf7ecd62018-06-22 22:41:27 +02001059
1060 inherited Create( TRUE);
Roger Meier3bef8c22012-10-06 06:58:00 +00001061end;
1062
1063destructor TClientThread.Destroy;
1064begin
1065 FreeAndNil( FConsole);
Jens Geyer82fc93e2024-05-24 23:36:07 +02001066 FLogger := nil; //-> Release
Roger Meier3bef8c22012-10-06 06:58:00 +00001067 inherited;
1068end;
1069
1070procedure TClientThread.Execute;
1071var
1072 i : Integer;
Roger Meier3bef8c22012-10-06 06:58:00 +00001073begin
1074 // perform all tests
1075 try
Jens Geyer82fc93e2024-05-24 23:36:07 +02001076 // builtin (quick) unit tests on one thread only
1077 if ThreadNo = 0
1078 then TQuickUnitTests.Execute(FLogger);
Jens Geyeraf7ecd62018-06-22 22:41:27 +02001079
1080 // must be run in the context of the thread
1081 InitializeProtocolTransportStack;
1082 try
Jens Geyer48d3bef2022-09-08 21:48:41 +02001083 for i := 0 to FNumIterations - 1 do begin
Jens Geyeraf7ecd62018-06-22 22:41:27 +02001084 ClientTest;
1085 {$IFDEF SupportsAsync}
1086 ClientAsyncTest;
1087 {$ENDIF}
1088 end;
1089
1090 // report the outcome
Jens Geyer82fc93e2024-05-24 23:36:07 +02001091 FLogger.ReportResults;
Jens Geyeraf7ecd62018-06-22 22:41:27 +02001092 SetReturnValue( CalculateExitCode);
1093
1094 finally
1095 ShutdownProtocolTransportStack;
Roger Meier3bef8c22012-10-06 06:58:00 +00001096 end;
Jens Geyeraf7ecd62018-06-22 22:41:27 +02001097
Roger Meier3bef8c22012-10-06 06:58:00 +00001098 except
1099 on e:Exception do Expect( FALSE, 'unexpected exception: "'+e.message+'"');
1100 end;
Jens Geyeraf7ecd62018-06-22 22:41:27 +02001101end;
Roger Meier3bef8c22012-10-06 06:58:00 +00001102
Roger Meier3bef8c22012-10-06 06:58:00 +00001103
Jens Geyera019cda2019-11-09 23:24:52 +01001104function TClientThread.InitializeHttpTransport( const aTimeoutSetting : Integer; const aConfig : IThriftConfiguration) : IHTTPClient;
Jens Geyer83ff7532019-06-06 22:46:03 +02001105var sUrl : string;
1106 comps : URL_COMPONENTS;
1107 dwChars : DWORD;
Jens Geyer02230912019-04-03 01:12:51 +02001108begin
1109 ASSERT( FSetup.endpoint in [trns_MsxmlHttp, trns_WinHttp]);
1110
1111 if FSetup.useSSL
1112 then sUrl := 'https://'
1113 else sUrl := 'http://';
1114
1115 sUrl := sUrl + FSetup.host;
1116
Jens Geyer83ff7532019-06-06 22:46:03 +02001117 // add the port number if necessary and at the right place
1118 FillChar( comps, SizeOf(comps), 0);
1119 comps.dwStructSize := SizeOf(comps);
1120 comps.dwSchemeLength := MAXINT;
1121 comps.dwHostNameLength := MAXINT;
1122 comps.dwUserNameLength := MAXINT;
1123 comps.dwPasswordLength := MAXINT;
1124 comps.dwUrlPathLength := MAXINT;
1125 comps.dwExtraInfoLength := MAXINT;
1126 Win32Check( WinHttpCrackUrl( PChar(sUrl), Length(sUrl), 0, comps));
Jens Geyer02230912019-04-03 01:12:51 +02001127 case FSetup.port of
Jens Geyer83ff7532019-06-06 22:46:03 +02001128 80 : if FSetup.useSSL then comps.nPort := FSetup.port;
1129 443 : if not FSetup.useSSL then comps.nPort := FSetup.port;
Jens Geyer02230912019-04-03 01:12:51 +02001130 else
Jens Geyer83ff7532019-06-06 22:46:03 +02001131 if FSetup.port > 0 then comps.nPort := FSetup.port;
Jens Geyer02230912019-04-03 01:12:51 +02001132 end;
Jens Geyer83ff7532019-06-06 22:46:03 +02001133 dwChars := Length(sUrl) + 64;
1134 SetLength( sUrl, dwChars);
1135 Win32Check( WinHttpCreateUrl( comps, 0, @sUrl[1], dwChars));
1136 SetLength( sUrl, dwChars);
1137
Jens Geyer02230912019-04-03 01:12:51 +02001138
1139 Console.WriteLine('Target URL: '+sUrl);
1140 case FSetup.endpoint of
Jens Geyera019cda2019-11-09 23:24:52 +01001141 trns_MsxmlHttp : result := TMsxmlHTTPClientImpl.Create( sUrl, aConfig);
1142 trns_WinHttp : result := TWinHTTPClientImpl.Create( sUrl, aConfig);
Jens Geyer02230912019-04-03 01:12:51 +02001143 else
1144 raise Exception.Create(ENDPOINT_TRANSPORTS[FSetup.endpoint]+' unhandled case');
1145 end;
1146
1147 result.DnsResolveTimeout := aTimeoutSetting;
1148 result.ConnectionTimeout := aTimeoutSetting;
1149 result.SendTimeout := aTimeoutSetting;
1150 result.ReadTimeout := aTimeoutSetting;
1151end;
1152
1153
Jens Geyeraf7ecd62018-06-22 22:41:27 +02001154procedure TClientThread.InitializeProtocolTransportStack;
Jens Geyer02230912019-04-03 01:12:51 +02001155var streamtrans : IStreamTransport;
Jens Geyer47f63172019-06-06 22:42:58 +02001156 canSSL : Boolean;
Jens Geyeraf7ecd62018-06-22 22:41:27 +02001157const
1158 DEBUG_TIMEOUT = 30 * 1000;
1159 RELEASE_TIMEOUT = DEFAULT_THRIFT_TIMEOUT;
1160 PIPE_TIMEOUT = RELEASE_TIMEOUT;
1161 HTTP_TIMEOUTS = 10 * 1000;
1162begin
1163 // needed for HTTP clients as they utilize the MSXML COM components
1164 OleCheck( CoInitialize( nil));
1165
Jens Geyer47f63172019-06-06 22:42:58 +02001166 canSSL := FALSE;
Jens Geyeraf7ecd62018-06-22 22:41:27 +02001167 case FSetup.endpoint of
1168 trns_Sockets: begin
1169 Console.WriteLine('Using sockets ('+FSetup.host+' port '+IntToStr(FSetup.port)+')');
Jens Geyera019cda2019-11-09 23:24:52 +01001170 streamtrans := TSocketImpl.Create( FSetup.host, FSetup.port);
Jens Geyeraf7ecd62018-06-22 22:41:27 +02001171 FTransport := streamtrans;
1172 end;
1173
Jens Geyer02230912019-04-03 01:12:51 +02001174 trns_MsxmlHttp,
1175 trns_WinHttp: begin
Jens Geyeraf7ecd62018-06-22 22:41:27 +02001176 Console.WriteLine('Using HTTPClient');
Jens Geyer02230912019-04-03 01:12:51 +02001177 FTransport := InitializeHttpTransport( HTTP_TIMEOUTS);
Jens Geyer47f63172019-06-06 22:42:58 +02001178 canSSL := TRUE;
Jens Geyeraf7ecd62018-06-22 22:41:27 +02001179 end;
1180
1181 trns_EvHttp: begin
1182 raise Exception.Create(ENDPOINT_TRANSPORTS[FSetup.endpoint]+' transport not implemented');
1183 end;
1184
1185 trns_NamedPipes: begin
1186 streamtrans := TNamedPipeTransportClientEndImpl.Create( FSetup.sPipeName, 0, nil, PIPE_TIMEOUT, PIPE_TIMEOUT);
1187 FTransport := streamtrans;
1188 end;
1189
1190 trns_AnonPipes: begin
Jens Geyera019cda2019-11-09 23:24:52 +01001191 streamtrans := TAnonymousPipeTransportImpl.Create( FSetup.hAnonRead, FSetup.hAnonWrite, FALSE, PIPE_TIMEOUT);
Jens Geyeraf7ecd62018-06-22 22:41:27 +02001192 FTransport := streamtrans;
1193 end;
1194
1195 else
1196 raise Exception.Create('Unhandled endpoint transport');
1197 end;
1198 ASSERT( FTransport <> nil);
1199
1200 // layered transports are not really meant to be stacked upon each other
1201 if (trns_Framed in FSetup.layered) then begin
1202 FTransport := TFramedTransportImpl.Create( FTransport);
1203 end
1204 else if (trns_Buffered in FSetup.layered) and (streamtrans <> nil) then begin
1205 FTransport := TBufferedTransportImpl.Create( streamtrans, 32); // small buffer to test read()
1206 end;
1207
Jens Geyer47f63172019-06-06 22:42:58 +02001208 if FSetup.useSSL and not canSSL then begin
Jens Geyeraf7ecd62018-06-22 22:41:27 +02001209 raise Exception.Create('SSL/TLS not implemented');
1210 end;
1211
1212 // create protocol instance, default to BinaryProtocol
Jens Geyer3b686532021-07-01 23:04:08 +02001213 FProtocol := PROTOCOL_CLASSES[FSetup.protType].Create(FTransport);
Jens Geyeraf7ecd62018-06-22 22:41:27 +02001214 ASSERT( (FTransport <> nil) and (FProtocol <> nil));
1215end;
1216
1217
1218procedure TClientThread.ShutdownProtocolTransportStack;
1219begin
1220 try
1221 FProtocol := nil;
1222
1223 if FTransport <> nil then begin
Roger Meier3bef8c22012-10-06 06:58:00 +00001224 FTransport.Close;
1225 FTransport := nil;
1226 end;
Roger Meier3bef8c22012-10-06 06:58:00 +00001227
Jens Geyeraf7ecd62018-06-22 22:41:27 +02001228 finally
1229 CoUninitialize;
1230 end;
Roger Meier3bef8c22012-10-06 06:58:00 +00001231end;
1232
Jens Geyerf8a1b7a2014-09-24 00:26:46 +02001233
Roger Meier3bef8c22012-10-06 06:58:00 +00001234{ TThreadConsole }
1235
Jens Geyer48d3bef2022-09-08 21:48:41 +02001236constructor TThreadConsole.Create( const aThread: TClientThread; const aLogThreadID : Boolean);
Roger Meier3bef8c22012-10-06 06:58:00 +00001237begin
Jens Geyer718f6ee2013-09-06 21:02:34 +02001238 inherited Create;
Roger Meier3bef8c22012-10-06 06:58:00 +00001239 FThread := AThread;
Jens Geyer48d3bef2022-09-08 21:48:41 +02001240 FLogThreadID := aLogThreadID;
Roger Meier3bef8c22012-10-06 06:58:00 +00001241end;
1242
1243procedure TThreadConsole.Write(const S: string);
Roger Meier3bef8c22012-10-06 06:58:00 +00001244begin
Jens Geyer48d3bef2022-09-08 21:48:41 +02001245 if FLogThreadID
1246 then ConsoleHelper.Console.Write( IntToStr(FThread.ThreadNo)+'> '+S)
1247 else ConsoleHelper.Console.Write( S);
Roger Meier3bef8c22012-10-06 06:58:00 +00001248end;
1249
1250procedure TThreadConsole.WriteLine(const S: string);
Roger Meier3bef8c22012-10-06 06:58:00 +00001251begin
Jens Geyer48d3bef2022-09-08 21:48:41 +02001252 if FLogThreadID
1253 then ConsoleHelper.Console.WriteLine( IntToStr(FThread.ThreadNo)+'> '+S)
1254 else ConsoleHelper.Console.WriteLine( S);
Roger Meier3bef8c22012-10-06 06:58:00 +00001255end;
1256
Jens Geyer48d3bef2022-09-08 21:48:41 +02001257
Roger Meier3bef8c22012-10-06 06:58:00 +00001258initialization
Jens Geyer48d3bef2022-09-08 21:48:41 +02001259 TTestClient.FNumIterations := 1;
1260 TTestClient.FNumThreads := 1;
Roger Meier3bef8c22012-10-06 06:58:00 +00001261
1262end.