tests.rtti.impl.pas 29 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645
  1. unit Tests.Rtti.Impl;
  2. {$ifdef fpc}
  3. {$mode objfpc}{$H+}
  4. {$endif}
  5. {.$define debug}
  6. interface
  7. uses
  8. {$IFDEF FPC}
  9. fpcunit,testregistry, testutils,
  10. {$ELSE FPC}
  11. TestFramework,
  12. {$ENDIF FPC}
  13. sysutils, typinfo, Rtti,
  14. Tests.Rtti.Util;
  15. { Note: Delphi does not provide a CreateImplementation for TRttiInvokableType
  16. and its descendants, so these tests are disabled for Delphi }
  17. type
  18. TTestImpl = class(TTestCase)
  19. private
  20. InputArgs: array of TValue;
  21. OutputArgs: array of TValue;
  22. ResultValue: TValue;
  23. InOutMapping: array of SizeInt;
  24. InputUntypedTypes: array of PTypeInfo;
  25. {$ifdef fpc}
  26. procedure OnHandleInvokable(aInvokable: TRttiInvokableType; const aArgs: TValueArray; out aResult: TValue);
  27. procedure DoMethodImpl(aTypeInfo: PTypeInfo; aInputArgs, aOutputArgs: TValueArray; aInOutMapping: array of SizeInt; aResult: TValue);
  28. procedure DoProcImpl(aTypeInfo: PTypeInfo; aInputArgs, aOutputArgs: TValueArray; aInOutMapping: array of SizeInt; aResult: TValue);
  29. {$ifndef InLazIDE}
  30. {$ifdef fpc}generic{$endif} procedure GenDoMethodImpl<T>(aInputArgs, aOutputArgs: TValueArray; aInOutMapping: array of SizeInt; aResult: TValue);
  31. {$ifdef fpc}generic{$endif} procedure GenDoProcImpl<T>(aInputArgs, aOutputArgs: TValueArray; aInOutMapping: array of SizeInt; aResult: TValue);
  32. {$endif}
  33. {$endif}
  34. {$ifdef fpc}
  35. procedure Status(const aMsg: String); inline;
  36. procedure Status(const aMsg: String; const aArgs: array of const); inline;
  37. {$endif}
  38. published
  39. {$ifdef fpc}
  40. procedure TestMethodVars;
  41. procedure TestProcVars;
  42. {$endif}
  43. end;
  44. implementation
  45. type
  46. TTestMethod1 = procedure of object;
  47. TTestMethod2 = function(aArg1: SizeInt): SizeInt of object;
  48. TTestMethod3 = procedure(aArg1: AnsiString) of object;
  49. TTestMethod4 = procedure(aArg1: ShortString) of object;
  50. TTestMethod5 = function: AnsiString of object;
  51. TTestMethod6 = function: ShortString of object;
  52. TTestMethod7 = procedure(aArg1: SizeInt; var aArg2: SizeInt; out aArg3: SizeInt; {$ifdef fpc}constref{$else}const [ref]{$endif}aArg4: SizeInt) of object;
  53. TTestMethod8 = procedure(aArg1: AnsiString; var aArg2: AnsiString; out aArg3: AnsiString; {$ifdef fpc}constref{$else}const [ref]{$endif}aArg4: AnsiString) of object;
  54. TTestMethod9 = procedure(aArg1: ShortString; var aArg2: ShortString; out aArg3: ShortString; {$ifdef fpc}constref{$else}const [ref]{$endif}aArg4: ShortString) of object;
  55. TTestMethod10 = procedure(aArg1: Single; var aArg2: Single; out aArg3: Single; {$ifdef fpc}constref{$else}const [ref]{$endif}aArg4: Single) of object;
  56. TTestMethod11 = procedure(aArg1: Double; var aArg2: Double; out aArg3: Double; {$ifdef fpc}constref{$else}const [ref]{$endif}aArg4: Double) of object;
  57. TTestMethod12 = procedure(aArg1: Extended; var aArg2: Extended; out aArg3: Extended; {$ifdef fpc}constref{$else}const [ref]{$endif}aArg4: Extended) of object;
  58. TTestMethod13 = procedure(aArg1: Comp; var aArg2: Comp; out aArg3: Comp; {$ifdef fpc}constref{$else}const [ref]{$endif}aArg4: Comp) of object;
  59. TTestMethod14 = procedure(aArg1: Currency; var aArg2: Currency; out aArg3: Currency; {$ifdef fpc}constref{$else}const [ref]{$endif}aArg4: Currency) of object;
  60. TTestMethod15 = function(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: SizeInt): SizeInt of object;
  61. TTestMethod16 = function(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Single): Single of object;
  62. TTestMethod17 = function(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Double): Double of object;
  63. TTestMethod18 = function(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Extended): Extended of object;
  64. TTestMethod19 = function(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Comp): Comp of object;
  65. TTestMethod20 = function(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Currency): Currency of object;
  66. TTestMethod21 = procedure(var aArg1; out aArg2; const aArg3; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4) of object;
  67. TTestProc1 = procedure;
  68. TTestProc2 = function(aArg1: SizeInt): SizeInt;
  69. TTestProc3 = procedure(aArg1: AnsiString);
  70. TTestProc4 = procedure(aArg1: ShortString);
  71. TTestProc5 = function: AnsiString;
  72. TTestProc6 = function: ShortString;
  73. TTestProc7 = procedure(aArg1: SizeInt; var aArg2: SizeInt; out aArg3: SizeInt; {$ifdef fpc}constref{$else}const [ref]{$endif}aArg4: SizeInt);
  74. TTestProc8 = procedure(aArg1: AnsiString; var aArg2: AnsiString; out aArg3: AnsiString; {$ifdef fpc}constref{$else}const [ref]{$endif}aArg4: AnsiString);
  75. TTestProc9 = procedure(aArg1: ShortString; var aArg2: ShortString; out aArg3: ShortString; {$ifdef fpc}constref{$else}const [ref]{$endif}aArg4: ShortString);
  76. TTestProc10 = procedure(aArg1: Single; var aArg2: Single; out aArg3: Single; {$ifdef fpc}constref{$else}const [ref]{$endif}aArg4: Single);
  77. TTestProc11 = procedure(aArg1: Double; var aArg2: Double; out aArg3: Double; {$ifdef fpc}constref{$else}const [ref]{$endif}aArg4: Double);
  78. TTestProc12 = procedure(aArg1: Extended; var aArg2: Extended; out aArg3: Extended; {$ifdef fpc}constref{$else}const [ref]{$endif}aArg4: Extended);
  79. TTestProc13 = procedure(aArg1: Comp; var aArg2: Comp; out aArg3: Comp; {$ifdef fpc}constref{$else}const [ref]{$endif}aArg4: Comp);
  80. TTestProc14 = procedure(aArg1: Currency; var aArg2: Currency; out aArg3: Currency; {$ifdef fpc}constref{$else}const [ref]{$endif}aArg4: Currency);
  81. TTestProc15 = function(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: SizeInt): SizeInt;
  82. TTestProc16 = function(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Single): Single;
  83. TTestProc17 = function(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Double): Double;
  84. TTestProc18 = function(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Extended): Extended;
  85. TTestProc19 = function(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Comp): Comp;
  86. TTestProc20 = function(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Currency): Currency;
  87. TTestProc21 = procedure(var aArg1; out aArg2; const aArg3; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4);
  88. const
  89. SingleArg1: Single = 1.23;
  90. SingleArg2In: Single = 3.21;
  91. SingleArg2Out: Single = 2.34;
  92. SingleArg3Out: Single = 9.87;
  93. SingleArg4: Single = 7.89;
  94. SingleRes: Single = 4.32;
  95. SingleAddArg1 = Single(1.23);
  96. SingleAddArg2 = Single(2.34);
  97. SingleAddArg3 = Single(3.45);
  98. SingleAddArg4 = Single(4.56);
  99. SingleAddArg5 = Single(5.67);
  100. SingleAddArg6 = Single(9.87);
  101. SingleAddArg7 = Single(8.76);
  102. SingleAddArg8 = Single(7.65);
  103. SingleAddArg9 = Single(6.54);
  104. SingleAddArg10 = Single(5.43);
  105. SingleAddRes = SingleAddArg1 + SingleAddArg2 + SingleAddArg3 + SingleAddArg4 + SingleAddArg5 +
  106. SingleAddArg6 + SingleAddArg7 + SingleAddArg8 + SingleAddArg9 + SingleAddArg10;
  107. DoubleArg1: Double = 1.23;
  108. DoubleArg2In: Double = 3.21;
  109. DoubleArg2Out: Double = 2.34;
  110. DoubleArg3Out: Double = 9.87;
  111. DoubleArg4: Double = 7.89;
  112. DoubleRes: Double = 4.32;
  113. DoubleAddArg1 = Double(1.23);
  114. DoubleAddArg2 = Double(2.34);
  115. DoubleAddArg3 = Double(3.45);
  116. DoubleAddArg4 = Double(4.56);
  117. DoubleAddArg5 = Double(5.67);
  118. DoubleAddArg6 = Double(9.87);
  119. DoubleAddArg7 = Double(8.76);
  120. DoubleAddArg8 = Double(7.65);
  121. DoubleAddArg9 = Double(6.54);
  122. DoubleAddArg10 = Double(5.43);
  123. DoubleAddRes = DoubleAddArg1 + DoubleAddArg2 + DoubleAddArg3 + DoubleAddArg4 + DoubleAddArg5 +
  124. DoubleAddArg6 + DoubleAddArg7 + DoubleAddArg8 + DoubleAddArg9 + DoubleAddArg10;
  125. ExtendedArg1: Extended = 1.23;
  126. ExtendedArg2In: Extended = 3.21;
  127. ExtendedArg2Out: Extended = 2.34;
  128. ExtendedArg3Out: Extended = 9.87;
  129. ExtendedArg4: Extended = 7.89;
  130. ExtendedRes: Extended = 4.32;
  131. ExtendedAddArg1 = Extended(1.23);
  132. ExtendedAddArg2 = Extended(2.34);
  133. ExtendedAddArg3 = Extended(3.45);
  134. ExtendedAddArg4 = Extended(4.56);
  135. ExtendedAddArg5 = Extended(5.67);
  136. ExtendedAddArg6 = Extended(9.87);
  137. ExtendedAddArg7 = Extended(8.76);
  138. ExtendedAddArg8 = Extended(7.65);
  139. ExtendedAddArg9 = Extended(6.54);
  140. ExtendedAddArg10 = Extended(5.43);
  141. ExtendedAddRes = ExtendedAddArg1 + ExtendedAddArg2 + ExtendedAddArg3 + ExtendedAddArg4 + ExtendedAddArg5 +
  142. ExtendedAddArg6 + ExtendedAddArg7 + ExtendedAddArg8 + ExtendedAddArg9 + ExtendedAddArg10;
  143. CurrencyArg1: Currency = 1.23;
  144. CurrencyArg2In: Currency = 3.21;
  145. CurrencyArg2Out: Currency = 2.34;
  146. CurrencyArg3Out: Currency = 9.87;
  147. CurrencyArg4: Currency = 7.89;
  148. CurrencyRes: Currency = 4.32;
  149. CurrencyAddArg1 = Currency(1.23);
  150. CurrencyAddArg2 = Currency(2.34);
  151. CurrencyAddArg3 = Currency(3.45);
  152. CurrencyAddArg4 = Currency(4.56);
  153. CurrencyAddArg5 = Currency(5.67);
  154. CurrencyAddArg6 = Currency(9.87);
  155. CurrencyAddArg7 = Currency(8.76);
  156. CurrencyAddArg8 = Currency(7.65);
  157. CurrencyAddArg9 = Currency(6.54);
  158. CurrencyAddArg10 = Currency(5.43);
  159. CurrencyAddRes = CurrencyAddArg1 + CurrencyAddArg2 + CurrencyAddArg3 + CurrencyAddArg4 + CurrencyAddArg5 +
  160. CurrencyAddArg6 + CurrencyAddArg7 + CurrencyAddArg8 + CurrencyAddArg9 + CurrencyAddArg10;
  161. CompArg1: Comp = 123;
  162. CompArg2In: Comp = 321;
  163. CompArg2Out: Comp = 234;
  164. CompArg3Out: Comp = 987;
  165. CompArg4: Comp = 789;
  166. CompRes: Comp = 432;
  167. CompAddArg1 = Comp(123);
  168. CompAddArg2 = Comp(234);
  169. CompAddArg3 = Comp(345);
  170. CompAddArg4 = Comp(456);
  171. CompAddArg5 = Comp(567);
  172. CompAddArg6 = Comp(987);
  173. CompAddArg7 = Comp(876);
  174. CompAddArg8 = Comp(765);
  175. CompAddArg9 = Comp(654);
  176. CompAddArg10 = Comp(543);
  177. CompAddRes = CompAddArg1 + CompAddArg2 + CompAddArg3 + CompAddArg4 + CompAddArg5 +
  178. CompAddArg6 + CompAddArg7 + CompAddArg8 + CompAddArg9 + CompAddArg10;
  179. { TTestImpl }
  180. {$ifdef fpc}
  181. procedure TTestImpl.Status(const aMsg: String);
  182. begin
  183. {$ifdef debug}
  184. Writeln(aMsg);
  185. {$endif}
  186. end;
  187. procedure TTestImpl.Status(const aMsg: String; const aArgs: array of const);
  188. begin
  189. {$ifdef debug}
  190. Writeln(Format(aMsg, aArgs));
  191. {$endif}
  192. end;
  193. {$endif}
  194. {$ifdef fpc}
  195. procedure TTestImpl.OnHandleInvokable(aInvokable: TRttiInvokableType; const aArgs: TValueArray; out
  196. aResult: TValue);
  197. var
  198. selfofs, i: SizeInt;
  199. begin
  200. CheckTrue((aInvokable is TRttiMethodType) or (aInvokable is TRttiProcedureType), 'Invokable is not a method or procedure variable: ' + aInvokable.ClassName);
  201. selfofs := 0;
  202. if aInvokable is TRttiMethodType then
  203. selfofs := 1;
  204. Status('In Callback');
  205. Status('Self: ' + HexStr(Self));
  206. if Assigned(aInvokable.ReturnType) then
  207. aResult := CopyValue(ResultValue);
  208. Status('Setting input args');
  209. SetLength(InputArgs, Length(aArgs));
  210. for i := 0 to High(aArgs) do begin
  211. Status('Arg %d: %p %p', [i, aArgs[i].GetReferenceToRawData, PPointer(aArgs[i].GetReferenceToRawData)^]);
  212. if Assigned(InputUntypedTypes[i]) then
  213. TValue.Make(PPointer(aArgs[i].GetReferenceToRawData)^, InputUntypedTypes[i], InputArgs[i])
  214. else
  215. InputArgs[i] := CopyValue(aArgs[i]);
  216. end;
  217. Status('Setting output args');
  218. { Note: account for Self }
  219. for i := 0 to High(InOutMapping) do begin
  220. Status('OutputArg %d -> Arg %d', [i, InOutMapping[i] + selfofs]);
  221. { check input arg type? }
  222. Move(OutputArgs[i].GetReferenceToRawData^, aArgs[InOutMapping[i] + selfofs].GetReferenceToRawData^, OutputArgs[i].DataSize);
  223. end;
  224. Status('Callback done');
  225. end;
  226. procedure TTestImpl.DoMethodImpl(aTypeInfo: PTypeInfo; aInputArgs,
  227. aOutputArgs: TValueArray; aInOutMapping: array of SizeInt; aResult: TValue);
  228. var
  229. context: TRttiContext;
  230. t: TRttiType;
  231. callable, res: TValue;
  232. method: TRttiMethodType;
  233. i: SizeInt;
  234. input: array of TValue;
  235. impl: TMethodImplementation;
  236. mrec: TMethod;
  237. name: String;
  238. params: array of TRttiParameter;
  239. begin
  240. name := aTypeInfo^.Name;
  241. impl := Nil;
  242. context := TRttiContext.Create;
  243. try
  244. t := context.GetType(aTypeInfo);
  245. Check(t is TRttiMethodType, 'Not a method variable: ' + name);
  246. method := t as TRttiMethodType;
  247. Status('Executing method %s', [name]);
  248. CheckEquals(Length(aOutputArgs), Length(aInOutMapping), 'Invalid in/out mapping');
  249. Check(Length(aOutputArgs) <= Length(aInputArgs), 'Output args not part of input args');
  250. params := method.GetParameters;
  251. { arguments might be modified by Invoke (Note: Copy() does not uniquify the
  252. IValueData of managed types) }
  253. SetLength(input, Length(aInputArgs) + 1);
  254. SetLength(InputUntypedTypes, Length(aInputArgs) + 1);
  255. input[0] := GetPointerValue(Self);
  256. InputUntypedTypes[0] := Nil;
  257. for i := 0 to High(aInputArgs) do begin
  258. input[i + 1] := CopyValue(aInputArgs[i]);
  259. if not Assigned(params[i].ParamType) then
  260. InputUntypedTypes[i + 1] := aInputArgs[i].TypeInfo
  261. else
  262. InputUntypedTypes[i + 1] := Nil;
  263. end;
  264. impl := method.CreateImplementation({$ifdef fpc}@{$endif}OnHandleInvokable);
  265. CheckNotNull(impl, 'Method implementation is Nil');
  266. mrec.Data := Self;
  267. mrec.Code := impl.CodeAddress;
  268. TValue.Make(@mrec, aTypeInfo, callable);
  269. SetLength(InOutMapping, Length(aInOutMapping));
  270. for i := 0 to High(InOutMapping) do
  271. InOutMapping[i] := aInOutMapping[i];
  272. SetLength(OutputArgs, Length(aOutputArgs));
  273. for i := 0 to High(OutputArgs) do
  274. OutputArgs[i] := CopyValue(aOutputArgs[i]);
  275. ResultValue := aResult;
  276. res := method.Invoke(callable, aInputArgs);
  277. Status('After invoke');
  278. Check(EqualValues(ResultValue, res), 'Reported result value differs from returned for ' + name);
  279. Check(EqualValues(aResult, res), 'Expected result value differs from returned for ' + name);
  280. CheckEquals(Length(input), Length(InputArgs), 'Count of input args differs for ' + name);
  281. for i := 0 to High(input) do begin
  282. Check(EqualValues(input[i], InputArgs[i]), Format('Input argument %d differs for %s', [i + 1, name]));
  283. end;
  284. for i := 0 to High(aOutputArgs) do begin
  285. Check(EqualValues(aOutputArgs[i], aInputArgs[InOutMapping[i]]), Format('New output argument %d differs from expected output for %s', [i + 1, name]));
  286. end;
  287. finally
  288. impl.Free;
  289. context.Free;
  290. end;
  291. end;
  292. procedure TTestImpl.DoProcImpl(aTypeInfo: PTypeInfo; aInputArgs,
  293. aOutputArgs: TValueArray; aInOutMapping: array of SizeInt; aResult: TValue);
  294. var
  295. context: TRttiContext;
  296. t: TRttiType;
  297. callable, res: TValue;
  298. proc: TRttiProcedureType;
  299. i: SizeInt;
  300. input: array of TValue;
  301. impl: TMethodImplementation;
  302. name: String;
  303. cp: CodePointer;
  304. params: array of TRttiParameter;
  305. begin
  306. name := aTypeInfo^.Name;
  307. impl := Nil;
  308. context := TRttiContext.Create;
  309. try
  310. t := context.GetType(aTypeInfo);
  311. Check(t is TRttiProcedureType, 'Not a procedure variable: ' + name);
  312. proc := t as TRttiProcedureType;
  313. Status('Executing procedure %s', [name]);
  314. CheckEquals(Length(aOutputArgs), Length(aInOutMapping), 'Invalid in/out mapping');
  315. Check(Length(aOutputArgs) <= Length(aInputArgs), 'Output args not part of input args');
  316. params := proc.GetParameters;
  317. { arguments might be modified by Invoke (Note: Copy() does not uniquify the
  318. IValueData of managed types) }
  319. SetLength(input, Length(aInputArgs));
  320. SetLength(InputUntypedTypes, Length(aInputArgs));
  321. for i := 0 to High(aInputArgs) do begin
  322. input[i] := CopyValue(aInputArgs[i]);
  323. if not Assigned(params[i].ParamType) then
  324. InputUntypedTypes[i] := aInputArgs[i].TypeInfo
  325. else
  326. InputUntypedTypes[i] := Nil;
  327. end;
  328. impl := proc.CreateImplementation({$ifdef fpc}@{$endif}OnHandleInvokable);
  329. CheckNotNull(impl, 'Method implementation is Nil');
  330. cp := impl.CodeAddress;
  331. TValue.Make(@cp, aTypeInfo, callable);
  332. SetLength(InOutMapping, Length(aInOutMapping));
  333. for i := 0 to High(InOutMapping) do
  334. InOutMapping[i] := aInOutMapping[i];
  335. SetLength(OutputArgs, Length(aOutputArgs));
  336. for i := 0 to High(OutputArgs) do
  337. OutputArgs[i] := CopyValue(aOutputArgs[i]);
  338. ResultValue := aResult;
  339. res := proc.Invoke(callable, aInputArgs);
  340. Status('After invoke');
  341. Check(EqualValues(ResultValue, res), 'Reported result value differs from returned for ' + name);
  342. Check(EqualValues(aResult, res), 'Expected result value differs from returned for ' + name);
  343. CheckEquals(Length(input), Length(InputArgs), 'Count of input args differs for ' + name);
  344. for i := 0 to High(input) do begin
  345. Check(EqualValues(input[i], InputArgs[i]), Format('Input argument %d differs for %s', [i + 1, name]));
  346. end;
  347. for i := 0 to High(aOutputArgs) do begin
  348. Check(EqualValues(aOutputArgs[i], aInputArgs[InOutMapping[i]]), Format('New output argument %d differs from expected output for %s', [i + 1, name]));
  349. end;
  350. finally
  351. impl.Free;
  352. context.Free;
  353. end;
  354. end;
  355. {$endif}
  356. {$ifndef InLazIDE}
  357. {$ifdef fpc}generic{$endif} procedure TTestImpl.GenDoMethodImpl<T>(aInputArgs, aOutputArgs: TValueArray; aInOutMapping: array of SizeInt; aResult: TValue);
  358. begin
  359. DoMethodImpl(TypeInfo(T), aInputArgs, aOutputArgs, aInOutMapping, aResult);
  360. end;
  361. {$ifdef fpc}generic{$endif} procedure TTestImpl.GenDoProcImpl<T>(aInputArgs, aOutputArgs: TValueArray; aInOutMapping: array of SizeInt; aResult: TValue);
  362. begin
  363. DoProcImpl(TypeInfo(T), aInputArgs, aOutputArgs, aInOutMapping, aResult);
  364. end;
  365. {$endif}
  366. {$ifdef fpc}
  367. procedure TTestImpl.TestMethodVars;
  368. begin
  369. {$ifdef fpc}specialize{$endif}GenDoMethodImpl<TTestMethod1>([], [], [], TValue.Empty);
  370. {$ifdef fpc}specialize{$endif}GenDoMethodImpl<TTestMethod2>([GetIntValue(42)], [], [], GetIntValue(21));
  371. {$ifdef fpc}specialize{$endif}GenDoMethodImpl<TTestMethod3>([GetAnsiString('Hello World')], [], [], TValue.Empty);
  372. {$ifdef fpc}specialize{$endif}GenDoMethodImpl<TTestMethod4>([GetShortString('Hello World')], [], [], TValue.Empty);
  373. {$ifdef fpc}specialize{$endif}GenDoMethodImpl<TTestMethod5>([], [], [], GetAnsiString('Hello World'));
  374. {$ifdef fpc}specialize{$endif}GenDoMethodImpl<TTestMethod6>([], [], [], GetShortString('Hello World'));
  375. {$ifdef fpc}specialize{$endif}GenDoMethodImpl<TTestMethod7>([
  376. GetIntValue(1234), GetIntValue(4321), GetIntValue(0), GetIntValue(9876)
  377. ], [
  378. GetIntValue(5678), GetIntValue(6789)
  379. ], [1, 2], TValue.Empty);
  380. {$ifdef fpc}specialize{$endif}GenDoMethodImpl<TTestMethod8>([
  381. GetAnsiString('Alpha'), GetAnsiString('Beta'), GetAnsiString(''), GetAnsiString('Delta')
  382. ], [
  383. GetAnsiString('Gamma'), GetAnsiString('Epsilon')
  384. ], [1, 2], TValue.Empty);
  385. {$ifdef fpc}specialize{$endif}GenDoMethodImpl<TTestMethod9>([
  386. GetShortString('Alpha'), GetShortString('Beta'), GetShortString(''), GetShortString('Delta')
  387. ], [
  388. GetShortString('Gamma'), GetShortString('Epsilon')
  389. ], [1, 2], TValue.Empty);
  390. {$ifdef fpc}specialize{$endif}GenDoMethodImpl<TTestMethod10>([
  391. GetSingleValue(SingleArg1), GetSingleValue(SingleArg2In), GetSingleValue(0), GetSingleValue(SingleArg4)
  392. ], [
  393. GetSingleValue(SingleArg2Out), GetSingleValue(SingleArg3Out)
  394. ], [1, 2], TValue.Empty);
  395. {$ifdef fpc}specialize{$endif}GenDoMethodImpl<TTestMethod11>([
  396. GetDoubleValue(DoubleArg1), GetDoubleValue(DoubleArg2In), GetDoubleValue(0), GetDoubleValue(DoubleArg4)
  397. ], [
  398. GetDoubleValue(DoubleArg2Out), GetDoubleValue(DoubleArg3Out)
  399. ], [1, 2], TValue.Empty);
  400. {$ifdef fpc}specialize{$endif}GenDoMethodImpl<TTestMethod12>([
  401. GetExtendedValue(ExtendedArg1), GetExtendedValue(ExtendedArg2In), GetExtendedValue(0), GetExtendedValue(ExtendedArg4)
  402. ], [
  403. GetExtendedValue(ExtendedArg2Out), GetExtendedValue(ExtendedArg3Out)
  404. ], [1, 2], TValue.Empty);
  405. {$ifdef fpc}specialize{$endif}GenDoMethodImpl<TTestMethod13>([
  406. GetCompValue(CompArg1), GetCompValue(CompArg2In), GetCompValue(0), GetCompValue(CompArg4)
  407. ], [
  408. GetCompValue(CompArg2Out), GetCompValue(CompArg3Out)
  409. ], [1, 2], TValue.Empty);
  410. {$ifdef fpc}specialize{$endif}GenDoMethodImpl<TTestMethod14>([
  411. GetCurrencyValue(CurrencyArg1), GetCurrencyValue(CurrencyArg2In), GetCurrencyValue(0), GetCurrencyValue(CurrencyArg4)
  412. ], [
  413. GetCurrencyValue(CurrencyArg2Out), GetCurrencyValue(CurrencyArg3Out)
  414. ], [1, 2], TValue.Empty);
  415. {$ifdef fpc}specialize{$endif}GenDoMethodImpl<TTestMethod15>([
  416. GetIntValue(1), GetIntValue(2), GetIntValue(3), GetIntValue(4), GetIntValue(5),
  417. GetIntValue(6), GetIntValue(7), GetIntValue(8), GetIntValue(9), GetIntValue(10)
  418. ], [], [], GetIntValue(11));
  419. {$ifdef fpc}specialize{$endif}GenDoMethodImpl<TTestMethod16>([
  420. GetSingleValue(SingleAddArg1), GetSingleValue(SingleAddArg2), GetSingleValue(SingleAddArg3), GetSingleValue(SingleAddArg4), GetSingleValue(SingleAddArg5),
  421. GetSingleValue(SingleAddArg6), GetSingleValue(SingleAddArg7), GetSingleValue(SingleAddArg8), GetSingleValue(SingleAddArg9), GetSingleValue(SingleAddArg10)
  422. ], [], [], GetSingleValue(SingleAddRes));
  423. {$ifdef fpc}specialize{$endif}GenDoMethodImpl<TTestMethod17>([
  424. GetDoubleValue(DoubleAddArg1), GetDoubleValue(DoubleAddArg2), GetDoubleValue(DoubleAddArg3), GetDoubleValue(DoubleAddArg4), GetDoubleValue(DoubleAddArg5),
  425. GetDoubleValue(DoubleAddArg6), GetDoubleValue(DoubleAddArg7), GetDoubleValue(DoubleAddArg8), GetDoubleValue(DoubleAddArg9), GetDoubleValue(DoubleAddArg10)
  426. ], [], [], GetDoubleValue(DoubleAddRes));
  427. {$ifdef fpc}specialize{$endif}GenDoMethodImpl<TTestMethod18>([
  428. GetExtendedValue(ExtendedAddArg1), GetExtendedValue(ExtendedAddArg2), GetExtendedValue(ExtendedAddArg3), GetExtendedValue(ExtendedAddArg4), GetExtendedValue(ExtendedAddArg5),
  429. GetExtendedValue(ExtendedAddArg6), GetExtendedValue(ExtendedAddArg7), GetExtendedValue(ExtendedAddArg8), GetExtendedValue(ExtendedAddArg9), GetExtendedValue(ExtendedAddArg10)
  430. ], [], [], GetExtendedValue(ExtendedAddRes));
  431. {$ifdef fpc}specialize{$endif}GenDoMethodImpl<TTestMethod19>([
  432. GetCompValue(CompAddArg1), GetCompValue(CompAddArg2), GetCompValue(CompAddArg3), GetCompValue(CompAddArg4), GetCompValue(CompAddArg5),
  433. GetCompValue(CompAddArg6), GetCompValue(CompAddArg7), GetCompValue(CompAddArg8), GetCompValue(CompAddArg9), GetCompValue(CompAddArg10)
  434. ], [], [], GetCompValue(CompAddRes));
  435. {$ifdef fpc}specialize{$endif}GenDoMethodImpl<TTestMethod20>([
  436. GetCurrencyValue(CurrencyAddArg1), GetCurrencyValue(CurrencyAddArg2), GetCurrencyValue(CurrencyAddArg3), GetCurrencyValue(CurrencyAddArg4), GetCurrencyValue(CurrencyAddArg5),
  437. GetCurrencyValue(CurrencyAddArg6), GetCurrencyValue(CurrencyAddArg7), GetCurrencyValue(CurrencyAddArg8), GetCurrencyValue(CurrencyAddArg9), GetCurrencyValue(CurrencyAddArg10)
  438. ], [], [], GetCurrencyValue(CurrencyAddRes));
  439. {$ifdef fpc}specialize{$endif}GenDoMethodImpl<TTestMethod21>([
  440. GetIntValue(1234), GetIntValue(4321), GetIntValue(0), GetIntValue(9876)
  441. ], [
  442. GetIntValue(5678), GetIntValue(6789)
  443. ], [0, 1], TValue.Empty);
  444. {$ifdef fpc}specialize{$endif}GenDoMethodImpl<TTestMethod21>([
  445. GetAnsiString('Alpha'), GetAnsiString('Beta'), GetAnsiString(''), GetAnsiString('Delta')
  446. ], [
  447. GetAnsiString('Gamma'), GetAnsiString('Epsilon')
  448. ], [0, 1], TValue.Empty);
  449. { for some reason this fails, though it fails in Delphi as well :/ }
  450. {{$ifdef fpc}specialize{$endif}GenDoMethodImpl<TTestMethod21>([
  451. GetShortString('Alpha'), GetShortString('Beta'), GetShortString(''), GetShortString('Delta')
  452. ], [
  453. GetShortString('Gamma'), GetShortString('Epsilon')
  454. ], [0, 1], TValue.Empty);}
  455. end;
  456. procedure TTestImpl.TestProcVars;
  457. begin
  458. {$ifdef fpc}specialize{$endif}GenDoProcImpl<TTestProc1>([], [], [], TValue.Empty);
  459. {$ifdef fpc}specialize{$endif}GenDoProcImpl<TTestProc2>([GetIntValue(42)], [], [], GetIntValue(21));
  460. {$ifdef fpc}specialize{$endif}GenDoProcImpl<TTestProc3>([GetAnsiString('Hello World')], [], [], TValue.Empty);
  461. {$ifdef fpc}specialize{$endif}GenDoProcImpl<TTestProc4>([GetShortString('Hello World')], [], [], TValue.Empty);
  462. {$ifdef fpc}specialize{$endif}GenDoProcImpl<TTestProc5>([], [], [], GetAnsiString('Hello World'));
  463. {$ifdef fpc}specialize{$endif}GenDoProcImpl<TTestProc6>([], [], [], GetShortString('Hello World'));
  464. {$ifdef fpc}specialize{$endif}GenDoProcImpl<TTestProc7>([
  465. GetIntValue(1234), GetIntValue(4321), GetIntValue(0), GetIntValue(9876)
  466. ], [
  467. GetIntValue(5678), GetIntValue(6789)
  468. ], [1, 2], TValue.Empty);
  469. {$ifdef fpc}specialize{$endif}GenDoProcImpl<TTestProc8>([
  470. GetAnsiString('Alpha'), GetAnsiString('Beta'), GetAnsiString(''), GetAnsiString('Delta')
  471. ], [
  472. GetAnsiString('Gamma'), GetAnsiString('Epsilon')
  473. ], [1, 2], TValue.Empty);
  474. {$ifdef fpc}specialize{$endif}GenDoProcImpl<TTestProc9>([
  475. GetShortString('Alpha'), GetShortString('Beta'), GetShortString(''), GetShortString('Delta')
  476. ], [
  477. GetShortString('Gamma'), GetShortString('Epsilon')
  478. ], [1, 2], TValue.Empty);
  479. {$ifdef fpc}specialize{$endif}GenDoProcImpl<TTestProc10>([
  480. GetSingleValue(SingleArg1), GetSingleValue(SingleArg2In), GetSingleValue(0), GetSingleValue(SingleArg4)
  481. ], [
  482. GetSingleValue(SingleArg2Out), GetSingleValue(SingleArg3Out)
  483. ], [1, 2], TValue.Empty);
  484. {$ifdef fpc}specialize{$endif}GenDoProcImpl<TTestProc11>([
  485. GetDoubleValue(DoubleArg1), GetDoubleValue(DoubleArg2In), GetDoubleValue(0), GetDoubleValue(DoubleArg4)
  486. ], [
  487. GetDoubleValue(DoubleArg2Out), GetDoubleValue(DoubleArg3Out)
  488. ], [1, 2], TValue.Empty);
  489. {$ifdef fpc}specialize{$endif}GenDoProcImpl<TTestProc12>([
  490. GetExtendedValue(ExtendedArg1), GetExtendedValue(ExtendedArg2In), GetExtendedValue(0), GetExtendedValue(ExtendedArg4)
  491. ], [
  492. GetExtendedValue(ExtendedArg2Out), GetExtendedValue(ExtendedArg3Out)
  493. ], [1, 2], TValue.Empty);
  494. {$ifdef fpc}specialize{$endif}GenDoProcImpl<TTestProc13>([
  495. GetCompValue(CompArg1), GetCompValue(CompArg2In), GetCompValue(0), GetCompValue(CompArg4)
  496. ], [
  497. GetCompValue(CompArg2Out), GetCompValue(CompArg3Out)
  498. ], [1, 2], TValue.Empty);
  499. {$ifdef fpc}specialize{$endif}GenDoProcImpl<TTestProc14>([
  500. GetCurrencyValue(CurrencyArg1), GetCurrencyValue(CurrencyArg2In), GetCurrencyValue(0), GetCurrencyValue(CurrencyArg4)
  501. ], [
  502. GetCurrencyValue(CurrencyArg2Out), GetCurrencyValue(CurrencyArg3Out)
  503. ], [1, 2], TValue.Empty);
  504. {$ifdef fpc}specialize{$endif}GenDoProcImpl<TTestProc15>([
  505. GetIntValue(1), GetIntValue(2), GetIntValue(3), GetIntValue(4), GetIntValue(5),
  506. GetIntValue(6), GetIntValue(7), GetIntValue(8), GetIntValue(9), GetIntValue(10)
  507. ], [], [], GetIntValue(11));
  508. {$ifdef fpc}specialize{$endif}GenDoProcImpl<TTestProc16>([
  509. GetSingleValue(SingleAddArg1), GetSingleValue(SingleAddArg2), GetSingleValue(SingleAddArg3), GetSingleValue(SingleAddArg4), GetSingleValue(SingleAddArg5),
  510. GetSingleValue(SingleAddArg6), GetSingleValue(SingleAddArg7), GetSingleValue(SingleAddArg8), GetSingleValue(SingleAddArg9), GetSingleValue(SingleAddArg10)
  511. ], [], [], GetSingleValue(SingleAddRes));
  512. {$ifdef fpc}specialize{$endif}GenDoProcImpl<TTestProc17>([
  513. GetDoubleValue(DoubleAddArg1), GetDoubleValue(DoubleAddArg2), GetDoubleValue(DoubleAddArg3), GetDoubleValue(DoubleAddArg4), GetDoubleValue(DoubleAddArg5),
  514. GetDoubleValue(DoubleAddArg6), GetDoubleValue(DoubleAddArg7), GetDoubleValue(DoubleAddArg8), GetDoubleValue(DoubleAddArg9), GetDoubleValue(DoubleAddArg10)
  515. ], [], [], GetDoubleValue(DoubleAddRes));
  516. {$ifdef fpc}specialize{$endif}GenDoProcImpl<TTestProc18>([
  517. GetExtendedValue(ExtendedAddArg1), GetExtendedValue(ExtendedAddArg2), GetExtendedValue(ExtendedAddArg3), GetExtendedValue(ExtendedAddArg4), GetExtendedValue(ExtendedAddArg5),
  518. GetExtendedValue(ExtendedAddArg6), GetExtendedValue(ExtendedAddArg7), GetExtendedValue(ExtendedAddArg8), GetExtendedValue(ExtendedAddArg9), GetExtendedValue(ExtendedAddArg10)
  519. ], [], [], GetExtendedValue(ExtendedAddRes));
  520. {$ifdef fpc}specialize{$endif}GenDoProcImpl<TTestProc19>([
  521. GetCompValue(CompAddArg1), GetCompValue(CompAddArg2), GetCompValue(CompAddArg3), GetCompValue(CompAddArg4), GetCompValue(CompAddArg5),
  522. GetCompValue(CompAddArg6), GetCompValue(CompAddArg7), GetCompValue(CompAddArg8), GetCompValue(CompAddArg9), GetCompValue(CompAddArg10)
  523. ], [], [], GetCompValue(CompAddRes));
  524. {$ifdef fpc}specialize{$endif}GenDoProcImpl<TTestProc20>([
  525. GetCurrencyValue(CurrencyAddArg1), GetCurrencyValue(CurrencyAddArg2), GetCurrencyValue(CurrencyAddArg3), GetCurrencyValue(CurrencyAddArg4), GetCurrencyValue(CurrencyAddArg5),
  526. GetCurrencyValue(CurrencyAddArg6), GetCurrencyValue(CurrencyAddArg7), GetCurrencyValue(CurrencyAddArg8), GetCurrencyValue(CurrencyAddArg9), GetCurrencyValue(CurrencyAddArg10)
  527. ], [], [], GetCurrencyValue(CurrencyAddRes));
  528. {$ifdef fpc}specialize{$endif}GenDoProcImpl<TTestProc21>([
  529. GetIntValue(1234), GetIntValue(4321), GetIntValue(0), GetIntValue(9876)
  530. ], [
  531. GetIntValue(5678), GetIntValue(6789)
  532. ], [0, 1], TValue.Empty);
  533. {$ifdef fpc}specialize{$endif}GenDoProcImpl<TTestProc21>([
  534. GetAnsiString('Alpha'), GetAnsiString('Beta'), GetAnsiString(''), GetAnsiString('Delta')
  535. ], [
  536. GetAnsiString('Gamma'), GetAnsiString('Epsilon')
  537. ], [0, 1], TValue.Empty);
  538. { for some reason this fails, though it fails in Delphi as well :/ }
  539. {{$ifdef fpc}specialize{$endif}GenDoProcImpl<TTestProc21>([
  540. GetShortString('Alpha'), GetShortString('Beta'), GetShortString(''), GetShortString('Delta')
  541. ], [
  542. GetShortString('Gamma'), GetShortString('Epsilon')
  543. ], [0, 1], TValue.Empty);}
  544. end;
  545. {$endif}
  546. initialization
  547. {$ifdef fpc}
  548. RegisterTest(TTestImpl);
  549. {$else fpc}
  550. RegisterTest(TTestImpl.Suite);
  551. {$endif fpc}
  552. end.