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