1 unit Tests.Rtti.Impl; 2 3 {$ifdef fpc} 4 {$mode objfpc}{$H+} 5 {$endif} 6 7 {.$define debug} 8 9 interface 10 11 uses 12 {$IFDEF FPC} 13 fpcunit,testregistry, testutils, 14 {$ELSE FPC} 15 TestFramework, 16 {$ENDIF FPC} 17 sysutils, typinfo, Rtti, 18 Tests.Rtti.Util; 19 20 { Note: Delphi does not provide a CreateImplementation for TRttiInvokableType 21 and its descendants, so these tests are disabled for Delphi } 22 23 type 24 TTestImpl = class(TTestCase) 25 private 26 InputArgs: array of TValue; 27 OutputArgs: array of TValue; 28 ResultValue: TValue; 29 InOutMapping: array of SizeInt; 30 InputUntypedTypes: array of PTypeInfo; 31 InvokedMethodName: String; 32 33 procedure OnHandleIntfMethod(aMethod: TRttiMethod; const aArgs: TValueArray; out aResult: TValue); 34 procedure DoIntfImpl(aIntf: IInterface; aTypeInfo: PTypeInfo; aIndex: LongInt; aInputArgs, aOutputArgs: TValueArray; aInOutMapping: array of SizeInt; aResult: TValue); 35 {$ifdef fpc} 36 procedure OnHandleInvokable(aInvokable: TRttiInvokableType; const aArgs: TValueArray; out aResult: TValue); 37 procedure DoMethodImpl(aTypeInfo: PTypeInfo; aInputArgs, aOutputArgs: TValueArray; aInOutMapping: array of SizeInt; aResult: TValue); 38 procedure DoProcImpl(aTypeInfo: PTypeInfo; aInputArgs, aOutputArgs: TValueArray; aInOutMapping: array of SizeInt; aResult: TValue); 39 {$ifndef InLazIDE} 40 {$ifdef fpc}generic{$endif} procedure GenDoIntfImpl<T: IInterface>(aIntf: T; aIndex: LongInt; aInputArgs, aOutputArgs: TValueArray; aInOutMapping: array of SizeInt; aResult: TValue); 41 {$ifdef fpc}generic{$endif} procedure GenDoMethodImpl<T>(aInputArgs, aOutputArgs: TValueArray; aInOutMapping: array of SizeInt; aResult: TValue); 42 {$ifdef fpc}generic{$endif} procedure GenDoProcImpl<T>(aInputArgs, aOutputArgs: TValueArray; aInOutMapping: array of SizeInt; aResult: TValue); 43 {$endif} 44 {$endif} 45 {$ifdef fpc} 46 procedure Status(const aMsg: String); inline; 47 procedure Status(const aMsg: String; const aArgs: array of const); inline; 48 {$endif} 49 published 50 procedure TestIntfMethods; 51 {$ifdef fpc} 52 procedure TestMethodVars; 53 procedure TestProcVars; 54 {$endif} 55 end; 56 57 implementation 58 59 type 60 {$push} 61 {$M+} 62 ITestInterface = interface 63 ['{1DE799BB-BEE9-405F-9AF3-D55DE978C793}'] 64 procedure TestMethod1; TestMethod2null65 function TestMethod2(aArg1: SizeInt): SizeInt; 66 procedure TestMethod3(aArg1: AnsiString); 67 procedure TestMethod4(aArg1: ShortString); TestMethod5null68 function TestMethod5: AnsiString; TestMethod6null69 function TestMethod6: ShortString; 70 procedure TestMethod7(aArg1: SizeInt; var aArg2: SizeInt; out aArg3: SizeInt; {$ifdef fpc}constref{$else}const [ref]{$endif}aArg4: SizeInt); 71 procedure TestMethod8(aArg1: AnsiString; var aArg2: AnsiString; out aArg3: AnsiString; {$ifdef fpc}constref{$else}const [ref]{$endif}aArg4: AnsiString); 72 procedure TestMethod9(aArg1: ShortString; var aArg2: ShortString; out aArg3: ShortString; {$ifdef fpc}constref{$else}const [ref]{$endif}aArg4: ShortString); 73 procedure TestMethod10(aArg1: Single; var aArg2: Single; out aArg3: Single; {$ifdef fpc}constref{$else}const [ref]{$endif}aArg4: Single); 74 procedure TestMethod11(aArg1: Double; var aArg2: Double; out aArg3: Double; {$ifdef fpc}constref{$else}const [ref]{$endif}aArg4: Double); 75 procedure TestMethod12(aArg1: Extended; var aArg2: Extended; out aArg3: Extended; {$ifdef fpc}constref{$else}const [ref]{$endif}aArg4: Extended); 76 procedure TestMethod13(aArg1: Comp; var aArg2: Comp; out aArg3: Comp; {$ifdef fpc}constref{$else}const [ref]{$endif}aArg4: Comp); 77 procedure TestMethod14(aArg1: Currency; var aArg2: Currency; out aArg3: Currency; {$ifdef fpc}constref{$else}const [ref]{$endif}aArg4: Currency); TestMethod15null78 function TestMethod15(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: SizeInt): SizeInt; TestMethod16null79 function TestMethod16(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Single): Single; TestMethod17null80 function TestMethod17(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Double): Double; TestMethod18null81 function TestMethod18(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Extended): Extended; TestMethod19null82 function TestMethod19(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Comp): Comp; TestMethod20null83 function TestMethod20(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Currency): Currency; 84 procedure TestMethod21(var aArg1; out aArg2; const aArg3; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4); 85 end; 86 {$pop} 87 88 TTestMethod1 = procedure of object; Arg1null89 TTestMethod2 = function(aArg1: SizeInt): SizeInt of object; 90 TTestMethod3 = procedure(aArg1: AnsiString) of object; 91 TTestMethod4 = procedure(aArg1: ShortString) of object; AnsiStringnull92 TTestMethod5 = function: AnsiString of object; ShortStringnull93 TTestMethod6 = function: ShortString of object; 94 TTestMethod7 = procedure(aArg1: SizeInt; var aArg2: SizeInt; out aArg3: SizeInt; {$ifdef fpc}constref{$else}const [ref]{$endif}aArg4: SizeInt) of object; 95 TTestMethod8 = procedure(aArg1: AnsiString; var aArg2: AnsiString; out aArg3: AnsiString; {$ifdef fpc}constref{$else}const [ref]{$endif}aArg4: AnsiString) of object; 96 TTestMethod9 = procedure(aArg1: ShortString; var aArg2: ShortString; out aArg3: ShortString; {$ifdef fpc}constref{$else}const [ref]{$endif}aArg4: ShortString) of object; 97 TTestMethod10 = procedure(aArg1: Single; var aArg2: Single; out aArg3: Single; {$ifdef fpc}constref{$else}const [ref]{$endif}aArg4: Single) of object; 98 TTestMethod11 = procedure(aArg1: Double; var aArg2: Double; out aArg3: Double; {$ifdef fpc}constref{$else}const [ref]{$endif}aArg4: Double) of object; 99 TTestMethod12 = procedure(aArg1: Extended; var aArg2: Extended; out aArg3: Extended; {$ifdef fpc}constref{$else}const [ref]{$endif}aArg4: Extended) of object; 100 TTestMethod13 = procedure(aArg1: Comp; var aArg2: Comp; out aArg3: Comp; {$ifdef fpc}constref{$else}const [ref]{$endif}aArg4: Comp) of object; 101 TTestMethod14 = procedure(aArg1: Currency; var aArg2: Currency; out aArg3: Currency; {$ifdef fpc}constref{$else}const [ref]{$endif}aArg4: Currency) of object; Arg1null102 TTestMethod15 = function(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: SizeInt): SizeInt of object; Arg1null103 TTestMethod16 = function(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Single): Single of object; Arg1null104 TTestMethod17 = function(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Double): Double of object; Arg1null105 TTestMethod18 = function(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Extended): Extended of object; Arg1null106 TTestMethod19 = function(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Comp): Comp of object; Arg1null107 TTestMethod20 = function(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Currency): Currency of object; 108 TTestMethod21 = procedure(var aArg1; out aArg2; const aArg3; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4) of object; 109 110 TTestProc1 = procedure; 111 TTestProc2 = function(aArg1: SizeInt): SizeInt; 112 TTestProc3 = procedure(aArg1: AnsiString); 113 TTestProc4 = procedure(aArg1: ShortString); AnsiStringnull114 TTestProc5 = function: AnsiString; ShortStringnull115 TTestProc6 = function: ShortString; 116 TTestProc7 = procedure(aArg1: SizeInt; var aArg2: SizeInt; out aArg3: SizeInt; {$ifdef fpc}constref{$else}const [ref]{$endif}aArg4: SizeInt); 117 TTestProc8 = procedure(aArg1: AnsiString; var aArg2: AnsiString; out aArg3: AnsiString; {$ifdef fpc}constref{$else}const [ref]{$endif}aArg4: AnsiString); 118 TTestProc9 = procedure(aArg1: ShortString; var aArg2: ShortString; out aArg3: ShortString; {$ifdef fpc}constref{$else}const [ref]{$endif}aArg4: ShortString); 119 TTestProc10 = procedure(aArg1: Single; var aArg2: Single; out aArg3: Single; {$ifdef fpc}constref{$else}const [ref]{$endif}aArg4: Single); 120 TTestProc11 = procedure(aArg1: Double; var aArg2: Double; out aArg3: Double; {$ifdef fpc}constref{$else}const [ref]{$endif}aArg4: Double); 121 TTestProc12 = procedure(aArg1: Extended; var aArg2: Extended; out aArg3: Extended; {$ifdef fpc}constref{$else}const [ref]{$endif}aArg4: Extended); 122 TTestProc13 = procedure(aArg1: Comp; var aArg2: Comp; out aArg3: Comp; {$ifdef fpc}constref{$else}const [ref]{$endif}aArg4: Comp); 123 TTestProc14 = procedure(aArg1: Currency; var aArg2: Currency; out aArg3: Currency; {$ifdef fpc}constref{$else}const [ref]{$endif}aArg4: Currency); Arg1null124 TTestProc15 = function(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: SizeInt): SizeInt; Arg1null125 TTestProc16 = function(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Single): Single; Arg1null126 TTestProc17 = function(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Double): Double; Arg1null127 TTestProc18 = function(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Extended): Extended; Arg1null128 TTestProc19 = function(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Comp): Comp; Arg1null129 TTestProc20 = function(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Currency): Currency; 130 TTestProc21 = procedure(var aArg1; out aArg2; const aArg3; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4); 131 132 const 133 SingleArg1: Single = 1.23; 134 SingleArg2In: Single = 3.21; 135 SingleArg2Out: Single = 2.34; 136 SingleArg3Out: Single = 9.87; 137 SingleArg4: Single = 7.89; 138 SingleRes: Single = 4.32; 139 SingleAddArg1 = Single(1.23); 140 SingleAddArg2 = Single(2.34); 141 SingleAddArg3 = Single(3.45); 142 SingleAddArg4 = Single(4.56); 143 SingleAddArg5 = Single(5.67); 144 SingleAddArg6 = Single(9.87); 145 SingleAddArg7 = Single(8.76); 146 SingleAddArg8 = Single(7.65); 147 SingleAddArg9 = Single(6.54); 148 SingleAddArg10 = Single(5.43); 149 SingleAddRes = SingleAddArg1 + SingleAddArg2 + SingleAddArg3 + SingleAddArg4 + SingleAddArg5 + 150 SingleAddArg6 + SingleAddArg7 + SingleAddArg8 + SingleAddArg9 + SingleAddArg10; 151 152 DoubleArg1: Double = 1.23; 153 DoubleArg2In: Double = 3.21; 154 DoubleArg2Out: Double = 2.34; 155 DoubleArg3Out: Double = 9.87; 156 DoubleArg4: Double = 7.89; 157 DoubleRes: Double = 4.32; 158 DoubleAddArg1 = Double(1.23); 159 DoubleAddArg2 = Double(2.34); 160 DoubleAddArg3 = Double(3.45); 161 DoubleAddArg4 = Double(4.56); 162 DoubleAddArg5 = Double(5.67); 163 DoubleAddArg6 = Double(9.87); 164 DoubleAddArg7 = Double(8.76); 165 DoubleAddArg8 = Double(7.65); 166 DoubleAddArg9 = Double(6.54); 167 DoubleAddArg10 = Double(5.43); 168 DoubleAddRes = DoubleAddArg1 + DoubleAddArg2 + DoubleAddArg3 + DoubleAddArg4 + DoubleAddArg5 + 169 DoubleAddArg6 + DoubleAddArg7 + DoubleAddArg8 + DoubleAddArg9 + DoubleAddArg10; 170 171 ExtendedArg1: Extended = 1.23; 172 ExtendedArg2In: Extended = 3.21; 173 ExtendedArg2Out: Extended = 2.34; 174 ExtendedArg3Out: Extended = 9.87; 175 ExtendedArg4: Extended = 7.89; 176 ExtendedRes: Extended = 4.32; 177 ExtendedAddArg1 = Extended(1.23); 178 ExtendedAddArg2 = Extended(2.34); 179 ExtendedAddArg3 = Extended(3.45); 180 ExtendedAddArg4 = Extended(4.56); 181 ExtendedAddArg5 = Extended(5.67); 182 ExtendedAddArg6 = Extended(9.87); 183 ExtendedAddArg7 = Extended(8.76); 184 ExtendedAddArg8 = Extended(7.65); 185 ExtendedAddArg9 = Extended(6.54); 186 ExtendedAddArg10 = Extended(5.43); 187 ExtendedAddRes = ExtendedAddArg1 + ExtendedAddArg2 + ExtendedAddArg3 + ExtendedAddArg4 + ExtendedAddArg5 + 188 ExtendedAddArg6 + ExtendedAddArg7 + ExtendedAddArg8 + ExtendedAddArg9 + ExtendedAddArg10; 189 190 CurrencyArg1: Currency = 1.23; 191 CurrencyArg2In: Currency = 3.21; 192 CurrencyArg2Out: Currency = 2.34; 193 CurrencyArg3Out: Currency = 9.87; 194 CurrencyArg4: Currency = 7.89; 195 CurrencyRes: Currency = 4.32; 196 CurrencyAddArg1 = Currency(1.23); 197 CurrencyAddArg2 = Currency(2.34); 198 CurrencyAddArg3 = Currency(3.45); 199 CurrencyAddArg4 = Currency(4.56); 200 CurrencyAddArg5 = Currency(5.67); 201 CurrencyAddArg6 = Currency(9.87); 202 CurrencyAddArg7 = Currency(8.76); 203 CurrencyAddArg8 = Currency(7.65); 204 CurrencyAddArg9 = Currency(6.54); 205 CurrencyAddArg10 = Currency(5.43); 206 CurrencyAddRes = CurrencyAddArg1 + CurrencyAddArg2 + CurrencyAddArg3 + CurrencyAddArg4 + CurrencyAddArg5 + 207 CurrencyAddArg6 + CurrencyAddArg7 + CurrencyAddArg8 + CurrencyAddArg9 + CurrencyAddArg10; 208 209 CompArg1: Comp = 123; 210 CompArg2In: Comp = 321; 211 CompArg2Out: Comp = 234; 212 CompArg3Out: Comp = 987; 213 CompArg4: Comp = 789; 214 CompRes: Comp = 432; 215 CompAddArg1 = Comp(123); 216 CompAddArg2 = Comp(234); 217 CompAddArg3 = Comp(345); 218 CompAddArg4 = Comp(456); 219 CompAddArg5 = Comp(567); 220 CompAddArg6 = Comp(987); 221 CompAddArg7 = Comp(876); 222 CompAddArg8 = Comp(765); 223 CompAddArg9 = Comp(654); 224 CompAddArg10 = Comp(543); 225 CompAddRes = CompAddArg1 + CompAddArg2 + CompAddArg3 + CompAddArg4 + CompAddArg5 + 226 CompAddArg6 + CompAddArg7 + CompAddArg8 + CompAddArg9 + CompAddArg10; 227 228 { TTestImpl } 229 230 {$ifdef fpc} 231 procedure TTestImpl.Status(const aMsg: String); 232 begin 233 {$ifdef debug} 234 Writeln(aMsg); 235 {$endif} 236 end; 237 238 procedure TTestImpl.Status(const aMsg: String; const aArgs: array of const); 239 begin 240 {$ifdef debug} 241 Writeln(Format(aMsg, aArgs)); 242 {$endif} 243 end; 244 {$endif} 245 246 procedure TTestImpl.OnHandleIntfMethod(aMethod: TRttiMethod; const aArgs: TValueArray; out aResult: TValue); 247 var 248 selfofs, i: SizeInt; 249 name: String; 250 begin 251 selfofs := 1; 252 253 Status('In Callback'); 254 InvokedMethodName := aMethod.Name; 255 Status('Self: ' + HexStr(Self)); 256 if Assigned(aMethod.ReturnType) then 257 aResult := CopyValue(ResultValue); 258 Status('Setting input args'); 259 SetLength(InputArgs, Length(aArgs)); 260 for i := 0 to High(aArgs) do begin 261 Status('Arg %d: %p %p', [i, aArgs[i].GetReferenceToRawData, PPointer(aArgs[i].GetReferenceToRawData)^]); 262 if Assigned(InputUntypedTypes[i]) then 263 TValue.Make(PPointer(aArgs[i].GetReferenceToRawData)^, InputUntypedTypes[i], InputArgs[i]) 264 else 265 InputArgs[i] := CopyValue(aArgs[i]); 266 end; 267 Status('Setting output args'); 268 { Note: account for Self } 269 for i := 0 to High(InOutMapping) do begin 270 Status('OutputArg %d -> Arg %d', [i, InOutMapping[i] + selfofs]); 271 { check input arg type? } 272 Move(OutputArgs[i].GetReferenceToRawData^, aArgs[InOutMapping[i] + selfofs].GetReferenceToRawData^, OutputArgs[i].DataSize); 273 end; 274 Status('Callback done'); 275 end; 276 277 procedure TTestImpl.DoIntfImpl(aIntf: IInterface; aTypeInfo: PTypeInfo; aIndex: LongInt; aInputArgs, aOutputArgs: TValueArray; aInOutMapping: array of SizeInt; aResult: TValue); 278 var 279 context: TRttiContext; 280 t: TRttiType; 281 instance, res: TValue; 282 method: TRttiMethod; 283 i: SizeInt; 284 input: array of TValue; 285 intf: TRttiInterfaceType; 286 mrec: TMethod; 287 name: String; 288 params: array of TRttiParameter; 289 begin 290 name := 'TestMethod' + IntToStr(aIndex); 291 292 context := TRttiContext.Create; 293 try 294 t := context.GetType(aTypeInfo); 295 Check(t is TRttiInterfaceType, 'Not a interface type: ' + aTypeInfo^.Name); 296 intf := t as TRttiInterfaceType; 297 298 method := intf.GetMethod(name); 299 Check(Assigned(method), 'Method not found: ' + name); 300 301 Status('Executing method %s', [name]); 302 303 CheckEquals(Length(aOutputArgs), Length(aInOutMapping), 'Invalid in/out mapping'); 304 Check(Length(aOutputArgs) <= Length(aInputArgs), 'Output args not part of input args'); 305 306 params := method.GetParameters; 307 308 TValue.Make(@aIntf, aTypeInfo, instance); 309 310 { arguments might be modified by Invoke (Note: Copy() does not uniquify the 311 IValueData of managed types) } 312 SetLength(input, Length(aInputArgs) + 1); 313 SetLength(InputUntypedTypes, Length(aInputArgs) + 1); 314 input[0] := instance; 315 InputUntypedTypes[0] := Nil; 316 for i := 0 to High(aInputArgs) do begin 317 input[i + 1] := CopyValue(aInputArgs[i]); 318 if not Assigned(params[i].ParamType) then 319 InputUntypedTypes[i + 1] := aInputArgs[i].TypeInfo 320 else 321 InputUntypedTypes[i + 1] := Nil; 322 end; 323 324 SetLength(InOutMapping, Length(aInOutMapping)); 325 for i := 0 to High(InOutMapping) do 326 InOutMapping[i] := aInOutMapping[i]; 327 SetLength(OutputArgs, Length(aOutputArgs)); 328 for i := 0 to High(OutputArgs) do 329 OutputArgs[i] := CopyValue(aOutputArgs[i]); 330 ResultValue := aResult; 331 332 res := method.Invoke(instance, aInputArgs); 333 Status('After invoke'); 334 335 CheckEquals(name, InvokedMethodName, 'Invoked method name differs for ' + name); 336 Check(EqualValues(ResultValue, res), 'Reported result value differs from returned for ' + name); 337 Check(EqualValues(aResult, res), 'Expected result value differs from returned for ' + name); 338 CheckEquals(Length(input), Length(InputArgs), 'Count of input args differs for ' + name); 339 for i := 0 to High(input) do begin 340 Check(EqualValues(input[i], InputArgs[i]), Format('Input argument %d differs for %s', [i + 1, name])); 341 end; 342 for i := 0 to High(aOutputArgs) do begin 343 Check(EqualValues(aOutputArgs[i], aInputArgs[InOutMapping[i]]), Format('New output argument %d differs from expected output for %s', [i + 1, name])); 344 end; 345 finally 346 context.Free; 347 end; 348 end; 349 350 {$ifdef fpc} 351 procedure TTestImpl.OnHandleInvokable(aInvokable: TRttiInvokableType; const aArgs: TValueArray; out 352 aResult: TValue); 353 var 354 selfofs, i: SizeInt; 355 begin 356 CheckTrue((aInvokable is TRttiMethodType) or (aInvokable is TRttiProcedureType), 'Invokable is not a method or procedure variable: ' + aInvokable.ClassName); 357 358 selfofs := 0; 359 if aInvokable is TRttiMethodType then 360 selfofs := 1; 361 362 Status('In Callback'); 363 Status('Self: ' + HexStr(Self)); 364 if Assigned(aInvokable.ReturnType) then 365 aResult := CopyValue(ResultValue); 366 Status('Setting input args'); 367 SetLength(InputArgs, Length(aArgs)); 368 for i := 0 to High(aArgs) do begin 369 Status('Arg %d: %p %p', [i, aArgs[i].GetReferenceToRawData, PPointer(aArgs[i].GetReferenceToRawData)^]); 370 if Assigned(InputUntypedTypes[i]) then 371 TValue.Make(PPointer(aArgs[i].GetReferenceToRawData)^, InputUntypedTypes[i], InputArgs[i]) 372 else 373 InputArgs[i] := CopyValue(aArgs[i]); 374 end; 375 Status('Setting output args'); 376 { Note: account for Self } 377 for i := 0 to High(InOutMapping) do begin 378 Status('OutputArg %d -> Arg %d', [i, InOutMapping[i] + selfofs]); 379 { check input arg type? } 380 Move(OutputArgs[i].GetReferenceToRawData^, aArgs[InOutMapping[i] + selfofs].GetReferenceToRawData^, OutputArgs[i].DataSize); 381 end; 382 Status('Callback done'); 383 end; 384 385 procedure TTestImpl.DoMethodImpl(aTypeInfo: PTypeInfo; aInputArgs, 386 aOutputArgs: TValueArray; aInOutMapping: array of SizeInt; aResult: TValue); 387 var 388 context: TRttiContext; 389 t: TRttiType; 390 callable, res: TValue; 391 method: TRttiMethodType; 392 i: SizeInt; 393 input: array of TValue; 394 impl: TMethodImplementation; 395 mrec: TMethod; 396 name: String; 397 params: array of TRttiParameter; 398 begin 399 name := aTypeInfo^.Name; 400 401 impl := Nil; 402 context := TRttiContext.Create; 403 try 404 t := context.GetType(aTypeInfo); 405 Check(t is TRttiMethodType, 'Not a method variable: ' + name); 406 method := t as TRttiMethodType; 407 408 Status('Executing method %s', [name]); 409 410 CheckEquals(Length(aOutputArgs), Length(aInOutMapping), 'Invalid in/out mapping'); 411 Check(Length(aOutputArgs) <= Length(aInputArgs), 'Output args not part of input args'); 412 413 params := method.GetParameters; 414 415 { arguments might be modified by Invoke (Note: Copy() does not uniquify the 416 IValueData of managed types) } 417 SetLength(input, Length(aInputArgs) + 1); 418 SetLength(InputUntypedTypes, Length(aInputArgs) + 1); 419 input[0] := GetPointerValue(Self); 420 InputUntypedTypes[0] := Nil; 421 for i := 0 to High(aInputArgs) do begin 422 input[i + 1] := CopyValue(aInputArgs[i]); 423 if not Assigned(params[i].ParamType) then 424 InputUntypedTypes[i + 1] := aInputArgs[i].TypeInfo 425 else 426 InputUntypedTypes[i + 1] := Nil; 427 end; 428 429 try 430 impl := method.CreateImplementation({$ifdef fpc}@{$endif}OnHandleInvokable); 431 except 432 on e: ENotImplemented do 433 Exit; 434 end; 435 CheckNotNull(impl, 'Method implementation is Nil'); 436 437 mrec.Data := Self; 438 mrec.Code := impl.CodeAddress; 439 TValue.Make(@mrec, aTypeInfo, callable); 440 441 SetLength(InOutMapping, Length(aInOutMapping)); 442 for i := 0 to High(InOutMapping) do 443 InOutMapping[i] := aInOutMapping[i]; 444 SetLength(OutputArgs, Length(aOutputArgs)); 445 for i := 0 to High(OutputArgs) do 446 OutputArgs[i] := CopyValue(aOutputArgs[i]); 447 ResultValue := aResult; 448 449 res := method.Invoke(callable, aInputArgs); 450 Status('After invoke'); 451 452 Check(EqualValues(ResultValue, res), 'Reported result value differs from returned for ' + name); 453 Check(EqualValues(aResult, res), 'Expected result value differs from returned for ' + name); 454 CheckEquals(Length(input), Length(InputArgs), 'Count of input args differs for ' + name); 455 for i := 0 to High(input) do begin 456 Check(EqualValues(input[i], InputArgs[i]), Format('Input argument %d differs for %s', [i + 1, name])); 457 end; 458 for i := 0 to High(aOutputArgs) do begin 459 Check(EqualValues(aOutputArgs[i], aInputArgs[InOutMapping[i]]), Format('New output argument %d differs from expected output for %s', [i + 1, name])); 460 end; 461 finally 462 impl.Free; 463 context.Free; 464 end; 465 end; 466 467 procedure TTestImpl.DoProcImpl(aTypeInfo: PTypeInfo; aInputArgs, 468 aOutputArgs: TValueArray; aInOutMapping: array of SizeInt; aResult: TValue); 469 var 470 context: TRttiContext; 471 t: TRttiType; 472 callable, res: TValue; 473 proc: TRttiProcedureType; 474 i: SizeInt; 475 input: array of TValue; 476 impl: TMethodImplementation; 477 name: String; 478 cp: CodePointer; 479 params: array of TRttiParameter; 480 begin 481 name := aTypeInfo^.Name; 482 483 impl := Nil; 484 context := TRttiContext.Create; 485 try 486 t := context.GetType(aTypeInfo); 487 Check(t is TRttiProcedureType, 'Not a procedure variable: ' + name); 488 proc := t as TRttiProcedureType; 489 490 Status('Executing procedure %s', [name]); 491 492 CheckEquals(Length(aOutputArgs), Length(aInOutMapping), 'Invalid in/out mapping'); 493 Check(Length(aOutputArgs) <= Length(aInputArgs), 'Output args not part of input args'); 494 495 params := proc.GetParameters; 496 497 { arguments might be modified by Invoke (Note: Copy() does not uniquify the 498 IValueData of managed types) } 499 SetLength(input, Length(aInputArgs)); 500 SetLength(InputUntypedTypes, Length(aInputArgs)); 501 for i := 0 to High(aInputArgs) do begin 502 input[i] := CopyValue(aInputArgs[i]); 503 if not Assigned(params[i].ParamType) then 504 InputUntypedTypes[i] := aInputArgs[i].TypeInfo 505 else 506 InputUntypedTypes[i] := Nil; 507 end; 508 509 try 510 impl := proc.CreateImplementation({$ifdef fpc}@{$endif}OnHandleInvokable); 511 except 512 on e: ENotImplemented do 513 Exit; 514 end; 515 CheckNotNull(impl, 'Method implementation is Nil'); 516 517 cp := impl.CodeAddress; 518 TValue.Make(@cp, aTypeInfo, callable); 519 520 SetLength(InOutMapping, Length(aInOutMapping)); 521 for i := 0 to High(InOutMapping) do 522 InOutMapping[i] := aInOutMapping[i]; 523 SetLength(OutputArgs, Length(aOutputArgs)); 524 for i := 0 to High(OutputArgs) do 525 OutputArgs[i] := CopyValue(aOutputArgs[i]); 526 ResultValue := aResult; 527 528 res := proc.Invoke(callable, aInputArgs); 529 Status('After invoke'); 530 531 Check(EqualValues(ResultValue, res), 'Reported result value differs from returned for ' + name); 532 Check(EqualValues(aResult, res), 'Expected result value differs from returned for ' + name); 533 CheckEquals(Length(input), Length(InputArgs), 'Count of input args differs for ' + name); 534 for i := 0 to High(input) do begin 535 Check(EqualValues(input[i], InputArgs[i]), Format('Input argument %d differs for %s', [i + 1, name])); 536 end; 537 for i := 0 to High(aOutputArgs) do begin 538 Check(EqualValues(aOutputArgs[i], aInputArgs[InOutMapping[i]]), Format('New output argument %d differs from expected output for %s', [i + 1, name])); 539 end; 540 finally 541 impl.Free; 542 context.Free; 543 end; 544 end; 545 {$endif} 546 547 {$ifndef InLazIDE} 548 {$ifdef fpc}generic{$endif} procedure TTestImpl.GenDoIntfImpl<T>(aIntf: T; aIndex: LongInt; aInputArgs, aOutputArgs: TValueArray; aInOutMapping: array of SizeInt; aResult: TValue); 549 begin 550 DoIntfImpl(aIntf, TypeInfo(T), aIndex, aInputArgs, aOutputArgs, aInOutMapping, aResult); 551 end; 552 553 {$ifdef fpc}generic{$endif} procedure TTestImpl.GenDoMethodImpl<T>(aInputArgs, aOutputArgs: TValueArray; aInOutMapping: array of SizeInt; aResult: TValue); 554 begin 555 DoMethodImpl(TypeInfo(T), aInputArgs, aOutputArgs, aInOutMapping, aResult); 556 end; 557 558 {$ifdef fpc}generic{$endif} procedure TTestImpl.GenDoProcImpl<T>(aInputArgs, aOutputArgs: TValueArray; aInOutMapping: array of SizeInt; aResult: TValue); 559 begin 560 DoProcImpl(TypeInfo(T), aInputArgs, aOutputArgs, aInOutMapping, aResult); 561 end; 562 {$endif} 563 564 procedure TTestImpl.TestIntfMethods; 565 var 566 intf: ITestInterface; 567 begin 568 try 569 intf := TVirtualInterface.Create(PTypeInfo(TypeInfo(ITestInterface)), {$ifdef fpc}@{$endif}OnHandleIntfMethod) as ITestInterface; 570 except 571 on e: ENotImplemented do 572 Ignore('TVirtualInterface not supported for ' + {$I %FPCTARGETCPU%} + '-' + {$I %FPCTARGETOS%}); 573 end; 574 Check(Assigned(intf), 'ITestInterface instance is Nil'); 575 576 {$ifdef fpc}specialize{$endif}GenDoIntfImpl<ITestInterface>(intf, 1, [], [], [], TValue.Empty); 577 578 {$ifdef fpc}specialize{$endif}GenDoIntfImpl<ITestInterface>(intf, 2, [GetIntValue(42)], [], [], GetIntValue(21)); 579 580 {$ifdef fpc}specialize{$endif}GenDoIntfImpl<ITestInterface>(intf, 3, [GetAnsiString('Hello World')], [], [], TValue.Empty); 581 582 {$ifdef fpc}specialize{$endif}GenDoIntfImpl<ITestInterface>(intf, 4, [GetShortString('Hello World')], [], [], TValue.Empty); 583 584 {$ifdef fpc}specialize{$endif}GenDoIntfImpl<ITestInterface>(intf, 5, [], [], [], GetAnsiString('Hello World')); 585 586 {$ifdef fpc}specialize{$endif}GenDoIntfImpl<ITestInterface>(intf, 6, [], [], [], GetShortString('Hello World')); 587 588 {$ifdef fpc}specialize{$endif}GenDoIntfImpl<ITestInterface>(intf, 7, [ 589 GetIntValue(1234), GetIntValue(4321), GetIntValue(0), GetIntValue(9876) 590 ], [ 591 GetIntValue(5678), GetIntValue(6789) 592 ], [1, 2], TValue.Empty); 593 594 {$ifdef fpc}specialize{$endif}GenDoIntfImpl<ITestInterface>(intf, 8, [ 595 GetAnsiString('Alpha'), GetAnsiString('Beta'), GetAnsiString(''), GetAnsiString('Delta') 596 ], [ 597 GetAnsiString('Gamma'), GetAnsiString('Epsilon') 598 ], [1, 2], TValue.Empty); 599 600 {$ifdef fpc}specialize{$endif}GenDoIntfImpl<ITestInterface>(intf, 9, [ 601 GetShortString('Alpha'), GetShortString('Beta'), GetShortString(''), GetShortString('Delta') 602 ], [ 603 GetShortString('Gamma'), GetShortString('Epsilon') 604 ], [1, 2], TValue.Empty); 605 606 {$ifdef fpc}specialize{$endif}GenDoIntfImpl<ITestInterface>(intf, 10, [ 607 GetSingleValue(SingleArg1), GetSingleValue(SingleArg2In), GetSingleValue(0), GetSingleValue(SingleArg4) 608 ], [ 609 GetSingleValue(SingleArg2Out), GetSingleValue(SingleArg3Out) 610 ], [1, 2], TValue.Empty); 611 612 {$ifdef fpc}specialize{$endif}GenDoIntfImpl<ITestInterface>(intf, 11, [ 613 GetDoubleValue(DoubleArg1), GetDoubleValue(DoubleArg2In), GetDoubleValue(0), GetDoubleValue(DoubleArg4) 614 ], [ 615 GetDoubleValue(DoubleArg2Out), GetDoubleValue(DoubleArg3Out) 616 ], [1, 2], TValue.Empty); 617 618 {$ifdef fpc}specialize{$endif}GenDoIntfImpl<ITestInterface>(intf, 12, [ 619 GetExtendedValue(ExtendedArg1), GetExtendedValue(ExtendedArg2In), GetExtendedValue(0), GetExtendedValue(ExtendedArg4) 620 ], [ 621 GetExtendedValue(ExtendedArg2Out), GetExtendedValue(ExtendedArg3Out) 622 ], [1, 2], TValue.Empty); 623 624 {$ifdef fpc}specialize{$endif}GenDoIntfImpl<ITestInterface>(intf, 13, [ 625 GetCompValue(CompArg1), GetCompValue(CompArg2In), GetCompValue(0), GetCompValue(CompArg4) 626 ], [ 627 GetCompValue(CompArg2Out), GetCompValue(CompArg3Out) 628 ], [1, 2], TValue.Empty); 629 630 {$ifdef fpc}specialize{$endif}GenDoIntfImpl<ITestInterface>(intf, 14, [ 631 GetCurrencyValue(CurrencyArg1), GetCurrencyValue(CurrencyArg2In), GetCurrencyValue(0), GetCurrencyValue(CurrencyArg4) 632 ], [ 633 GetCurrencyValue(CurrencyArg2Out), GetCurrencyValue(CurrencyArg3Out) 634 ], [1, 2], TValue.Empty); 635 636 {$ifdef fpc}specialize{$endif}GenDoIntfImpl<ITestInterface>(intf, 15, [ 637 GetIntValue(1), GetIntValue(2), GetIntValue(3), GetIntValue(4), GetIntValue(5), 638 GetIntValue(6), GetIntValue(7), GetIntValue(8), GetIntValue(9), GetIntValue(10) 639 ], [], [], GetIntValue(11)); 640 641 {$ifdef fpc}specialize{$endif}GenDoIntfImpl<ITestInterface>(intf, 16, [ 642 GetSingleValue(SingleAddArg1), GetSingleValue(SingleAddArg2), GetSingleValue(SingleAddArg3), GetSingleValue(SingleAddArg4), GetSingleValue(SingleAddArg5), 643 GetSingleValue(SingleAddArg6), GetSingleValue(SingleAddArg7), GetSingleValue(SingleAddArg8), GetSingleValue(SingleAddArg9), GetSingleValue(SingleAddArg10) 644 ], [], [], GetSingleValue(SingleAddRes)); 645 646 {$ifdef fpc}specialize{$endif}GenDoIntfImpl<ITestInterface>(intf, 17, [ 647 GetDoubleValue(DoubleAddArg1), GetDoubleValue(DoubleAddArg2), GetDoubleValue(DoubleAddArg3), GetDoubleValue(DoubleAddArg4), GetDoubleValue(DoubleAddArg5), 648 GetDoubleValue(DoubleAddArg6), GetDoubleValue(DoubleAddArg7), GetDoubleValue(DoubleAddArg8), GetDoubleValue(DoubleAddArg9), GetDoubleValue(DoubleAddArg10) 649 ], [], [], GetDoubleValue(DoubleAddRes)); 650 651 {$ifdef fpc}specialize{$endif}GenDoIntfImpl<ITestInterface>(intf, 18, [ 652 GetExtendedValue(ExtendedAddArg1), GetExtendedValue(ExtendedAddArg2), GetExtendedValue(ExtendedAddArg3), GetExtendedValue(ExtendedAddArg4), GetExtendedValue(ExtendedAddArg5), 653 GetExtendedValue(ExtendedAddArg6), GetExtendedValue(ExtendedAddArg7), GetExtendedValue(ExtendedAddArg8), GetExtendedValue(ExtendedAddArg9), GetExtendedValue(ExtendedAddArg10) 654 ], [], [], GetExtendedValue(ExtendedAddRes)); 655 656 {$ifdef fpc}specialize{$endif}GenDoIntfImpl<ITestInterface>(intf, 19, [ 657 GetCompValue(CompAddArg1), GetCompValue(CompAddArg2), GetCompValue(CompAddArg3), GetCompValue(CompAddArg4), GetCompValue(CompAddArg5), 658 GetCompValue(CompAddArg6), GetCompValue(CompAddArg7), GetCompValue(CompAddArg8), GetCompValue(CompAddArg9), GetCompValue(CompAddArg10) 659 ], [], [], GetCompValue(CompAddRes)); 660 661 {$ifdef fpc}specialize{$endif}GenDoIntfImpl<ITestInterface>(intf, 20, [ 662 GetCurrencyValue(CurrencyAddArg1), GetCurrencyValue(CurrencyAddArg2), GetCurrencyValue(CurrencyAddArg3), GetCurrencyValue(CurrencyAddArg4), GetCurrencyValue(CurrencyAddArg5), 663 GetCurrencyValue(CurrencyAddArg6), GetCurrencyValue(CurrencyAddArg7), GetCurrencyValue(CurrencyAddArg8), GetCurrencyValue(CurrencyAddArg9), GetCurrencyValue(CurrencyAddArg10) 664 ], [], [], GetCurrencyValue(CurrencyAddRes)); 665 666 {$ifdef fpc}specialize{$endif}GenDoIntfImpl<ITestInterface>(intf, 21, [ 667 GetIntValue(1234), GetIntValue(4321), GetIntValue(0), GetIntValue(9876) 668 ], [ 669 GetIntValue(5678), GetIntValue(6789) 670 ], [0, 1], TValue.Empty); 671 672 {$ifdef fpc}specialize{$endif}GenDoIntfImpl<ITestInterface>(intf, 21, [ 673 GetAnsiString('Alpha'), GetAnsiString('Beta'), GetAnsiString(''), GetAnsiString('Delta') 674 ], [ 675 GetAnsiString('Gamma'), GetAnsiString('Epsilon') 676 ], [0, 1], TValue.Empty); 677 678 { for some reason this fails, though it fails in Delphi as well :/ } 679 {{$ifdef fpc}specialize{$endif}GenDoIntfImpl<ITestInterface>(intf, 21, [ 680 GetShortString('Alpha'), GetShortString('Beta'), GetShortString(''), GetShortString('Delta') 681 ], [ 682 GetShortString('Gamma'), GetShortString('Epsilon') 683 ], [0, 1], TValue.Empty);} 684 end; 685 686 {$ifdef fpc} 687 procedure TTestImpl.TestMethodVars; 688 begin 689 {$ifdef fpc}specialize{$endif}GenDoMethodImpl<TTestMethod1>([], [], [], TValue.Empty); 690 691 {$ifdef fpc}specialize{$endif}GenDoMethodImpl<TTestMethod2>([GetIntValue(42)], [], [], GetIntValue(21)); 692 693 {$ifdef fpc}specialize{$endif}GenDoMethodImpl<TTestMethod3>([GetAnsiString('Hello World')], [], [], TValue.Empty); 694 695 {$ifdef fpc}specialize{$endif}GenDoMethodImpl<TTestMethod4>([GetShortString('Hello World')], [], [], TValue.Empty); 696 697 {$ifdef fpc}specialize{$endif}GenDoMethodImpl<TTestMethod5>([], [], [], GetAnsiString('Hello World')); 698 699 {$ifdef fpc}specialize{$endif}GenDoMethodImpl<TTestMethod6>([], [], [], GetShortString('Hello World')); 700 701 {$ifdef fpc}specialize{$endif}GenDoMethodImpl<TTestMethod7>([ 702 GetIntValue(1234), GetIntValue(4321), GetIntValue(0), GetIntValue(9876) 703 ], [ 704 GetIntValue(5678), GetIntValue(6789) 705 ], [1, 2], TValue.Empty); 706 707 {$ifdef fpc}specialize{$endif}GenDoMethodImpl<TTestMethod8>([ 708 GetAnsiString('Alpha'), GetAnsiString('Beta'), GetAnsiString(''), GetAnsiString('Delta') 709 ], [ 710 GetAnsiString('Gamma'), GetAnsiString('Epsilon') 711 ], [1, 2], TValue.Empty); 712 713 {$ifdef fpc}specialize{$endif}GenDoMethodImpl<TTestMethod9>([ 714 GetShortString('Alpha'), GetShortString('Beta'), GetShortString(''), GetShortString('Delta') 715 ], [ 716 GetShortString('Gamma'), GetShortString('Epsilon') 717 ], [1, 2], TValue.Empty); 718 719 {$ifdef fpc}specialize{$endif}GenDoMethodImpl<TTestMethod10>([ 720 GetSingleValue(SingleArg1), GetSingleValue(SingleArg2In), GetSingleValue(0), GetSingleValue(SingleArg4) 721 ], [ 722 GetSingleValue(SingleArg2Out), GetSingleValue(SingleArg3Out) 723 ], [1, 2], TValue.Empty); 724 725 {$ifdef fpc}specialize{$endif}GenDoMethodImpl<TTestMethod11>([ 726 GetDoubleValue(DoubleArg1), GetDoubleValue(DoubleArg2In), GetDoubleValue(0), GetDoubleValue(DoubleArg4) 727 ], [ 728 GetDoubleValue(DoubleArg2Out), GetDoubleValue(DoubleArg3Out) 729 ], [1, 2], TValue.Empty); 730 731 {$ifdef fpc}specialize{$endif}GenDoMethodImpl<TTestMethod12>([ 732 GetExtendedValue(ExtendedArg1), GetExtendedValue(ExtendedArg2In), GetExtendedValue(0), GetExtendedValue(ExtendedArg4) 733 ], [ 734 GetExtendedValue(ExtendedArg2Out), GetExtendedValue(ExtendedArg3Out) 735 ], [1, 2], TValue.Empty); 736 737 {$ifdef fpc}specialize{$endif}GenDoMethodImpl<TTestMethod13>([ 738 GetCompValue(CompArg1), GetCompValue(CompArg2In), GetCompValue(0), GetCompValue(CompArg4) 739 ], [ 740 GetCompValue(CompArg2Out), GetCompValue(CompArg3Out) 741 ], [1, 2], TValue.Empty); 742 743 {$ifdef fpc}specialize{$endif}GenDoMethodImpl<TTestMethod14>([ 744 GetCurrencyValue(CurrencyArg1), GetCurrencyValue(CurrencyArg2In), GetCurrencyValue(0), GetCurrencyValue(CurrencyArg4) 745 ], [ 746 GetCurrencyValue(CurrencyArg2Out), GetCurrencyValue(CurrencyArg3Out) 747 ], [1, 2], TValue.Empty); 748 749 {$ifdef fpc}specialize{$endif}GenDoMethodImpl<TTestMethod15>([ 750 GetIntValue(1), GetIntValue(2), GetIntValue(3), GetIntValue(4), GetIntValue(5), 751 GetIntValue(6), GetIntValue(7), GetIntValue(8), GetIntValue(9), GetIntValue(10) 752 ], [], [], GetIntValue(11)); 753 754 {$ifdef fpc}specialize{$endif}GenDoMethodImpl<TTestMethod16>([ 755 GetSingleValue(SingleAddArg1), GetSingleValue(SingleAddArg2), GetSingleValue(SingleAddArg3), GetSingleValue(SingleAddArg4), GetSingleValue(SingleAddArg5), 756 GetSingleValue(SingleAddArg6), GetSingleValue(SingleAddArg7), GetSingleValue(SingleAddArg8), GetSingleValue(SingleAddArg9), GetSingleValue(SingleAddArg10) 757 ], [], [], GetSingleValue(SingleAddRes)); 758 759 {$ifdef fpc}specialize{$endif}GenDoMethodImpl<TTestMethod17>([ 760 GetDoubleValue(DoubleAddArg1), GetDoubleValue(DoubleAddArg2), GetDoubleValue(DoubleAddArg3), GetDoubleValue(DoubleAddArg4), GetDoubleValue(DoubleAddArg5), 761 GetDoubleValue(DoubleAddArg6), GetDoubleValue(DoubleAddArg7), GetDoubleValue(DoubleAddArg8), GetDoubleValue(DoubleAddArg9), GetDoubleValue(DoubleAddArg10) 762 ], [], [], GetDoubleValue(DoubleAddRes)); 763 764 {$ifdef fpc}specialize{$endif}GenDoMethodImpl<TTestMethod18>([ 765 GetExtendedValue(ExtendedAddArg1), GetExtendedValue(ExtendedAddArg2), GetExtendedValue(ExtendedAddArg3), GetExtendedValue(ExtendedAddArg4), GetExtendedValue(ExtendedAddArg5), 766 GetExtendedValue(ExtendedAddArg6), GetExtendedValue(ExtendedAddArg7), GetExtendedValue(ExtendedAddArg8), GetExtendedValue(ExtendedAddArg9), GetExtendedValue(ExtendedAddArg10) 767 ], [], [], GetExtendedValue(ExtendedAddRes)); 768 769 {$ifdef fpc}specialize{$endif}GenDoMethodImpl<TTestMethod19>([ 770 GetCompValue(CompAddArg1), GetCompValue(CompAddArg2), GetCompValue(CompAddArg3), GetCompValue(CompAddArg4), GetCompValue(CompAddArg5), 771 GetCompValue(CompAddArg6), GetCompValue(CompAddArg7), GetCompValue(CompAddArg8), GetCompValue(CompAddArg9), GetCompValue(CompAddArg10) 772 ], [], [], GetCompValue(CompAddRes)); 773 774 {$ifdef fpc}specialize{$endif}GenDoMethodImpl<TTestMethod20>([ 775 GetCurrencyValue(CurrencyAddArg1), GetCurrencyValue(CurrencyAddArg2), GetCurrencyValue(CurrencyAddArg3), GetCurrencyValue(CurrencyAddArg4), GetCurrencyValue(CurrencyAddArg5), 776 GetCurrencyValue(CurrencyAddArg6), GetCurrencyValue(CurrencyAddArg7), GetCurrencyValue(CurrencyAddArg8), GetCurrencyValue(CurrencyAddArg9), GetCurrencyValue(CurrencyAddArg10) 777 ], [], [], GetCurrencyValue(CurrencyAddRes)); 778 779 {$ifdef fpc}specialize{$endif}GenDoMethodImpl<TTestMethod21>([ 780 GetIntValue(1234), GetIntValue(4321), GetIntValue(0), GetIntValue(9876) 781 ], [ 782 GetIntValue(5678), GetIntValue(6789) 783 ], [0, 1], TValue.Empty); 784 785 {$ifdef fpc}specialize{$endif}GenDoMethodImpl<TTestMethod21>([ 786 GetAnsiString('Alpha'), GetAnsiString('Beta'), GetAnsiString(''), GetAnsiString('Delta') 787 ], [ 788 GetAnsiString('Gamma'), GetAnsiString('Epsilon') 789 ], [0, 1], TValue.Empty); 790 791 { for some reason this fails, though it fails in Delphi as well :/ } 792 {{$ifdef fpc}specialize{$endif}GenDoMethodImpl<TTestMethod21>([ 793 GetShortString('Alpha'), GetShortString('Beta'), GetShortString(''), GetShortString('Delta') 794 ], [ 795 GetShortString('Gamma'), GetShortString('Epsilon') 796 ], [0, 1], TValue.Empty);} 797 end; 798 799 procedure TTestImpl.TestProcVars; 800 begin 801 {$ifdef fpc}specialize{$endif}GenDoProcImpl<TTestProc1>([], [], [], TValue.Empty); 802 803 {$ifdef fpc}specialize{$endif}GenDoProcImpl<TTestProc2>([GetIntValue(42)], [], [], GetIntValue(21)); 804 805 {$ifdef fpc}specialize{$endif}GenDoProcImpl<TTestProc3>([GetAnsiString('Hello World')], [], [], TValue.Empty); 806 807 {$ifdef fpc}specialize{$endif}GenDoProcImpl<TTestProc4>([GetShortString('Hello World')], [], [], TValue.Empty); 808 809 {$ifdef fpc}specialize{$endif}GenDoProcImpl<TTestProc5>([], [], [], GetAnsiString('Hello World')); 810 811 {$ifdef fpc}specialize{$endif}GenDoProcImpl<TTestProc6>([], [], [], GetShortString('Hello World')); 812 813 {$ifdef fpc}specialize{$endif}GenDoProcImpl<TTestProc7>([ 814 GetIntValue(1234), GetIntValue(4321), GetIntValue(0), GetIntValue(9876) 815 ], [ 816 GetIntValue(5678), GetIntValue(6789) 817 ], [1, 2], TValue.Empty); 818 819 {$ifdef fpc}specialize{$endif}GenDoProcImpl<TTestProc8>([ 820 GetAnsiString('Alpha'), GetAnsiString('Beta'), GetAnsiString(''), GetAnsiString('Delta') 821 ], [ 822 GetAnsiString('Gamma'), GetAnsiString('Epsilon') 823 ], [1, 2], TValue.Empty); 824 825 {$ifdef fpc}specialize{$endif}GenDoProcImpl<TTestProc9>([ 826 GetShortString('Alpha'), GetShortString('Beta'), GetShortString(''), GetShortString('Delta') 827 ], [ 828 GetShortString('Gamma'), GetShortString('Epsilon') 829 ], [1, 2], TValue.Empty); 830 831 {$ifdef fpc}specialize{$endif}GenDoProcImpl<TTestProc10>([ 832 GetSingleValue(SingleArg1), GetSingleValue(SingleArg2In), GetSingleValue(0), GetSingleValue(SingleArg4) 833 ], [ 834 GetSingleValue(SingleArg2Out), GetSingleValue(SingleArg3Out) 835 ], [1, 2], TValue.Empty); 836 837 {$ifdef fpc}specialize{$endif}GenDoProcImpl<TTestProc11>([ 838 GetDoubleValue(DoubleArg1), GetDoubleValue(DoubleArg2In), GetDoubleValue(0), GetDoubleValue(DoubleArg4) 839 ], [ 840 GetDoubleValue(DoubleArg2Out), GetDoubleValue(DoubleArg3Out) 841 ], [1, 2], TValue.Empty); 842 843 {$ifdef fpc}specialize{$endif}GenDoProcImpl<TTestProc12>([ 844 GetExtendedValue(ExtendedArg1), GetExtendedValue(ExtendedArg2In), GetExtendedValue(0), GetExtendedValue(ExtendedArg4) 845 ], [ 846 GetExtendedValue(ExtendedArg2Out), GetExtendedValue(ExtendedArg3Out) 847 ], [1, 2], TValue.Empty); 848 849 {$ifdef fpc}specialize{$endif}GenDoProcImpl<TTestProc13>([ 850 GetCompValue(CompArg1), GetCompValue(CompArg2In), GetCompValue(0), GetCompValue(CompArg4) 851 ], [ 852 GetCompValue(CompArg2Out), GetCompValue(CompArg3Out) 853 ], [1, 2], TValue.Empty); 854 855 {$ifdef fpc}specialize{$endif}GenDoProcImpl<TTestProc14>([ 856 GetCurrencyValue(CurrencyArg1), GetCurrencyValue(CurrencyArg2In), GetCurrencyValue(0), GetCurrencyValue(CurrencyArg4) 857 ], [ 858 GetCurrencyValue(CurrencyArg2Out), GetCurrencyValue(CurrencyArg3Out) 859 ], [1, 2], TValue.Empty); 860 861 {$ifdef fpc}specialize{$endif}GenDoProcImpl<TTestProc15>([ 862 GetIntValue(1), GetIntValue(2), GetIntValue(3), GetIntValue(4), GetIntValue(5), 863 GetIntValue(6), GetIntValue(7), GetIntValue(8), GetIntValue(9), GetIntValue(10) 864 ], [], [], GetIntValue(11)); 865 866 {$ifdef fpc}specialize{$endif}GenDoProcImpl<TTestProc16>([ 867 GetSingleValue(SingleAddArg1), GetSingleValue(SingleAddArg2), GetSingleValue(SingleAddArg3), GetSingleValue(SingleAddArg4), GetSingleValue(SingleAddArg5), 868 GetSingleValue(SingleAddArg6), GetSingleValue(SingleAddArg7), GetSingleValue(SingleAddArg8), GetSingleValue(SingleAddArg9), GetSingleValue(SingleAddArg10) 869 ], [], [], GetSingleValue(SingleAddRes)); 870 871 {$ifdef fpc}specialize{$endif}GenDoProcImpl<TTestProc17>([ 872 GetDoubleValue(DoubleAddArg1), GetDoubleValue(DoubleAddArg2), GetDoubleValue(DoubleAddArg3), GetDoubleValue(DoubleAddArg4), GetDoubleValue(DoubleAddArg5), 873 GetDoubleValue(DoubleAddArg6), GetDoubleValue(DoubleAddArg7), GetDoubleValue(DoubleAddArg8), GetDoubleValue(DoubleAddArg9), GetDoubleValue(DoubleAddArg10) 874 ], [], [], GetDoubleValue(DoubleAddRes)); 875 876 {$ifdef fpc}specialize{$endif}GenDoProcImpl<TTestProc18>([ 877 GetExtendedValue(ExtendedAddArg1), GetExtendedValue(ExtendedAddArg2), GetExtendedValue(ExtendedAddArg3), GetExtendedValue(ExtendedAddArg4), GetExtendedValue(ExtendedAddArg5), 878 GetExtendedValue(ExtendedAddArg6), GetExtendedValue(ExtendedAddArg7), GetExtendedValue(ExtendedAddArg8), GetExtendedValue(ExtendedAddArg9), GetExtendedValue(ExtendedAddArg10) 879 ], [], [], GetExtendedValue(ExtendedAddRes)); 880 881 {$ifdef fpc}specialize{$endif}GenDoProcImpl<TTestProc19>([ 882 GetCompValue(CompAddArg1), GetCompValue(CompAddArg2), GetCompValue(CompAddArg3), GetCompValue(CompAddArg4), GetCompValue(CompAddArg5), 883 GetCompValue(CompAddArg6), GetCompValue(CompAddArg7), GetCompValue(CompAddArg8), GetCompValue(CompAddArg9), GetCompValue(CompAddArg10) 884 ], [], [], GetCompValue(CompAddRes)); 885 886 {$ifdef fpc}specialize{$endif}GenDoProcImpl<TTestProc20>([ 887 GetCurrencyValue(CurrencyAddArg1), GetCurrencyValue(CurrencyAddArg2), GetCurrencyValue(CurrencyAddArg3), GetCurrencyValue(CurrencyAddArg4), GetCurrencyValue(CurrencyAddArg5), 888 GetCurrencyValue(CurrencyAddArg6), GetCurrencyValue(CurrencyAddArg7), GetCurrencyValue(CurrencyAddArg8), GetCurrencyValue(CurrencyAddArg9), GetCurrencyValue(CurrencyAddArg10) 889 ], [], [], GetCurrencyValue(CurrencyAddRes)); 890 891 {$ifdef fpc}specialize{$endif}GenDoProcImpl<TTestProc21>([ 892 GetIntValue(1234), GetIntValue(4321), GetIntValue(0), GetIntValue(9876) 893 ], [ 894 GetIntValue(5678), GetIntValue(6789) 895 ], [0, 1], TValue.Empty); 896 897 {$ifdef fpc}specialize{$endif}GenDoProcImpl<TTestProc21>([ 898 GetAnsiString('Alpha'), GetAnsiString('Beta'), GetAnsiString(''), GetAnsiString('Delta') 899 ], [ 900 GetAnsiString('Gamma'), GetAnsiString('Epsilon') 901 ], [0, 1], TValue.Empty); 902 903 { for some reason this fails, though it fails in Delphi as well :/ } 904 {{$ifdef fpc}specialize{$endif}GenDoProcImpl<TTestProc21>([ 905 GetShortString('Alpha'), GetShortString('Beta'), GetShortString(''), GetShortString('Delta') 906 ], [ 907 GetShortString('Gamma'), GetShortString('Epsilon') 908 ], [0, 1], TValue.Empty);} 909 end; 910 {$endif} 911 912 initialization 913 {$ifdef fpc} 914 RegisterTest(TTestImpl); 915 {$else fpc} 916 RegisterTest(TTestImpl.Suite); 917 {$endif fpc} 918 end. 919 920