tests.rtti.invoketypes.pas 46 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095
  1. unit tests.rtti.invoketypes;
  2. {$ifdef fpc}
  3. {$mode ObjFPC}{$H+}
  4. {$endif}
  5. interface
  6. uses
  7. Classes, SysUtils, RTTI;
  8. const
  9. SingleArg1: Single = 1.23;
  10. SingleArg2In: Single = 3.21;
  11. SingleArg2Out: Single = 2.34;
  12. SingleArg3Out: Single = 9.87;
  13. SingleArg4: Single = 7.89;
  14. SingleRes: Single = 4.32;
  15. SingleAddArg1 = Single(1.23);
  16. SingleAddArg2 = Single(2.34);
  17. SingleAddArg3 = Single(3.45);
  18. SingleAddArg4 = Single(4.56);
  19. SingleAddArg5 = Single(5.67);
  20. SingleAddArg6 = Single(9.87);
  21. SingleAddArg7 = Single(8.76);
  22. SingleAddArg8 = Single(7.65);
  23. SingleAddArg9 = Single(6.54);
  24. SingleAddArg10 = Single(5.43);
  25. SingleAddRes = SingleAddArg1 + SingleAddArg2 + SingleAddArg3 + SingleAddArg4 + SingleAddArg5 +
  26. SingleAddArg6 + SingleAddArg7 + SingleAddArg8 + SingleAddArg9 + SingleAddArg10;
  27. DoubleArg1: Double = 1.23;
  28. DoubleArg2In: Double = 3.21;
  29. DoubleArg2Out: Double = 2.34;
  30. DoubleArg3Out: Double = 9.87;
  31. DoubleArg4: Double = 7.89;
  32. DoubleRes: Double = 4.32;
  33. DoubleAddArg1 = Double(1.23);
  34. DoubleAddArg2 = Double(2.34);
  35. DoubleAddArg3 = Double(3.45);
  36. DoubleAddArg4 = Double(4.56);
  37. DoubleAddArg5 = Double(5.67);
  38. DoubleAddArg6 = Double(9.87);
  39. DoubleAddArg7 = Double(8.76);
  40. DoubleAddArg8 = Double(7.65);
  41. DoubleAddArg9 = Double(6.54);
  42. DoubleAddArg10 = Double(5.43);
  43. DoubleAddRes = DoubleAddArg1 + DoubleAddArg2 + DoubleAddArg3 + DoubleAddArg4 + DoubleAddArg5 +
  44. DoubleAddArg6 + DoubleAddArg7 + DoubleAddArg8 + DoubleAddArg9 + DoubleAddArg10;
  45. ExtendedArg1: Extended = 1.23;
  46. ExtendedArg2In: Extended = 3.21;
  47. ExtendedArg2Out: Extended = 2.34;
  48. ExtendedArg3Out: Extended = 9.87;
  49. ExtendedArg4: Extended = 7.89;
  50. ExtendedRes: Extended = 4.32;
  51. ExtendedAddArg1 = Extended(1.23);
  52. ExtendedAddArg2 = Extended(2.34);
  53. ExtendedAddArg3 = Extended(3.45);
  54. ExtendedAddArg4 = Extended(4.56);
  55. ExtendedAddArg5 = Extended(5.67);
  56. ExtendedAddArg6 = Extended(9.87);
  57. ExtendedAddArg7 = Extended(8.76);
  58. ExtendedAddArg8 = Extended(7.65);
  59. ExtendedAddArg9 = Extended(6.54);
  60. ExtendedAddArg10 = Extended(5.43);
  61. ExtendedAddRes = ExtendedAddArg1 + ExtendedAddArg2 + ExtendedAddArg3 + ExtendedAddArg4 + ExtendedAddArg5 +
  62. ExtendedAddArg6 + ExtendedAddArg7 + ExtendedAddArg8 + ExtendedAddArg9 + ExtendedAddArg10;
  63. CurrencyArg1: Currency = 1.23;
  64. CurrencyArg2In: Currency = 3.21;
  65. CurrencyArg2Out: Currency = 2.34;
  66. CurrencyArg3Out: Currency = 9.87;
  67. CurrencyArg4: Currency = 7.89;
  68. CurrencyRes: Currency = 4.32;
  69. CurrencyAddArg1 = Currency(1.23);
  70. CurrencyAddArg2 = Currency(2.34);
  71. CurrencyAddArg3 = Currency(3.45);
  72. CurrencyAddArg4 = Currency(4.56);
  73. CurrencyAddArg5 = Currency(5.67);
  74. CurrencyAddArg6 = Currency(9.87);
  75. CurrencyAddArg7 = Currency(8.76);
  76. CurrencyAddArg8 = Currency(7.65);
  77. CurrencyAddArg9 = Currency(6.54);
  78. CurrencyAddArg10 = Currency(5.43);
  79. CurrencyAddRes = CurrencyAddArg1 + CurrencyAddArg2 + CurrencyAddArg3 + CurrencyAddArg4 + CurrencyAddArg5 +
  80. CurrencyAddArg6 + CurrencyAddArg7 + CurrencyAddArg8 + CurrencyAddArg9 + CurrencyAddArg10;
  81. CompArg1: Comp = 123;
  82. CompArg2In: Comp = 321;
  83. CompArg2Out: Comp = 234;
  84. CompArg3Out: Comp = 987;
  85. CompArg4: Comp = 789;
  86. CompRes: Comp = 432;
  87. CompAddArg1 = Comp(123);
  88. CompAddArg2 = Comp(234);
  89. CompAddArg3 = Comp(345);
  90. CompAddArg4 = Comp(456);
  91. CompAddArg5 = Comp(567);
  92. CompAddArg6 = Comp(987);
  93. CompAddArg7 = Comp(876);
  94. CompAddArg8 = Comp(765);
  95. CompAddArg9 = Comp(654);
  96. CompAddArg10 = Comp(543);
  97. CompAddRes = CompAddArg1 + CompAddArg2 + CompAddArg3 + CompAddArg4 + CompAddArg5 +
  98. CompAddArg6 + CompAddArg7 + CompAddArg8 + CompAddArg9 + CompAddArg10;
  99. type
  100. TTestRecord1 = packed record
  101. b: array[0..0] of Byte;
  102. end;
  103. TTestRecord2 = packed record
  104. b: array[0..1] of Byte;
  105. end;
  106. TTestRecord3 = packed record
  107. b: array[0..2] of Byte;
  108. end;
  109. TTestRecord4 = packed record
  110. b: array[0..3] of Byte;
  111. end;
  112. TTestRecord5 = packed record
  113. b: array[0..4] of Byte;
  114. end;
  115. TTestRecord6 = packed record
  116. b: array[0..5] of Byte;
  117. end;
  118. TTestRecord7 = packed record
  119. b: array[0..6] of Byte;
  120. end;
  121. TTestRecord8 = packed record
  122. b: array[0..7] of Byte;
  123. end;
  124. TTestRecord9 = packed record
  125. b: array[0..8] of Byte;
  126. end;
  127. TTestRecord10 = packed record
  128. b: array[0..9] of Byte;
  129. end;
  130. {$M+}
  131. ITestInterface = interface
  132. procedure Test1;
  133. function Test2: SizeInt;
  134. function Test3(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: SizeInt): SizeInt;
  135. procedure Test4(aArg1: AnsiString; aArg2: UnicodeString; aArg3: WideString; aArg4: ShortString);
  136. function Test5: AnsiString;
  137. function Test6: UnicodeString;
  138. function Test7: WideString;
  139. function Test8: ShortString;
  140. procedure Test9(aArg1: SizeInt; var aArg2: SizeInt; out aArg3: SizeInt; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: SizeInt);
  141. procedure Test10(aArg1: AnsiString; var aArg2: AnsiString; out aArg3: AnsiString; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: AnsiString);
  142. procedure Test11(aArg1: ShortString; var aArg2: ShortString; out aArg3: ShortString; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: ShortString);
  143. procedure Test12(aArg1: array of SizeInt; var aArg2: array of SizeInt; out aArg3: array of SizeInt; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: array of SizeInt);
  144. function Test13(aArg1: Single; var aArg2: Single; out aArg3: Single; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Single): Single;
  145. function Test14(aArg1: Double; var aArg2: Double; out aArg3: Double; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Double): Double;
  146. function Test15(aArg1: Extended; var aArg2: Extended; out aArg3: Extended; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Extended): Extended;
  147. function Test16(aArg1: Comp; var aArg2: Comp; out aArg3: Comp; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Comp): Comp;
  148. function Test17(aArg1: Currency; var aArg2: Currency; out aArg3: Currency; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Currency): Currency;
  149. function Test18(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Single): Single;
  150. function Test19(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Double): Double;
  151. function Test20(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Extended): Extended;
  152. function Test21(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Comp): Comp;
  153. function Test22(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Currency): Currency;
  154. function Test23(aArg1 : Variant) : AnsiString;
  155. function TestRecSize1(aArg1: TTestRecord1): TTestRecord1;
  156. function TestRecSize2(aArg1: TTestRecord2): TTestRecord2;
  157. function TestRecSize3(aArg1: TTestRecord3): TTestRecord3;
  158. function TestRecSize4(aArg1: TTestRecord4): TTestRecord4;
  159. function TestRecSize5(aArg1: TTestRecord5): TTestRecord5;
  160. function TestRecSize6(aArg1: TTestRecord6): TTestRecord6;
  161. function TestRecSize7(aArg1: TTestRecord7): TTestRecord7;
  162. function TestRecSize8(aArg1: TTestRecord8): TTestRecord8;
  163. function TestRecSize9(aArg1: TTestRecord9): TTestRecord9;
  164. function TestRecSize10(aArg1: TTestRecord10): TTestRecord10;
  165. procedure TestUntyped(var aArg1; out aArg2; const aArg3; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4);
  166. end;
  167. {$M-}
  168. { TTestInterfaceClass }
  169. TTestInterfaceClass = class(TInterfacedObject, ITestInterface)
  170. public
  171. procedure Test1;
  172. function Test2: SizeInt;
  173. function Test3(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: SizeInt): SizeInt;
  174. procedure Test4(aArg1: AnsiString; aArg2: UnicodeString; aArg3: WideString; aArg4: ShortString);
  175. function Test5: AnsiString;
  176. function Test6: UnicodeString;
  177. function Test7: WideString;
  178. function Test8: ShortString;
  179. procedure Test9(aArg1: SizeInt; var aArg2: SizeInt; out aArg3: SizeInt; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: SizeInt);
  180. procedure Test10(aArg1: AnsiString; var aArg2: AnsiString; out aArg3: AnsiString; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: AnsiString);
  181. procedure Test11(aArg1: ShortString; var aArg2: ShortString; out aArg3: ShortString; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: ShortString);
  182. procedure Test12(aArg1: array of SizeInt; var aArg2: array of SizeInt; out aArg3: array of SizeInt; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: array of SizeInt);
  183. function Test13(aArg1: Single; var aArg2: Single; out aArg3: Single; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Single): Single;
  184. function Test14(aArg1: Double; var aArg2: Double; out aArg3: Double; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Double): Double;
  185. function Test15(aArg1: Extended; var aArg2: Extended; out aArg3: Extended; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Extended): Extended;
  186. function Test16(aArg1: Comp; var aArg2: Comp; out aArg3: Comp; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Comp): Comp;
  187. function Test17(aArg1: Currency; var aArg2: Currency; out aArg3: Currency; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Currency): Currency;
  188. function Test18(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Single): Single;
  189. function Test19(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Double): Double;
  190. function Test20(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Extended): Extended;
  191. function Test21(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Comp): Comp;
  192. function Test22(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Currency): Currency;
  193. function Test23(aArg1 : Variant) : AnsiString;
  194. function TestRecSize1(aArg1: TTestRecord1): TTestRecord1;
  195. function TestRecSize2(aArg1: TTestRecord2): TTestRecord2;
  196. function TestRecSize3(aArg1: TTestRecord3): TTestRecord3;
  197. function TestRecSize4(aArg1: TTestRecord4): TTestRecord4;
  198. function TestRecSize5(aArg1: TTestRecord5): TTestRecord5;
  199. function TestRecSize6(aArg1: TTestRecord6): TTestRecord6;
  200. function TestRecSize7(aArg1: TTestRecord7): TTestRecord7;
  201. function TestRecSize8(aArg1: TTestRecord8): TTestRecord8;
  202. function TestRecSize9(aArg1: TTestRecord9): TTestRecord9;
  203. function TestRecSize10(aArg1: TTestRecord10): TTestRecord10;
  204. procedure TestUntyped(var aArg1; out aArg2; const aArg3; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4);
  205. public
  206. InputArgs: array of TValue;
  207. OutputArgs: array of TValue;
  208. ExpectedArgs: array of TValue;
  209. OutArgs: array of TValue;
  210. ResultValue: TValue;
  211. CalledMethod: SizeInt;
  212. InOutMapping: array of SizeInt;
  213. procedure Reset;
  214. function DoAddRef : longint;
  215. function DoRelease : longint;
  216. Destructor Destroy; override;
  217. public class var
  218. ProcVarInst: TTestInterfaceClass;
  219. ProcVarRecInst: TTestInterfaceClass;
  220. public const
  221. RecSizeMarker = SizeInt($80000000);
  222. end;
  223. TMethodTest1 = procedure of object;
  224. TMethodTest2 = function: SizeInt of object;
  225. TMethodTest3 = function(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: SizeInt): SizeInt of object;
  226. TMethodTest4 = procedure(aArg1: AnsiString; aArg2: UnicodeString; aArg3: WideString; aArg4: ShortString) of object;
  227. TMethodTest5 = function: AnsiString of object;
  228. TMethodTest6 = function: UnicodeString of object;
  229. TMethodTest7 = function: WideString of object;
  230. TMethodTest8 = function: ShortString of object;
  231. TMethodTest9 = procedure(aArg1: SizeInt; var aArg2: SizeInt; out aArg3: SizeInt; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: SizeInt) of object;
  232. TMethodTest10 = procedure(aArg1: AnsiString; var aArg2: AnsiString; out aArg3: AnsiString; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: AnsiString) of object;
  233. TMethodTest11 = procedure(aArg1: ShortString; var aArg2: ShortString; out aArg3: ShortString; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: ShortString) of object;
  234. TMethodTest12 = procedure(aArg1: array of SizeInt; var aArg2: array of SizeInt; out aArg3: array of SizeInt; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: array of SizeInt) of object;
  235. TMethodTest13 = function(aArg1: Single; var aArg2: Single; out aArg3: Single; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Single): Single of object;
  236. TMethodTest14 = function(aArg1: Double; var aArg2: Double; out aArg3: Double; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Double): Double of object;
  237. TMethodTest15 = function(aArg1: Extended; var aArg2: Extended; out aArg3: Extended; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Extended): Extended of object;
  238. TMethodTest16 = function(aArg1: Comp; var aArg2: Comp; out aArg3: Comp; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Comp): Comp of object;
  239. TMethodTest17 = function(aArg1: Currency; var aArg2: Currency; out aArg3: Currency; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Currency): Currency of object;
  240. TMethodTest18 = function(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Single): Single of object;
  241. TMethodTest19 = function(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Double): Double of object;
  242. TMethodTest20 = function(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Extended): Extended of object;
  243. TMethodTest21 = function(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Comp): Comp of object;
  244. TMethodTest22 = function(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Currency): Currency of object;
  245. TMethodTestRecSize1 = function(aArg1: TTestRecord1): TTestRecord1 of object;
  246. TMethodTestRecSize2 = function(aArg1: TTestRecord2): TTestRecord2 of object;
  247. TMethodTestRecSize3 = function(aArg1: TTestRecord3): TTestRecord3 of object;
  248. TMethodTestRecSize4 = function(aArg1: TTestRecord4): TTestRecord4 of object;
  249. TMethodTestRecSize5 = function(aArg1: TTestRecord5): TTestRecord5 of object;
  250. TMethodTestRecSize6 = function(aArg1: TTestRecord6): TTestRecord6 of object;
  251. TMethodTestRecSize7 = function(aArg1: TTestRecord7): TTestRecord7 of object;
  252. TMethodTestRecSize8 = function(aArg1: TTestRecord8): TTestRecord8 of object;
  253. TMethodTestRecSize9 = function(aArg1: TTestRecord9): TTestRecord9 of object;
  254. TMethodTestRecSize10 = function(aArg1: TTestRecord10): TTestRecord10 of object;
  255. TMethodTestUntyped = procedure(var aArg1; out aArg2; const aArg3; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4) of object;
  256. TProcVarTest1 = procedure;
  257. TProcVarTest2 = function: SizeInt;
  258. TProcVarTest3 = function(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: SizeInt): SizeInt;
  259. TProcVarTest4 = procedure(aArg1: AnsiString; aArg2: UnicodeString; aArg3: WideString; aArg4: ShortString);
  260. TProcVarTest5 = function: AnsiString;
  261. TProcVarTest6 = function: UnicodeString;
  262. TProcVarTest7 = function: WideString;
  263. TProcVarTest8 = function: ShortString;
  264. TProcVarTest9 = procedure(aArg1: SizeInt; var aArg2: SizeInt; out aArg3: SizeInt; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: SizeInt);
  265. TProcVarTest10 = procedure(aArg1: AnsiString; var aArg2: AnsiString; out aArg3: AnsiString; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: AnsiString);
  266. TProcVarTest11 = procedure(aArg1: ShortString; var aArg2: ShortString; out aArg3: ShortString; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: ShortString);
  267. TProcVarTest12 = procedure(aArg1: array of SizeInt; var aArg2: array of SizeInt; out aArg3: array of SizeInt; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: array of SizeInt);
  268. TProcVarTest13 = function(aArg1: Single; var aArg2: Single; out aArg3: Single; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Single): Single;
  269. TProcVarTest14 = function(aArg1: Double; var aArg2: Double; out aArg3: Double; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Double): Double;
  270. TProcVarTest15 = function(aArg1: Extended; var aArg2: Extended; out aArg3: Extended; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Extended): Extended;
  271. TProcVarTest16 = function(aArg1: Comp; var aArg2: Comp; out aArg3: Comp; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Comp): Comp;
  272. TProcVarTest17 = function(aArg1: Currency; var aArg2: Currency; out aArg3: Currency; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Currency): Currency;
  273. TProcVarTest18 = function(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Single): Single;
  274. TProcVarTest19 = function(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Double): Double;
  275. TProcVarTest20 = function(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Extended): Extended;
  276. TProcVarTest21 = function(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Comp): Comp;
  277. TProcVarTest22 = function(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Currency): Currency;
  278. TProcVarTestRecSize1 = function(aArg1: TTestRecord1): TTestRecord1;
  279. TProcVarTestRecSize2 = function(aArg1: TTestRecord2): TTestRecord2;
  280. TProcVarTestRecSize3 = function(aArg1: TTestRecord3): TTestRecord3;
  281. TProcVarTestRecSize4 = function(aArg1: TTestRecord4): TTestRecord4;
  282. TProcVarTestRecSize5 = function(aArg1: TTestRecord5): TTestRecord5;
  283. TProcVarTestRecSize6 = function(aArg1: TTestRecord6): TTestRecord6;
  284. TProcVarTestRecSize7 = function(aArg1: TTestRecord7): TTestRecord7;
  285. TProcVarTestRecSize8 = function(aArg1: TTestRecord8): TTestRecord8;
  286. TProcVarTestRecSize9 = function(aArg1: TTestRecord9): TTestRecord9;
  287. TProcVarTestRecSize10 = function(aArg1: TTestRecord10): TTestRecord10;
  288. TProcVarTestUntyped = procedure(var aArg1; out aArg2; const aArg3; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4);
  289. procedure ProcTest1;
  290. function ProcTest2: SizeInt;
  291. function ProcTest3(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: SizeInt): SizeInt;
  292. procedure ProcTest4(aArg1: AnsiString; aArg2: UnicodeString; aArg3: WideString; aArg4: ShortString);
  293. function ProcTest5: AnsiString;
  294. function ProcTest6: UnicodeString;
  295. function ProcTest7: WideString;
  296. function ProcTest8: ShortString;
  297. procedure ProcTest9(aArg1: SizeInt; var aArg2: SizeInt; out aArg3: SizeInt; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: SizeInt);
  298. procedure ProcTest10(aArg1: AnsiString; var aArg2: AnsiString; out aArg3: AnsiString; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: AnsiString);
  299. procedure ProcTest11(aArg1: ShortString; var aArg2: ShortString; out aArg3: ShortString; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: ShortString);
  300. procedure ProcTest12(aArg1: array of SizeInt; var aArg2: array of SizeInt; out aArg3: array of SizeInt; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: array of SizeInt);
  301. function ProcTest13(aArg1: Single; var aArg2: Single; out aArg3: Single; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Single): Single;
  302. function ProcTest14(aArg1: Double; var aArg2: Double; out aArg3: Double; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Double): Double;
  303. function ProcTest15(aArg1: Extended; var aArg2: Extended; out aArg3: Extended; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Extended): Extended;
  304. function ProcTest16(aArg1: Comp; var aArg2: Comp; out aArg3: Comp; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Comp): Comp;
  305. function ProcTest17(aArg1: Currency; var aArg2: Currency; out aArg3: Currency; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Currency): Currency;
  306. function ProcTest18(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Single): Single;
  307. function ProcTest19(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Double): Double;
  308. function ProcTest20(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Extended): Extended;
  309. function ProcTest21(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Comp): Comp;
  310. function ProcTest22(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Currency): Currency;
  311. function ProcTestRecSize1(aArg1: TTestRecord1): TTestRecord1;
  312. function ProcTestRecSize2(aArg1: TTestRecord2): TTestRecord2;
  313. function ProcTestRecSize3(aArg1: TTestRecord3): TTestRecord3;
  314. function ProcTestRecSize4(aArg1: TTestRecord4): TTestRecord4;
  315. function ProcTestRecSize5(aArg1: TTestRecord5): TTestRecord5;
  316. function ProcTestRecSize6(aArg1: TTestRecord6): TTestRecord6;
  317. function ProcTestRecSize7(aArg1: TTestRecord7): TTestRecord7;
  318. function ProcTestRecSize8(aArg1: TTestRecord8): TTestRecord8;
  319. function ProcTestRecSize9(aArg1: TTestRecord9): TTestRecord9;
  320. function ProcTestRecSize10(aArg1: TTestRecord10): TTestRecord10;
  321. procedure ProcTestUntyped(var aArg1; out aArg2; const aArg3; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4);
  322. implementation
  323. procedure TTestInterfaceClass.Test1;
  324. begin
  325. SetLength(InputArgs, 0);
  326. SetLength(OutputArgs, 0);
  327. ResultValue := TValue.Empty;
  328. CalledMethod := 1;
  329. end;
  330. function TTestInterfaceClass.Test2: SizeInt;
  331. begin
  332. SetLength(InputArgs, 0);
  333. SetLength(OutputArgs, 0);
  334. Result := 42;
  335. TValue.Make(@Result, TypeInfo(Result), ResultValue);
  336. CalledMethod := 2;
  337. end;
  338. function TTestInterfaceClass.Test3(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: SizeInt): SizeInt;
  339. begin
  340. SetLength(InputArgs, 10);
  341. TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]);
  342. TValue.Make(@aArg2, TypeInfo(aArg2), InputArgs[1]);
  343. TValue.Make(@aArg3, TypeInfo(aArg3), InputArgs[2]);
  344. TValue.Make(@aArg4, TypeInfo(aArg4), InputArgs[3]);
  345. TValue.Make(@aArg5, TypeInfo(aArg5), InputArgs[4]);
  346. TValue.Make(@aArg6, TypeInfo(aArg6), InputArgs[5]);
  347. TValue.Make(@aArg7, TypeInfo(aArg7), InputArgs[6]);
  348. TValue.Make(@aArg8, TypeInfo(aArg8), InputArgs[7]);
  349. TValue.Make(@aArg9, TypeInfo(aArg9), InputArgs[8]);
  350. TValue.Make(@aArg10, TypeInfo(aArg10), InputArgs[9]);
  351. SetLength(OutputArgs, 0);
  352. Result := 42;
  353. TValue.Make(@Result, TypeInfo(Result), ResultValue);
  354. CalledMethod := 3;
  355. end;
  356. procedure TTestInterfaceClass.Test4(aArg1: AnsiString; aArg2: UnicodeString; aArg3: WideString; aArg4: ShortString);
  357. begin
  358. SetLength(InputArgs, 4);
  359. TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]);
  360. TValue.Make(@aArg2, TypeInfo(aArg2), InputArgs[1]);
  361. TValue.Make(@aArg3, TypeInfo(aArg3), InputArgs[2]);
  362. TValue.Make(@aArg4, TypeInfo(aArg4), InputArgs[3]);
  363. SetLength(OutputArgs, 0);
  364. ResultValue := TValue.Empty;
  365. CalledMethod := 4;
  366. end;
  367. function TTestInterfaceClass.Test5: AnsiString;
  368. begin
  369. SetLength(InputArgs, 0);
  370. SetLength(OutputArgs, 0);
  371. Result := 'Hello World';
  372. TValue.Make(@Result, TypeInfo(Result), ResultValue);
  373. CalledMethod := 5;
  374. end;
  375. function TTestInterfaceClass.Test6: UnicodeString;
  376. begin
  377. SetLength(InputArgs, 0);
  378. SetLength(OutputArgs, 0);
  379. Result := 'Hello World';
  380. TValue.Make(@Result, TypeInfo(Result), ResultValue);
  381. CalledMethod := 6;
  382. end;
  383. function TTestInterfaceClass.Test7: WideString;
  384. begin
  385. SetLength(InputArgs, 0);
  386. SetLength(OutputArgs, 0);
  387. Result := 'Hello World';
  388. TValue.Make(@Result, TypeInfo(Result), ResultValue);
  389. CalledMethod := 7;
  390. end;
  391. function TTestInterfaceClass.Test8: ShortString;
  392. begin
  393. SetLength(InputArgs, 0);
  394. SetLength(OutputArgs, 0);
  395. Result := 'Hello World';
  396. TValue.Make(@Result, TypeInfo(Result), ResultValue);
  397. CalledMethod := 8;
  398. end;
  399. procedure TTestInterfaceClass.Test9(aArg1: SizeInt; var aArg2: SizeInt; out aArg3: SizeInt; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: SizeInt);
  400. begin
  401. SetLength(InputArgs, 4);
  402. TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]);
  403. TValue.Make(@aArg2, TypeInfo(aArg2), InputArgs[1]);
  404. TValue.Make(@aArg3, TypeInfo(aArg3), InputArgs[2]);
  405. TValue.Make(@aArg4, TypeInfo(aArg4), InputArgs[3]);
  406. aArg2 := $1234;
  407. aArg3 := $5678;
  408. SetLength(OutputArgs, 2);
  409. TValue.Make(@aArg2, TypeInfo(aArg2), OutputArgs[0]);
  410. TValue.Make(@aArg3, TypeInfo(aArg3), OutputArgs[1]);
  411. SetLength(InOutMapping, 2);
  412. InOutMapping[0] := 1;
  413. InOutMapping[1] := 2;
  414. ResultValue := TValue.Empty;
  415. CalledMethod := 9;
  416. end;
  417. procedure TTestInterfaceClass.Test10(aArg1: AnsiString; var aArg2: AnsiString; out aArg3: AnsiString; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: AnsiString);
  418. begin
  419. SetLength(InputArgs, 4);
  420. TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]);
  421. TValue.Make(@aArg2, TypeInfo(aArg2), InputArgs[1]);
  422. TValue.Make(@aArg3, TypeInfo(aArg3), InputArgs[2]);
  423. TValue.Make(@aArg4, TypeInfo(aArg4), InputArgs[3]);
  424. aArg2 := 'Foo';
  425. aArg3 := 'Bar';
  426. SetLength(OutputArgs, 2);
  427. TValue.Make(@aArg2, TypeInfo(aArg2), OutputArgs[0]);
  428. TValue.Make(@aArg3, TypeInfo(aArg3), OutputArgs[1]);
  429. SetLength(InOutMapping, 2);
  430. InOutMapping[0] := 1;
  431. InOutMapping[1] := 2;
  432. ResultValue := TValue.Empty;
  433. CalledMethod := 10;
  434. end;
  435. procedure TTestInterfaceClass.Test11(aArg1: ShortString; var aArg2: ShortString; out aArg3: ShortString; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: ShortString);
  436. begin
  437. SetLength(InputArgs, 4);
  438. TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]);
  439. TValue.Make(@aArg2, TypeInfo(aArg2), InputArgs[1]);
  440. TValue.Make(@aArg3, TypeInfo(aArg3), InputArgs[2]);
  441. TValue.Make(@aArg4, TypeInfo(aArg4), InputArgs[3]);
  442. aArg2 := 'Foo';
  443. aArg3 := 'Bar';
  444. SetLength(OutputArgs, 2);
  445. TValue.Make(@aArg2, TypeInfo(aArg2), OutputArgs[0]);
  446. TValue.Make(@aArg3, TypeInfo(aArg3), OutputArgs[1]);
  447. SetLength(InOutMapping, 2);
  448. InOutMapping[0] := 1;
  449. InOutMapping[1] := 2;
  450. ResultValue := TValue.Empty;
  451. CalledMethod := 11;
  452. end;
  453. procedure TTestInterfaceClass.Test12(aArg1: array of SizeInt; var aArg2: array of SizeInt; out aArg3: array of SizeInt; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: array of SizeInt);
  454. {$ifdef fpc}
  455. var
  456. i: SizeInt;
  457. start: SizeInt;
  458. {$endif}
  459. begin
  460. {$ifdef fpc}
  461. SetLength(InputArgs, 4);
  462. InputArgs[0] := specialize OpenArrayToDynArrayValue<SizeInt>(aArg1);
  463. InputArgs[1] := specialize OpenArrayToDynArrayValue<SizeInt>(aArg2);
  464. InputArgs[2] := specialize OpenArrayToDynArrayValue<SizeInt>(aArg3);
  465. InputArgs[3] := specialize OpenArrayToDynArrayValue<SizeInt>(aArg4);
  466. SetLength(OutputArgs, 2);
  467. start := $4321;
  468. for i := 0 to High(aArg2) do
  469. aArg2[i] := start + i;
  470. start := $9876;
  471. for i := 0 to High(aArg3) do
  472. aArg3[i] := start + i;
  473. OutputArgs[0] := specialize OpenArrayToDynArrayValue<SizeInt>(aArg2);
  474. OutputArgs[1] := specialize OpenArrayToDynArrayValue<SizeInt>(aArg3);
  475. SetLength(InOutMapping, 2);
  476. InOutMapping[0] := 1;
  477. InOutMapping[1] := 2;
  478. ResultValue := TValue.Empty;
  479. CalledMethod := 12;
  480. {$endif}
  481. end;
  482. function TTestInterfaceClass.Test13(aArg1: Single; var aArg2: Single; out aArg3: Single; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Single): Single;
  483. begin
  484. SetLength(InputArgs, 4);
  485. TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]);
  486. TValue.Make(@aArg2, TypeInfo(aArg2), InputArgs[1]);
  487. TValue.Make(@aArg3, TypeInfo(aArg3), InputArgs[2]);
  488. TValue.Make(@aArg4, TypeInfo(aArg4), InputArgs[3]);
  489. aArg2 := SingleArg2Out;
  490. aArg3 := SingleArg3Out;
  491. SetLength(OutputArgs, 2);
  492. TValue.Make(@aArg2, TypeInfo(aArg2), OutputArgs[0]);
  493. TValue.Make(@aArg3, TypeInfo(aArg3), OutputArgs[1]);
  494. SetLength(InOutMapping, 2);
  495. InOutMapping[0] := 1;
  496. InOutMapping[1] := 2;
  497. Result := SingleRes;
  498. TValue.Make(@Result, TypeInfo(Result), ResultValue);
  499. CalledMethod := 13;
  500. end;
  501. function TTestInterfaceClass.Test14(aArg1: Double; var aArg2: Double; out aArg3: Double; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Double): Double;
  502. begin
  503. SetLength(InputArgs, 4);
  504. TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]);
  505. TValue.Make(@aArg2, TypeInfo(aArg2), InputArgs[1]);
  506. TValue.Make(@aArg3, TypeInfo(aArg3), InputArgs[2]);
  507. TValue.Make(@aArg4, TypeInfo(aArg4), InputArgs[3]);
  508. aArg2 := DoubleArg2Out;
  509. aArg3 := DoubleArg3Out;
  510. SetLength(OutputArgs, 2);
  511. TValue.Make(@aArg2, TypeInfo(aArg2), OutputArgs[0]);
  512. TValue.Make(@aArg3, TypeInfo(aArg3), OutputArgs[1]);
  513. SetLength(InOutMapping, 2);
  514. InOutMapping[0] := 1;
  515. InOutMapping[1] := 2;
  516. Result := DoubleRes;
  517. TValue.Make(@Result, TypeInfo(Result), ResultValue);
  518. CalledMethod := 14;
  519. end;
  520. function TTestInterfaceClass.Test15(aArg1: Extended; var aArg2: Extended; out aArg3: Extended; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Extended): Extended;
  521. begin
  522. SetLength(InputArgs, 4);
  523. TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]);
  524. TValue.Make(@aArg2, TypeInfo(aArg2), InputArgs[1]);
  525. TValue.Make(@aArg3, TypeInfo(aArg3), InputArgs[2]);
  526. TValue.Make(@aArg4, TypeInfo(aArg4), InputArgs[3]);
  527. aArg2 := ExtendedArg2Out;
  528. aArg3 := ExtendedArg3Out;
  529. SetLength(OutputArgs, 2);
  530. TValue.Make(@aArg2, TypeInfo(aArg2), OutputArgs[0]);
  531. TValue.Make(@aArg3, TypeInfo(aArg3), OutputArgs[1]);
  532. SetLength(InOutMapping, 2);
  533. InOutMapping[0] := 1;
  534. InOutMapping[1] := 2;
  535. Result := ExtendedRes;
  536. TValue.Make(@Result, TypeInfo(Result), ResultValue);
  537. CalledMethod := 15;
  538. end;
  539. function TTestInterfaceClass.Test16(aArg1: Comp; var aArg2: Comp; out aArg3: Comp; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Comp): Comp;
  540. begin
  541. SetLength(InputArgs, 4);
  542. TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]);
  543. TValue.Make(@aArg2, TypeInfo(aArg2), InputArgs[1]);
  544. TValue.Make(@aArg3, TypeInfo(aArg3), InputArgs[2]);
  545. TValue.Make(@aArg4, TypeInfo(aArg4), InputArgs[3]);
  546. aArg2 := CompArg2Out;
  547. aArg3 := CompArg3Out;
  548. SetLength(OutputArgs, 2);
  549. TValue.Make(@aArg2, TypeInfo(aArg2), OutputArgs[0]);
  550. TValue.Make(@aArg3, TypeInfo(aArg3), OutputArgs[1]);
  551. SetLength(InOutMapping, 2);
  552. InOutMapping[0] := 1;
  553. InOutMapping[1] := 2;
  554. Result := CompRes;
  555. TValue.Make(@Result, TypeInfo(Result), ResultValue);
  556. CalledMethod := 16;
  557. end;
  558. function TTestInterfaceClass.Test17(aArg1: Currency; var aArg2: Currency; out aArg3: Currency; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Currency): Currency;
  559. begin
  560. SetLength(InputArgs, 4);
  561. TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]);
  562. TValue.Make(@aArg2, TypeInfo(aArg2), InputArgs[1]);
  563. TValue.Make(@aArg3, TypeInfo(aArg3), InputArgs[2]);
  564. TValue.Make(@aArg4, TypeInfo(aArg4), InputArgs[3]);
  565. aArg2 := CurrencyArg2Out;
  566. aArg3 := CurrencyArg3Out;
  567. SetLength(OutputArgs, 2);
  568. TValue.Make(@aArg2, TypeInfo(aArg2), OutputArgs[0]);
  569. TValue.Make(@aArg3, TypeInfo(aArg3), OutputArgs[1]);
  570. SetLength(InOutMapping, 2);
  571. InOutMapping[0] := 1;
  572. InOutMapping[1] := 2;
  573. Result := CurrencyRes;
  574. TValue.Make(@Result, TypeInfo(Result), ResultValue);
  575. CalledMethod := 17;
  576. end;
  577. function TTestInterfaceClass.Test18(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Single): Single;
  578. begin
  579. SetLength(InputArgs, 10);
  580. TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]);
  581. TValue.Make(@aArg2, TypeInfo(aArg2), InputArgs[1]);
  582. TValue.Make(@aArg3, TypeInfo(aArg3), InputArgs[2]);
  583. TValue.Make(@aArg4, TypeInfo(aArg4), InputArgs[3]);
  584. TValue.Make(@aArg5, TypeInfo(aArg5), InputArgs[4]);
  585. TValue.Make(@aArg6, TypeInfo(aArg6), InputArgs[5]);
  586. TValue.Make(@aArg7, TypeInfo(aArg7), InputArgs[6]);
  587. TValue.Make(@aArg8, TypeInfo(aArg8), InputArgs[7]);
  588. TValue.Make(@aArg9, TypeInfo(aArg9), InputArgs[8]);
  589. TValue.Make(@aArg10, TypeInfo(aArg10), InputArgs[9]);
  590. SetLength(OutputArgs, 0);
  591. SetLength(InOutMapping, 0);
  592. Result := aArg1 + aArg2 + aArg3 + aArg4 + aArg5 + aArg6 + aArg7 + aArg8 + aArg9 + aArg10;
  593. TValue.Make(@Result ,TypeInfo(Result), ResultValue);
  594. CalledMethod := 18;
  595. end;
  596. function TTestInterfaceClass.Test19(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Double): Double;
  597. begin
  598. SetLength(InputArgs, 10);
  599. TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]);
  600. TValue.Make(@aArg2, TypeInfo(aArg2), InputArgs[1]);
  601. TValue.Make(@aArg3, TypeInfo(aArg3), InputArgs[2]);
  602. TValue.Make(@aArg4, TypeInfo(aArg4), InputArgs[3]);
  603. TValue.Make(@aArg5, TypeInfo(aArg5), InputArgs[4]);
  604. TValue.Make(@aArg6, TypeInfo(aArg6), InputArgs[5]);
  605. TValue.Make(@aArg7, TypeInfo(aArg7), InputArgs[6]);
  606. TValue.Make(@aArg8, TypeInfo(aArg8), InputArgs[7]);
  607. TValue.Make(@aArg9, TypeInfo(aArg9), InputArgs[8]);
  608. TValue.Make(@aArg10, TypeInfo(aArg10), InputArgs[9]);
  609. SetLength(OutputArgs, 0);
  610. SetLength(InOutMapping, 0);
  611. Result := aArg1 + aArg2 + aArg3 + aArg4 + aArg5 + aArg6 + aArg7 + aArg8 + aArg9 + aArg10;
  612. TValue.Make(@Result ,TypeInfo(Result), ResultValue);
  613. CalledMethod := 19;
  614. end;
  615. function TTestInterfaceClass.Test20(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Extended): Extended;
  616. begin
  617. SetLength(InputArgs, 10);
  618. TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]);
  619. TValue.Make(@aArg2, TypeInfo(aArg2), InputArgs[1]);
  620. TValue.Make(@aArg3, TypeInfo(aArg3), InputArgs[2]);
  621. TValue.Make(@aArg4, TypeInfo(aArg4), InputArgs[3]);
  622. TValue.Make(@aArg5, TypeInfo(aArg5), InputArgs[4]);
  623. TValue.Make(@aArg6, TypeInfo(aArg6), InputArgs[5]);
  624. TValue.Make(@aArg7, TypeInfo(aArg7), InputArgs[6]);
  625. TValue.Make(@aArg8, TypeInfo(aArg8), InputArgs[7]);
  626. TValue.Make(@aArg9, TypeInfo(aArg9), InputArgs[8]);
  627. TValue.Make(@aArg10, TypeInfo(aArg10), InputArgs[9]);
  628. SetLength(OutputArgs, 0);
  629. SetLength(InOutMapping, 0);
  630. Result := aArg1 + aArg2 + aArg3 + aArg4 + aArg5 + aArg6 + aArg7 + aArg8 + aArg9 + aArg10;
  631. TValue.Make(@Result ,TypeInfo(Result), ResultValue);
  632. CalledMethod := 20;
  633. end;
  634. function TTestInterfaceClass.Test21(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Comp): Comp;
  635. begin
  636. SetLength(InputArgs, 10);
  637. TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]);
  638. TValue.Make(@aArg2, TypeInfo(aArg2), InputArgs[1]);
  639. TValue.Make(@aArg3, TypeInfo(aArg3), InputArgs[2]);
  640. TValue.Make(@aArg4, TypeInfo(aArg4), InputArgs[3]);
  641. TValue.Make(@aArg5, TypeInfo(aArg5), InputArgs[4]);
  642. TValue.Make(@aArg6, TypeInfo(aArg6), InputArgs[5]);
  643. TValue.Make(@aArg7, TypeInfo(aArg7), InputArgs[6]);
  644. TValue.Make(@aArg8, TypeInfo(aArg8), InputArgs[7]);
  645. TValue.Make(@aArg9, TypeInfo(aArg9), InputArgs[8]);
  646. TValue.Make(@aArg10, TypeInfo(aArg10), InputArgs[9]);
  647. SetLength(OutputArgs, 0);
  648. SetLength(InOutMapping, 0);
  649. Result := aArg1 + aArg2 + aArg3 + aArg4 + aArg5 + aArg6 + aArg7 + aArg8 + aArg9 + aArg10;
  650. TValue.Make(@Result ,TypeInfo(Result), ResultValue);
  651. CalledMethod := 21;
  652. end;
  653. function TTestInterfaceClass.Test22(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Currency): Currency;
  654. begin
  655. SetLength(InputArgs, 10);
  656. TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]);
  657. TValue.Make(@aArg2, TypeInfo(aArg2), InputArgs[1]);
  658. TValue.Make(@aArg3, TypeInfo(aArg3), InputArgs[2]);
  659. TValue.Make(@aArg4, TypeInfo(aArg4), InputArgs[3]);
  660. TValue.Make(@aArg5, TypeInfo(aArg5), InputArgs[4]);
  661. TValue.Make(@aArg6, TypeInfo(aArg6), InputArgs[5]);
  662. TValue.Make(@aArg7, TypeInfo(aArg7), InputArgs[6]);
  663. TValue.Make(@aArg8, TypeInfo(aArg8), InputArgs[7]);
  664. TValue.Make(@aArg9, TypeInfo(aArg9), InputArgs[8]);
  665. TValue.Make(@aArg10, TypeInfo(aArg10), InputArgs[9]);
  666. SetLength(OutputArgs, 0);
  667. SetLength(InOutMapping, 0);
  668. Result := aArg1 + aArg2 + aArg3 + aArg4 + aArg5 + aArg6 + aArg7 + aArg8 + aArg9 + aArg10;
  669. TValue.Make(@Result ,TypeInfo(Result), ResultValue);
  670. CalledMethod := 22;
  671. end;
  672. function TTestInterfaceClass.Test23(aArg1: Variant): AnsiString;
  673. begin
  674. SetLength(OutputArgs, 0);
  675. SetLength(InOutMapping, 0);
  676. SetLength(InputArgs, 1);
  677. TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]);
  678. Result:=AnsiString(aArg1);
  679. TValue.Make(@Result ,TypeInfo(Result), ResultValue);
  680. CalledMethod:=23;
  681. end;
  682. function TTestInterfaceClass.TestRecSize1(aArg1: TTestRecord1): TTestRecord1;
  683. var
  684. i: LongInt;
  685. begin
  686. SetLength(InputArgs, 1);
  687. TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]);
  688. SetLength(OutputArgs, 0);
  689. for i := 0 to High(aArg1.b) do
  690. Result.b[High(Result.b) - i] := aArg1.b[i];
  691. TValue.Make(@Result, TypeInfo(Result), ResultValue);
  692. CalledMethod := 1 or RecSizeMarker;
  693. end;
  694. function TTestInterfaceClass.TestRecSize2(aArg1: TTestRecord2): TTestRecord2;
  695. var
  696. i: LongInt;
  697. begin
  698. SetLength(InputArgs, 1);
  699. TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]);
  700. SetLength(OutputArgs, 0);
  701. for i := 0 to High(aArg1.b) do
  702. Result.b[High(Result.b) - i] := aArg1.b[i];
  703. TValue.Make(@Result, TypeInfo(Result), ResultValue);
  704. CalledMethod := 2 or RecSizeMarker;
  705. end;
  706. function TTestInterfaceClass.TestRecSize3(aArg1: TTestRecord3): TTestRecord3;
  707. var
  708. i: LongInt;
  709. begin
  710. SetLength(InputArgs, 1);
  711. TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]);
  712. SetLength(OutputArgs, 0);
  713. for i := 0 to High(aArg1.b) do
  714. Result.b[High(Result.b) - i] := aArg1.b[i];
  715. TValue.Make(@Result, TypeInfo(Result), ResultValue);
  716. CalledMethod := 3 or RecSizeMarker;
  717. end;
  718. function TTestInterfaceClass.TestRecSize4(aArg1: TTestRecord4): TTestRecord4;
  719. var
  720. i: LongInt;
  721. begin
  722. SetLength(InputArgs, 1);
  723. TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]);
  724. SetLength(OutputArgs, 0);
  725. for i := 0 to High(aArg1.b) do
  726. Result.b[High(Result.b) - i] := aArg1.b[i];
  727. TValue.Make(@Result, TypeInfo(Result), ResultValue);
  728. CalledMethod := 4 or RecSizeMarker;
  729. end;
  730. function TTestInterfaceClass.TestRecSize5(aArg1: TTestRecord5): TTestRecord5;
  731. var
  732. i: LongInt;
  733. begin
  734. SetLength(InputArgs, 1);
  735. TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]);
  736. SetLength(OutputArgs, 0);
  737. for i := 0 to High(aArg1.b) do
  738. Result.b[High(Result.b) - i] := aArg1.b[i];
  739. TValue.Make(@Result, TypeInfo(Result), ResultValue);
  740. CalledMethod := 5 or RecSizeMarker;
  741. end;
  742. function TTestInterfaceClass.TestRecSize6(aArg1: TTestRecord6): TTestRecord6;
  743. var
  744. i: LongInt;
  745. begin
  746. SetLength(InputArgs, 1);
  747. TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]);
  748. SetLength(OutputArgs, 0);
  749. for i := 0 to High(aArg1.b) do
  750. Result.b[High(Result.b) - i] := aArg1.b[i];
  751. TValue.Make(@Result, TypeInfo(Result), ResultValue);
  752. CalledMethod := 6 or RecSizeMarker;
  753. end;
  754. function TTestInterfaceClass.TestRecSize7(aArg1: TTestRecord7): TTestRecord7;
  755. var
  756. i: LongInt;
  757. begin
  758. SetLength(InputArgs, 1);
  759. TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]);
  760. SetLength(OutputArgs, 0);
  761. for i := 0 to High(aArg1.b) do
  762. Result.b[High(Result.b) - i] := aArg1.b[i];
  763. TValue.Make(@Result, TypeInfo(Result), ResultValue);
  764. CalledMethod := 7 or RecSizeMarker;
  765. end;
  766. function TTestInterfaceClass.TestRecSize8(aArg1: TTestRecord8): TTestRecord8;
  767. var
  768. i: LongInt;
  769. begin
  770. SetLength(InputArgs, 1);
  771. TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]);
  772. SetLength(OutputArgs, 0);
  773. for i := 0 to High(aArg1.b) do
  774. Result.b[High(Result.b) - i] := aArg1.b[i];
  775. TValue.Make(@Result, TypeInfo(Result), ResultValue);
  776. CalledMethod := 8 or RecSizeMarker;
  777. end;
  778. function TTestInterfaceClass.TestRecSize9(aArg1: TTestRecord9): TTestRecord9;
  779. var
  780. i: LongInt;
  781. begin
  782. SetLength(InputArgs, 1);
  783. TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]);
  784. SetLength(OutputArgs, 0);
  785. for i := 0 to High(aArg1.b) do
  786. Result.b[High(Result.b) - i] := aArg1.b[i];
  787. TValue.Make(@Result, TypeInfo(Result), ResultValue);
  788. CalledMethod := 9 or RecSizeMarker;
  789. end;
  790. function TTestInterfaceClass.TestRecSize10(aArg1: TTestRecord10): TTestRecord10;
  791. var
  792. i: LongInt;
  793. begin
  794. SetLength(InputArgs, 1);
  795. TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]);
  796. SetLength(OutputArgs, 0);
  797. for i := 0 to High(aArg1.b) do
  798. Result.b[High(Result.b) - i] := aArg1.b[i];
  799. TValue.Make(@Result, TypeInfo(Result), ResultValue);
  800. CalledMethod := 10 or RecSizeMarker;
  801. end;
  802. procedure TTestInterfaceClass.TestUntyped(var aArg1; out aArg2; const aArg3; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4);
  803. begin
  804. if Length(ExpectedArgs) <> 4 then
  805. Exit;
  806. if Length(OutArgs) <> 2 then
  807. Exit;
  808. SetLength(InputArgs, 4);
  809. TValue.Make(@aArg1, ExpectedArgs[0].TypeInfo, InputArgs[0]);
  810. TValue.Make(@aArg2, ExpectedArgs[1].TypeInfo, InputArgs[1]);
  811. TValue.Make(@aArg3, ExpectedArgs[2].TypeInfo, InputArgs[2]);
  812. TValue.Make(@aArg4, ExpectedArgs[3].TypeInfo, InputArgs[3]);
  813. Move(PPointer(OutArgs[0].GetReferenceToRawData)^, aArg1, OutArgs[0].DataSize);
  814. Move(PPointer(OutArgs[1].GetReferenceToRawData)^, aArg2, OutArgs[1].DataSize);
  815. SetLength(OutputArgs, 2);
  816. TValue.Make(@aArg1, ExpectedArgs[0].TypeInfo, OutputArgs[0]);
  817. TValue.Make(@aArg2, ExpectedArgs[1].TypeInfo, OutputArgs[1]);
  818. SetLength(InOutMapping, 2);
  819. InOutMapping[0] := 0;
  820. InOutMapping[1] := 1;
  821. CalledMethod := -1;
  822. end;
  823. procedure TTestInterfaceClass.Reset;
  824. begin
  825. InputArgs := Nil;
  826. OutputArgs := Nil;
  827. ExpectedArgs := Nil;
  828. OutArgs := Nil;
  829. InOutMapping := Nil;
  830. ResultValue := TValue.Empty;
  831. CalledMethod := 0;
  832. end;
  833. function TTestInterfaceClass.DoAddRef: longint;
  834. begin
  835. Result:=_AddRef;
  836. end;
  837. function TTestInterfaceClass.DoRelease: longint;
  838. begin
  839. Result:=_Release
  840. end;
  841. destructor TTestInterfaceClass.Destroy;
  842. begin
  843. // Empty, for debugging purposes
  844. inherited Destroy;
  845. end;
  846. procedure ProcTest1;
  847. begin
  848. TTestInterfaceClass.ProcVarInst.Test1;
  849. end;
  850. function ProcTest2: SizeInt;
  851. begin
  852. Result := TTestInterfaceClass.ProcVarInst.Test2;
  853. end;
  854. function ProcTest3(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: SizeInt): SizeInt;
  855. begin
  856. Result := TTestInterfaceClass.ProcVarInst.Test3(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10);
  857. end;
  858. procedure ProcTest4(aArg1: AnsiString; aArg2: UnicodeString; aArg3: WideString; aArg4: ShortString);
  859. begin
  860. TTestInterfaceClass.ProcVarInst.Test4(aArg1, aArg2, aArg3, aArg4);
  861. end;
  862. function ProcTest5: AnsiString;
  863. begin
  864. Result := TTestInterfaceClass.ProcVarInst.Test5;
  865. end;
  866. function ProcTest6: UnicodeString;
  867. begin
  868. Result := TTestInterfaceClass.ProcVarInst.Test6;
  869. end;
  870. function ProcTest7: WideString;
  871. begin
  872. Result := TTestInterfaceClass.ProcVarInst.Test7;
  873. end;
  874. function ProcTest8: ShortString;
  875. begin
  876. Result := TTestInterfaceClass.ProcVarInst.Test8;
  877. end;
  878. procedure ProcTest9(aArg1: SizeInt; var aArg2: SizeInt; out aArg3: SizeInt; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: SizeInt);
  879. begin
  880. TTestInterfaceClass.ProcVarInst.Test9(aArg1, aArg2, aArg3, aArg4);
  881. end;
  882. procedure ProcTest10(aArg1: AnsiString; var aArg2: AnsiString; out aArg3: AnsiString; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: AnsiString);
  883. begin
  884. TTestInterfaceClass.ProcVarInst.Test10(aArg1, aArg2, aArg3, aArg4);
  885. end;
  886. procedure ProcTest11(aArg1: ShortString; var aArg2: ShortString; out aArg3: ShortString; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: ShortString);
  887. begin
  888. TTestInterfaceClass.ProcVarInst.Test11(aArg1, aArg2, aArg3, aArg4);
  889. end;
  890. procedure ProcTest12(aArg1: array of SizeInt; var aArg2: array of SizeInt; out aArg3: array of SizeInt; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: array of SizeInt);
  891. begin
  892. TTestInterfaceClass.ProcVarInst.Test12(aArg1, aArg2, aArg3, aArg4);
  893. end;
  894. function ProcTest13(aArg1: Single; var aArg2: Single; out aArg3: Single; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Single): Single;
  895. begin
  896. Result := TTestInterfaceClass.ProcVarInst.Test13(aArg1, aArg2, aArg3, aArg4);
  897. end;
  898. function ProcTest14(aArg1: Double; var aArg2: Double; out aArg3: Double; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Double): Double;
  899. begin
  900. Result := TTestInterfaceClass.ProcVarInst.Test14(aArg1, aArg2, aArg3, aArg4);
  901. end;
  902. function ProcTest15(aArg1: Extended; var aArg2: Extended; out aArg3: Extended; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Extended): Extended;
  903. begin
  904. Result := TTestInterfaceClass.ProcVarInst.Test15(aArg1, aArg2, aArg3, aArg4);
  905. end;
  906. function ProcTest16(aArg1: Comp; var aArg2: Comp; out aArg3: Comp; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Comp): Comp;
  907. begin
  908. Result := TTestInterfaceClass.ProcVarInst.Test16(aArg1, aArg2, aArg3, aArg4);
  909. end;
  910. function ProcTest17(aArg1: Currency; var aArg2: Currency; out aArg3: Currency; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Currency): Currency;
  911. begin
  912. Result := TTestInterfaceClass.ProcVarInst.Test17(aArg1, aArg2, aArg3, aArg4);
  913. end;
  914. function ProcTest18(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Single): Single;
  915. begin
  916. Result := TTestInterfaceClass.ProcVarInst.Test18(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10);
  917. end;
  918. function ProcTest19(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Double): Double;
  919. begin
  920. Result := TTestInterfaceClass.ProcVarInst.Test19(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10);
  921. end;
  922. function ProcTest20(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Extended): Extended;
  923. begin
  924. Result := TTestInterfaceClass.ProcVarInst.Test20(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10);
  925. end;
  926. function ProcTest21(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Comp): Comp;
  927. begin
  928. Result := TTestInterfaceClass.ProcVarInst.Test21(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10);
  929. end;
  930. function ProcTest22(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Currency): Currency;
  931. begin
  932. Result := TTestInterfaceClass.ProcVarInst.Test22(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10);
  933. end;
  934. function ProcTestRecSize1(aArg1: TTestRecord1): TTestRecord1;
  935. begin
  936. Result := TTestInterfaceClass.ProcVarRecInst.TestRecSize1(aArg1);
  937. end;
  938. function ProcTestRecSize2(aArg1: TTestRecord2): TTestRecord2;
  939. begin
  940. Result := TTestInterfaceClass.ProcVarRecInst.TestRecSize2(aArg1);
  941. end;
  942. function ProcTestRecSize3(aArg1: TTestRecord3): TTestRecord3;
  943. begin
  944. Result := TTestInterfaceClass.ProcVarRecInst.TestRecSize3(aArg1);
  945. end;
  946. function ProcTestRecSize4(aArg1: TTestRecord4): TTestRecord4;
  947. begin
  948. Result := TTestInterfaceClass.ProcVarRecInst.TestRecSize4(aArg1);
  949. end;
  950. function ProcTestRecSize5(aArg1: TTestRecord5): TTestRecord5;
  951. begin
  952. Result := TTestInterfaceClass.ProcVarRecInst.TestRecSize5(aArg1);
  953. end;
  954. function ProcTestRecSize6(aArg1: TTestRecord6): TTestRecord6;
  955. begin
  956. Result := TTestInterfaceClass.ProcVarRecInst.TestRecSize6(aArg1);
  957. end;
  958. function ProcTestRecSize7(aArg1: TTestRecord7): TTestRecord7;
  959. begin
  960. Result := TTestInterfaceClass.ProcVarRecInst.TestRecSize7(aArg1);
  961. end;
  962. function ProcTestRecSize8(aArg1: TTestRecord8): TTestRecord8;
  963. begin
  964. Result := TTestInterfaceClass.ProcVarRecInst.TestRecSize8(aArg1);
  965. end;
  966. function ProcTestRecSize9(aArg1: TTestRecord9): TTestRecord9;
  967. begin
  968. Result := TTestInterfaceClass.ProcVarRecInst.TestRecSize9(aArg1);
  969. end;
  970. function ProcTestRecSize10(aArg1: TTestRecord10): TTestRecord10;
  971. begin
  972. Result := TTestInterfaceClass.ProcVarRecInst.TestRecSize10(aArg1);
  973. end;
  974. procedure ProcTestUntyped(var aArg1; out aArg2; const aArg3; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4);
  975. begin
  976. TTestInterfaceClass.ProcVarInst.TestUntyped(aArg1, aArg2, aArg3, aArg4);
  977. end;
  978. end.