tests.rtti.invoketypes.pas 48 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225
  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. ITestMethodCall = interface
  224. Function Test : String;
  225. end;
  226. {$RTTI EXPLICIT METHODS[vcPrivate,vcProtected,vcPublic,vcPublished]}
  227. { TTestParent }
  228. TTestParent = class
  229. function DoTest : String; virtual;
  230. end;
  231. TTest = Class(TInterfacedObject,ITestMethodCall)
  232. FTestCalled : Boolean;
  233. Function Test : String;
  234. end;
  235. { TTestConstructorCall }
  236. TTestConstructorCall = class(TTestParent)
  237. Private
  238. FTest : ITestMethodCall;
  239. Public
  240. constructor Create({[QueryParam]} aTest: ITestMethodCall);
  241. function DoTest : String; override;
  242. end;
  243. { test for newinstance 41090 }
  244. { TTestBaseNewInstance }
  245. TTestBaseNewInstance = class
  246. public
  247. // So it is found in every RTL
  248. constructor create;
  249. class var BaseNewCount : Integer;
  250. class function NewInstance: TObject; override;
  251. end;
  252. TTestNewInstance = class(TTestBaseNewInstance)
  253. public
  254. class var TestNewCount : Integer;
  255. class function NewInstance: TObject; override;
  256. end;
  257. type
  258. TEnum1 = (en1_1, en1_2);
  259. TEnum2 = (en2_1);
  260. TEnum3 = en1_1..en1_1;
  261. { TTestInvokeCast }
  262. TTestInvokeCast = class(TPersistent)
  263. published
  264. function Test(Arg: Single): Double;
  265. procedure Test2(var Arg: Single);
  266. procedure Test3(Arg: TEnum1);
  267. function Test4(Arg: UInt8): UInt8;
  268. end;
  269. TMethodTest1 = procedure of object;
  270. TMethodTest2 = function: SizeInt of object;
  271. TMethodTest3 = function(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: SizeInt): SizeInt of object;
  272. TMethodTest4 = procedure(aArg1: AnsiString; aArg2: UnicodeString; aArg3: WideString; aArg4: ShortString) of object;
  273. TMethodTest5 = function: AnsiString of object;
  274. TMethodTest6 = function: UnicodeString of object;
  275. TMethodTest7 = function: WideString of object;
  276. TMethodTest8 = function: ShortString of object;
  277. TMethodTest9 = procedure(aArg1: SizeInt; var aArg2: SizeInt; out aArg3: SizeInt; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: SizeInt) of object;
  278. TMethodTest10 = procedure(aArg1: AnsiString; var aArg2: AnsiString; out aArg3: AnsiString; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: AnsiString) of object;
  279. TMethodTest11 = procedure(aArg1: ShortString; var aArg2: ShortString; out aArg3: ShortString; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: ShortString) of object;
  280. 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;
  281. TMethodTest13 = function(aArg1: Single; var aArg2: Single; out aArg3: Single; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Single): Single of object;
  282. TMethodTest14 = function(aArg1: Double; var aArg2: Double; out aArg3: Double; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Double): Double of object;
  283. TMethodTest15 = function(aArg1: Extended; var aArg2: Extended; out aArg3: Extended; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Extended): Extended of object;
  284. TMethodTest16 = function(aArg1: Comp; var aArg2: Comp; out aArg3: Comp; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Comp): Comp of object;
  285. TMethodTest17 = function(aArg1: Currency; var aArg2: Currency; out aArg3: Currency; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Currency): Currency of object;
  286. TMethodTest18 = function(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Single): Single of object;
  287. TMethodTest19 = function(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Double): Double of object;
  288. TMethodTest20 = function(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Extended): Extended of object;
  289. TMethodTest21 = function(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Comp): Comp of object;
  290. TMethodTest22 = function(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Currency): Currency of object;
  291. TMethodTestRecSize1 = function(aArg1: TTestRecord1): TTestRecord1 of object;
  292. TMethodTestRecSize2 = function(aArg1: TTestRecord2): TTestRecord2 of object;
  293. TMethodTestRecSize3 = function(aArg1: TTestRecord3): TTestRecord3 of object;
  294. TMethodTestRecSize4 = function(aArg1: TTestRecord4): TTestRecord4 of object;
  295. TMethodTestRecSize5 = function(aArg1: TTestRecord5): TTestRecord5 of object;
  296. TMethodTestRecSize6 = function(aArg1: TTestRecord6): TTestRecord6 of object;
  297. TMethodTestRecSize7 = function(aArg1: TTestRecord7): TTestRecord7 of object;
  298. TMethodTestRecSize8 = function(aArg1: TTestRecord8): TTestRecord8 of object;
  299. TMethodTestRecSize9 = function(aArg1: TTestRecord9): TTestRecord9 of object;
  300. TMethodTestRecSize10 = function(aArg1: TTestRecord10): TTestRecord10 of object;
  301. TMethodTestUntyped = procedure(var aArg1; out aArg2; const aArg3; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4) of object;
  302. TProcVarTest1 = procedure;
  303. TProcVarTest2 = function: SizeInt;
  304. TProcVarTest3 = function(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: SizeInt): SizeInt;
  305. TProcVarTest4 = procedure(aArg1: AnsiString; aArg2: UnicodeString; aArg3: WideString; aArg4: ShortString);
  306. TProcVarTest5 = function: AnsiString;
  307. TProcVarTest6 = function: UnicodeString;
  308. TProcVarTest7 = function: WideString;
  309. TProcVarTest8 = function: ShortString;
  310. TProcVarTest9 = procedure(aArg1: SizeInt; var aArg2: SizeInt; out aArg3: SizeInt; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: SizeInt);
  311. TProcVarTest10 = procedure(aArg1: AnsiString; var aArg2: AnsiString; out aArg3: AnsiString; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: AnsiString);
  312. TProcVarTest11 = procedure(aArg1: ShortString; var aArg2: ShortString; out aArg3: ShortString; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: ShortString);
  313. 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);
  314. TProcVarTest13 = function(aArg1: Single; var aArg2: Single; out aArg3: Single; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Single): Single;
  315. TProcVarTest14 = function(aArg1: Double; var aArg2: Double; out aArg3: Double; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Double): Double;
  316. TProcVarTest15 = function(aArg1: Extended; var aArg2: Extended; out aArg3: Extended; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Extended): Extended;
  317. TProcVarTest16 = function(aArg1: Comp; var aArg2: Comp; out aArg3: Comp; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Comp): Comp;
  318. TProcVarTest17 = function(aArg1: Currency; var aArg2: Currency; out aArg3: Currency; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Currency): Currency;
  319. TProcVarTest18 = function(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Single): Single;
  320. TProcVarTest19 = function(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Double): Double;
  321. TProcVarTest20 = function(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Extended): Extended;
  322. TProcVarTest21 = function(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Comp): Comp;
  323. TProcVarTest22 = function(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Currency): Currency;
  324. TProcVarTestRecSize1 = function(aArg1: TTestRecord1): TTestRecord1;
  325. TProcVarTestRecSize2 = function(aArg1: TTestRecord2): TTestRecord2;
  326. TProcVarTestRecSize3 = function(aArg1: TTestRecord3): TTestRecord3;
  327. TProcVarTestRecSize4 = function(aArg1: TTestRecord4): TTestRecord4;
  328. TProcVarTestRecSize5 = function(aArg1: TTestRecord5): TTestRecord5;
  329. TProcVarTestRecSize6 = function(aArg1: TTestRecord6): TTestRecord6;
  330. TProcVarTestRecSize7 = function(aArg1: TTestRecord7): TTestRecord7;
  331. TProcVarTestRecSize8 = function(aArg1: TTestRecord8): TTestRecord8;
  332. TProcVarTestRecSize9 = function(aArg1: TTestRecord9): TTestRecord9;
  333. TProcVarTestRecSize10 = function(aArg1: TTestRecord10): TTestRecord10;
  334. TProcVarTestUntyped = procedure(var aArg1; out aArg2; const aArg3; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4);
  335. procedure ProcTest1;
  336. function ProcTest2: SizeInt;
  337. function ProcTest3(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: SizeInt): SizeInt;
  338. procedure ProcTest4(aArg1: AnsiString; aArg2: UnicodeString; aArg3: WideString; aArg4: ShortString);
  339. function ProcTest5: AnsiString;
  340. function ProcTest6: UnicodeString;
  341. function ProcTest7: WideString;
  342. function ProcTest8: ShortString;
  343. procedure ProcTest9(aArg1: SizeInt; var aArg2: SizeInt; out aArg3: SizeInt; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: SizeInt);
  344. procedure ProcTest10(aArg1: AnsiString; var aArg2: AnsiString; out aArg3: AnsiString; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: AnsiString);
  345. procedure ProcTest11(aArg1: ShortString; var aArg2: ShortString; out aArg3: ShortString; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: ShortString);
  346. 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);
  347. function ProcTest13(aArg1: Single; var aArg2: Single; out aArg3: Single; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Single): Single;
  348. function ProcTest14(aArg1: Double; var aArg2: Double; out aArg3: Double; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Double): Double;
  349. function ProcTest15(aArg1: Extended; var aArg2: Extended; out aArg3: Extended; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Extended): Extended;
  350. function ProcTest16(aArg1: Comp; var aArg2: Comp; out aArg3: Comp; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Comp): Comp;
  351. function ProcTest17(aArg1: Currency; var aArg2: Currency; out aArg3: Currency; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Currency): Currency;
  352. function ProcTest18(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Single): Single;
  353. function ProcTest19(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Double): Double;
  354. function ProcTest20(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Extended): Extended;
  355. function ProcTest21(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Comp): Comp;
  356. function ProcTest22(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Currency): Currency;
  357. function ProcTestRecSize1(aArg1: TTestRecord1): TTestRecord1;
  358. function ProcTestRecSize2(aArg1: TTestRecord2): TTestRecord2;
  359. function ProcTestRecSize3(aArg1: TTestRecord3): TTestRecord3;
  360. function ProcTestRecSize4(aArg1: TTestRecord4): TTestRecord4;
  361. function ProcTestRecSize5(aArg1: TTestRecord5): TTestRecord5;
  362. function ProcTestRecSize6(aArg1: TTestRecord6): TTestRecord6;
  363. function ProcTestRecSize7(aArg1: TTestRecord7): TTestRecord7;
  364. function ProcTestRecSize8(aArg1: TTestRecord8): TTestRecord8;
  365. function ProcTestRecSize9(aArg1: TTestRecord9): TTestRecord9;
  366. function ProcTestRecSize10(aArg1: TTestRecord10): TTestRecord10;
  367. procedure ProcTestUntyped(var aArg1; out aArg2; const aArg3; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4);
  368. implementation
  369. procedure TTestInterfaceClass.Test1;
  370. begin
  371. SetLength(InputArgs, 0);
  372. SetLength(OutputArgs, 0);
  373. ResultValue := TValue.Empty;
  374. CalledMethod := 1;
  375. end;
  376. function TTestInterfaceClass.Test2: SizeInt;
  377. begin
  378. SetLength(InputArgs, 0);
  379. SetLength(OutputArgs, 0);
  380. Result := 42;
  381. TValue.Make(@Result, TypeInfo(Result), ResultValue);
  382. CalledMethod := 2;
  383. end;
  384. function TTestInterfaceClass.Test3(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: SizeInt): SizeInt;
  385. begin
  386. SetLength(InputArgs, 10);
  387. TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]);
  388. TValue.Make(@aArg2, TypeInfo(aArg2), InputArgs[1]);
  389. TValue.Make(@aArg3, TypeInfo(aArg3), InputArgs[2]);
  390. TValue.Make(@aArg4, TypeInfo(aArg4), InputArgs[3]);
  391. TValue.Make(@aArg5, TypeInfo(aArg5), InputArgs[4]);
  392. TValue.Make(@aArg6, TypeInfo(aArg6), InputArgs[5]);
  393. TValue.Make(@aArg7, TypeInfo(aArg7), InputArgs[6]);
  394. TValue.Make(@aArg8, TypeInfo(aArg8), InputArgs[7]);
  395. TValue.Make(@aArg9, TypeInfo(aArg9), InputArgs[8]);
  396. TValue.Make(@aArg10, TypeInfo(aArg10), InputArgs[9]);
  397. SetLength(OutputArgs, 0);
  398. Result := 42;
  399. TValue.Make(@Result, TypeInfo(Result), ResultValue);
  400. CalledMethod := 3;
  401. end;
  402. procedure TTestInterfaceClass.Test4(aArg1: AnsiString; aArg2: UnicodeString; aArg3: WideString; aArg4: ShortString);
  403. begin
  404. SetLength(InputArgs, 4);
  405. TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]);
  406. TValue.Make(@aArg2, TypeInfo(aArg2), InputArgs[1]);
  407. TValue.Make(@aArg3, TypeInfo(aArg3), InputArgs[2]);
  408. TValue.Make(@aArg4, TypeInfo(aArg4), InputArgs[3]);
  409. SetLength(OutputArgs, 0);
  410. ResultValue := TValue.Empty;
  411. CalledMethod := 4;
  412. end;
  413. function TTestInterfaceClass.Test5: AnsiString;
  414. begin
  415. SetLength(InputArgs, 0);
  416. SetLength(OutputArgs, 0);
  417. Result := 'Hello World';
  418. TValue.Make(@Result, TypeInfo(Result), ResultValue);
  419. CalledMethod := 5;
  420. end;
  421. function TTestInterfaceClass.Test6: UnicodeString;
  422. begin
  423. SetLength(InputArgs, 0);
  424. SetLength(OutputArgs, 0);
  425. Result := 'Hello World';
  426. TValue.Make(@Result, TypeInfo(Result), ResultValue);
  427. CalledMethod := 6;
  428. end;
  429. function TTestInterfaceClass.Test7: WideString;
  430. begin
  431. SetLength(InputArgs, 0);
  432. SetLength(OutputArgs, 0);
  433. Result := 'Hello World';
  434. TValue.Make(@Result, TypeInfo(Result), ResultValue);
  435. CalledMethod := 7;
  436. end;
  437. function TTestInterfaceClass.Test8: ShortString;
  438. begin
  439. SetLength(InputArgs, 0);
  440. SetLength(OutputArgs, 0);
  441. Result := 'Hello World';
  442. TValue.Make(@Result, TypeInfo(Result), ResultValue);
  443. CalledMethod := 8;
  444. end;
  445. procedure TTestInterfaceClass.Test9(aArg1: SizeInt; var aArg2: SizeInt; out aArg3: SizeInt; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: SizeInt);
  446. begin
  447. SetLength(InputArgs, 4);
  448. TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]);
  449. TValue.Make(@aArg2, TypeInfo(aArg2), InputArgs[1]);
  450. TValue.Make(@aArg3, TypeInfo(aArg3), InputArgs[2]);
  451. TValue.Make(@aArg4, TypeInfo(aArg4), InputArgs[3]);
  452. aArg2 := $1234;
  453. aArg3 := $5678;
  454. SetLength(OutputArgs, 2);
  455. TValue.Make(@aArg2, TypeInfo(aArg2), OutputArgs[0]);
  456. TValue.Make(@aArg3, TypeInfo(aArg3), OutputArgs[1]);
  457. SetLength(InOutMapping, 2);
  458. InOutMapping[0] := 1;
  459. InOutMapping[1] := 2;
  460. ResultValue := TValue.Empty;
  461. CalledMethod := 9;
  462. end;
  463. procedure TTestInterfaceClass.Test10(aArg1: AnsiString; var aArg2: AnsiString; out aArg3: AnsiString; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: AnsiString);
  464. begin
  465. SetLength(InputArgs, 4);
  466. TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]);
  467. TValue.Make(@aArg2, TypeInfo(aArg2), InputArgs[1]);
  468. TValue.Make(@aArg3, TypeInfo(aArg3), InputArgs[2]);
  469. TValue.Make(@aArg4, TypeInfo(aArg4), InputArgs[3]);
  470. aArg2 := 'Foo';
  471. aArg3 := 'Bar';
  472. SetLength(OutputArgs, 2);
  473. TValue.Make(@aArg2, TypeInfo(aArg2), OutputArgs[0]);
  474. TValue.Make(@aArg3, TypeInfo(aArg3), OutputArgs[1]);
  475. SetLength(InOutMapping, 2);
  476. InOutMapping[0] := 1;
  477. InOutMapping[1] := 2;
  478. ResultValue := TValue.Empty;
  479. CalledMethod := 10;
  480. end;
  481. procedure TTestInterfaceClass.Test11(aArg1: ShortString; var aArg2: ShortString; out aArg3: ShortString; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: ShortString);
  482. begin
  483. SetLength(InputArgs, 4);
  484. TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]);
  485. TValue.Make(@aArg2, TypeInfo(aArg2), InputArgs[1]);
  486. TValue.Make(@aArg3, TypeInfo(aArg3), InputArgs[2]);
  487. TValue.Make(@aArg4, TypeInfo(aArg4), InputArgs[3]);
  488. aArg2 := 'Foo';
  489. aArg3 := 'Bar';
  490. SetLength(OutputArgs, 2);
  491. TValue.Make(@aArg2, TypeInfo(aArg2), OutputArgs[0]);
  492. TValue.Make(@aArg3, TypeInfo(aArg3), OutputArgs[1]);
  493. SetLength(InOutMapping, 2);
  494. InOutMapping[0] := 1;
  495. InOutMapping[1] := 2;
  496. ResultValue := TValue.Empty;
  497. CalledMethod := 11;
  498. end;
  499. 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);
  500. {$ifdef fpc}
  501. var
  502. i: SizeInt;
  503. start: SizeInt;
  504. {$endif}
  505. begin
  506. {$ifdef fpc}
  507. SetLength(InputArgs, 4);
  508. InputArgs[0] := specialize OpenArrayToDynArrayValue<SizeInt>(aArg1);
  509. InputArgs[1] := specialize OpenArrayToDynArrayValue<SizeInt>(aArg2);
  510. InputArgs[2] := specialize OpenArrayToDynArrayValue<SizeInt>(aArg3);
  511. InputArgs[3] := specialize OpenArrayToDynArrayValue<SizeInt>(aArg4);
  512. SetLength(OutputArgs, 2);
  513. start := $4321;
  514. for i := 0 to High(aArg2) do
  515. aArg2[i] := start + i;
  516. start := $9876;
  517. for i := 0 to High(aArg3) do
  518. aArg3[i] := start + i;
  519. OutputArgs[0] := specialize OpenArrayToDynArrayValue<SizeInt>(aArg2);
  520. OutputArgs[1] := specialize OpenArrayToDynArrayValue<SizeInt>(aArg3);
  521. SetLength(InOutMapping, 2);
  522. InOutMapping[0] := 1;
  523. InOutMapping[1] := 2;
  524. ResultValue := TValue.Empty;
  525. CalledMethod := 12;
  526. {$endif}
  527. end;
  528. function TTestInterfaceClass.Test13(aArg1: Single; var aArg2: Single; out aArg3: Single; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Single): Single;
  529. begin
  530. SetLength(InputArgs, 4);
  531. TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]);
  532. TValue.Make(@aArg2, TypeInfo(aArg2), InputArgs[1]);
  533. TValue.Make(@aArg3, TypeInfo(aArg3), InputArgs[2]);
  534. TValue.Make(@aArg4, TypeInfo(aArg4), InputArgs[3]);
  535. aArg2 := SingleArg2Out;
  536. aArg3 := SingleArg3Out;
  537. SetLength(OutputArgs, 2);
  538. TValue.Make(@aArg2, TypeInfo(aArg2), OutputArgs[0]);
  539. TValue.Make(@aArg3, TypeInfo(aArg3), OutputArgs[1]);
  540. SetLength(InOutMapping, 2);
  541. InOutMapping[0] := 1;
  542. InOutMapping[1] := 2;
  543. Result := SingleRes;
  544. TValue.Make(@Result, TypeInfo(Result), ResultValue);
  545. CalledMethod := 13;
  546. end;
  547. function TTestInterfaceClass.Test14(aArg1: Double; var aArg2: Double; out aArg3: Double; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Double): Double;
  548. begin
  549. SetLength(InputArgs, 4);
  550. TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]);
  551. TValue.Make(@aArg2, TypeInfo(aArg2), InputArgs[1]);
  552. TValue.Make(@aArg3, TypeInfo(aArg3), InputArgs[2]);
  553. TValue.Make(@aArg4, TypeInfo(aArg4), InputArgs[3]);
  554. aArg2 := DoubleArg2Out;
  555. aArg3 := DoubleArg3Out;
  556. SetLength(OutputArgs, 2);
  557. TValue.Make(@aArg2, TypeInfo(aArg2), OutputArgs[0]);
  558. TValue.Make(@aArg3, TypeInfo(aArg3), OutputArgs[1]);
  559. SetLength(InOutMapping, 2);
  560. InOutMapping[0] := 1;
  561. InOutMapping[1] := 2;
  562. Result := DoubleRes;
  563. TValue.Make(@Result, TypeInfo(Result), ResultValue);
  564. CalledMethod := 14;
  565. end;
  566. function TTestInterfaceClass.Test15(aArg1: Extended; var aArg2: Extended; out aArg3: Extended; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Extended): Extended;
  567. begin
  568. SetLength(InputArgs, 4);
  569. TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]);
  570. TValue.Make(@aArg2, TypeInfo(aArg2), InputArgs[1]);
  571. TValue.Make(@aArg3, TypeInfo(aArg3), InputArgs[2]);
  572. TValue.Make(@aArg4, TypeInfo(aArg4), InputArgs[3]);
  573. aArg2 := ExtendedArg2Out;
  574. aArg3 := ExtendedArg3Out;
  575. SetLength(OutputArgs, 2);
  576. TValue.Make(@aArg2, TypeInfo(aArg2), OutputArgs[0]);
  577. TValue.Make(@aArg3, TypeInfo(aArg3), OutputArgs[1]);
  578. SetLength(InOutMapping, 2);
  579. InOutMapping[0] := 1;
  580. InOutMapping[1] := 2;
  581. Result := ExtendedRes;
  582. TValue.Make(@Result, TypeInfo(Result), ResultValue);
  583. CalledMethod := 15;
  584. end;
  585. function TTestInterfaceClass.Test16(aArg1: Comp; var aArg2: Comp; out aArg3: Comp; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Comp): Comp;
  586. begin
  587. SetLength(InputArgs, 4);
  588. TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]);
  589. TValue.Make(@aArg2, TypeInfo(aArg2), InputArgs[1]);
  590. TValue.Make(@aArg3, TypeInfo(aArg3), InputArgs[2]);
  591. TValue.Make(@aArg4, TypeInfo(aArg4), InputArgs[3]);
  592. aArg2 := CompArg2Out;
  593. aArg3 := CompArg3Out;
  594. SetLength(OutputArgs, 2);
  595. TValue.Make(@aArg2, TypeInfo(aArg2), OutputArgs[0]);
  596. TValue.Make(@aArg3, TypeInfo(aArg3), OutputArgs[1]);
  597. SetLength(InOutMapping, 2);
  598. InOutMapping[0] := 1;
  599. InOutMapping[1] := 2;
  600. Result := CompRes;
  601. TValue.Make(@Result, TypeInfo(Result), ResultValue);
  602. CalledMethod := 16;
  603. end;
  604. function TTestInterfaceClass.Test17(aArg1: Currency; var aArg2: Currency; out aArg3: Currency; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Currency): Currency;
  605. begin
  606. SetLength(InputArgs, 4);
  607. TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]);
  608. TValue.Make(@aArg2, TypeInfo(aArg2), InputArgs[1]);
  609. TValue.Make(@aArg3, TypeInfo(aArg3), InputArgs[2]);
  610. TValue.Make(@aArg4, TypeInfo(aArg4), InputArgs[3]);
  611. aArg2 := CurrencyArg2Out;
  612. aArg3 := CurrencyArg3Out;
  613. SetLength(OutputArgs, 2);
  614. TValue.Make(@aArg2, TypeInfo(aArg2), OutputArgs[0]);
  615. TValue.Make(@aArg3, TypeInfo(aArg3), OutputArgs[1]);
  616. SetLength(InOutMapping, 2);
  617. InOutMapping[0] := 1;
  618. InOutMapping[1] := 2;
  619. Result := CurrencyRes;
  620. TValue.Make(@Result, TypeInfo(Result), ResultValue);
  621. CalledMethod := 17;
  622. end;
  623. function TTestInterfaceClass.Test18(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Single): Single;
  624. begin
  625. SetLength(InputArgs, 10);
  626. TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]);
  627. TValue.Make(@aArg2, TypeInfo(aArg2), InputArgs[1]);
  628. TValue.Make(@aArg3, TypeInfo(aArg3), InputArgs[2]);
  629. TValue.Make(@aArg4, TypeInfo(aArg4), InputArgs[3]);
  630. TValue.Make(@aArg5, TypeInfo(aArg5), InputArgs[4]);
  631. TValue.Make(@aArg6, TypeInfo(aArg6), InputArgs[5]);
  632. TValue.Make(@aArg7, TypeInfo(aArg7), InputArgs[6]);
  633. TValue.Make(@aArg8, TypeInfo(aArg8), InputArgs[7]);
  634. TValue.Make(@aArg9, TypeInfo(aArg9), InputArgs[8]);
  635. TValue.Make(@aArg10, TypeInfo(aArg10), InputArgs[9]);
  636. SetLength(OutputArgs, 0);
  637. SetLength(InOutMapping, 0);
  638. Result := aArg1 + aArg2 + aArg3 + aArg4 + aArg5 + aArg6 + aArg7 + aArg8 + aArg9 + aArg10;
  639. TValue.Make(@Result ,TypeInfo(Result), ResultValue);
  640. CalledMethod := 18;
  641. end;
  642. function TTestInterfaceClass.Test19(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Double): Double;
  643. begin
  644. SetLength(InputArgs, 10);
  645. TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]);
  646. TValue.Make(@aArg2, TypeInfo(aArg2), InputArgs[1]);
  647. TValue.Make(@aArg3, TypeInfo(aArg3), InputArgs[2]);
  648. TValue.Make(@aArg4, TypeInfo(aArg4), InputArgs[3]);
  649. TValue.Make(@aArg5, TypeInfo(aArg5), InputArgs[4]);
  650. TValue.Make(@aArg6, TypeInfo(aArg6), InputArgs[5]);
  651. TValue.Make(@aArg7, TypeInfo(aArg7), InputArgs[6]);
  652. TValue.Make(@aArg8, TypeInfo(aArg8), InputArgs[7]);
  653. TValue.Make(@aArg9, TypeInfo(aArg9), InputArgs[8]);
  654. TValue.Make(@aArg10, TypeInfo(aArg10), InputArgs[9]);
  655. SetLength(OutputArgs, 0);
  656. SetLength(InOutMapping, 0);
  657. Result := aArg1 + aArg2 + aArg3 + aArg4 + aArg5 + aArg6 + aArg7 + aArg8 + aArg9 + aArg10;
  658. TValue.Make(@Result ,TypeInfo(Result), ResultValue);
  659. CalledMethod := 19;
  660. end;
  661. function TTestInterfaceClass.Test20(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Extended): Extended;
  662. begin
  663. SetLength(InputArgs, 10);
  664. TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]);
  665. TValue.Make(@aArg2, TypeInfo(aArg2), InputArgs[1]);
  666. TValue.Make(@aArg3, TypeInfo(aArg3), InputArgs[2]);
  667. TValue.Make(@aArg4, TypeInfo(aArg4), InputArgs[3]);
  668. TValue.Make(@aArg5, TypeInfo(aArg5), InputArgs[4]);
  669. TValue.Make(@aArg6, TypeInfo(aArg6), InputArgs[5]);
  670. TValue.Make(@aArg7, TypeInfo(aArg7), InputArgs[6]);
  671. TValue.Make(@aArg8, TypeInfo(aArg8), InputArgs[7]);
  672. TValue.Make(@aArg9, TypeInfo(aArg9), InputArgs[8]);
  673. TValue.Make(@aArg10, TypeInfo(aArg10), InputArgs[9]);
  674. SetLength(OutputArgs, 0);
  675. SetLength(InOutMapping, 0);
  676. Result := aArg1 + aArg2 + aArg3 + aArg4 + aArg5 + aArg6 + aArg7 + aArg8 + aArg9 + aArg10;
  677. TValue.Make(@Result ,TypeInfo(Result), ResultValue);
  678. CalledMethod := 20;
  679. end;
  680. function TTestInterfaceClass.Test21(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Comp): Comp;
  681. begin
  682. SetLength(InputArgs, 10);
  683. TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]);
  684. TValue.Make(@aArg2, TypeInfo(aArg2), InputArgs[1]);
  685. TValue.Make(@aArg3, TypeInfo(aArg3), InputArgs[2]);
  686. TValue.Make(@aArg4, TypeInfo(aArg4), InputArgs[3]);
  687. TValue.Make(@aArg5, TypeInfo(aArg5), InputArgs[4]);
  688. TValue.Make(@aArg6, TypeInfo(aArg6), InputArgs[5]);
  689. TValue.Make(@aArg7, TypeInfo(aArg7), InputArgs[6]);
  690. TValue.Make(@aArg8, TypeInfo(aArg8), InputArgs[7]);
  691. TValue.Make(@aArg9, TypeInfo(aArg9), InputArgs[8]);
  692. TValue.Make(@aArg10, TypeInfo(aArg10), InputArgs[9]);
  693. SetLength(OutputArgs, 0);
  694. SetLength(InOutMapping, 0);
  695. Result := aArg1 + aArg2 + aArg3 + aArg4 + aArg5 + aArg6 + aArg7 + aArg8 + aArg9 + aArg10;
  696. TValue.Make(@Result ,TypeInfo(Result), ResultValue);
  697. CalledMethod := 21;
  698. end;
  699. function TTestInterfaceClass.Test22(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Currency): Currency;
  700. begin
  701. SetLength(InputArgs, 10);
  702. TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]);
  703. TValue.Make(@aArg2, TypeInfo(aArg2), InputArgs[1]);
  704. TValue.Make(@aArg3, TypeInfo(aArg3), InputArgs[2]);
  705. TValue.Make(@aArg4, TypeInfo(aArg4), InputArgs[3]);
  706. TValue.Make(@aArg5, TypeInfo(aArg5), InputArgs[4]);
  707. TValue.Make(@aArg6, TypeInfo(aArg6), InputArgs[5]);
  708. TValue.Make(@aArg7, TypeInfo(aArg7), InputArgs[6]);
  709. TValue.Make(@aArg8, TypeInfo(aArg8), InputArgs[7]);
  710. TValue.Make(@aArg9, TypeInfo(aArg9), InputArgs[8]);
  711. TValue.Make(@aArg10, TypeInfo(aArg10), InputArgs[9]);
  712. SetLength(OutputArgs, 0);
  713. SetLength(InOutMapping, 0);
  714. Result := aArg1 + aArg2 + aArg3 + aArg4 + aArg5 + aArg6 + aArg7 + aArg8 + aArg9 + aArg10;
  715. TValue.Make(@Result ,TypeInfo(Result), ResultValue);
  716. CalledMethod := 22;
  717. end;
  718. function TTestInterfaceClass.Test23(aArg1: Variant): AnsiString;
  719. begin
  720. SetLength(OutputArgs, 0);
  721. SetLength(InOutMapping, 0);
  722. SetLength(InputArgs, 1);
  723. TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]);
  724. Result:=AnsiString(aArg1);
  725. TValue.Make(@Result ,TypeInfo(Result), ResultValue);
  726. CalledMethod:=23;
  727. end;
  728. function TTestInterfaceClass.TestRecSize1(aArg1: TTestRecord1): TTestRecord1;
  729. var
  730. i: LongInt;
  731. begin
  732. SetLength(InputArgs, 1);
  733. TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]);
  734. SetLength(OutputArgs, 0);
  735. for i := 0 to High(aArg1.b) do
  736. Result.b[High(Result.b) - i] := aArg1.b[i];
  737. TValue.Make(@Result, TypeInfo(Result), ResultValue);
  738. CalledMethod := 1 or RecSizeMarker;
  739. end;
  740. function TTestInterfaceClass.TestRecSize2(aArg1: TTestRecord2): TTestRecord2;
  741. var
  742. i: LongInt;
  743. begin
  744. SetLength(InputArgs, 1);
  745. TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]);
  746. SetLength(OutputArgs, 0);
  747. for i := 0 to High(aArg1.b) do
  748. Result.b[High(Result.b) - i] := aArg1.b[i];
  749. TValue.Make(@Result, TypeInfo(Result), ResultValue);
  750. CalledMethod := 2 or RecSizeMarker;
  751. end;
  752. function TTestInterfaceClass.TestRecSize3(aArg1: TTestRecord3): TTestRecord3;
  753. var
  754. i: LongInt;
  755. begin
  756. SetLength(InputArgs, 1);
  757. TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]);
  758. SetLength(OutputArgs, 0);
  759. for i := 0 to High(aArg1.b) do
  760. Result.b[High(Result.b) - i] := aArg1.b[i];
  761. TValue.Make(@Result, TypeInfo(Result), ResultValue);
  762. CalledMethod := 3 or RecSizeMarker;
  763. end;
  764. function TTestInterfaceClass.TestRecSize4(aArg1: TTestRecord4): TTestRecord4;
  765. var
  766. i: LongInt;
  767. begin
  768. SetLength(InputArgs, 1);
  769. TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]);
  770. SetLength(OutputArgs, 0);
  771. for i := 0 to High(aArg1.b) do
  772. Result.b[High(Result.b) - i] := aArg1.b[i];
  773. TValue.Make(@Result, TypeInfo(Result), ResultValue);
  774. CalledMethod := 4 or RecSizeMarker;
  775. end;
  776. function TTestInterfaceClass.TestRecSize5(aArg1: TTestRecord5): TTestRecord5;
  777. var
  778. i: LongInt;
  779. begin
  780. SetLength(InputArgs, 1);
  781. TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]);
  782. SetLength(OutputArgs, 0);
  783. for i := 0 to High(aArg1.b) do
  784. Result.b[High(Result.b) - i] := aArg1.b[i];
  785. TValue.Make(@Result, TypeInfo(Result), ResultValue);
  786. CalledMethod := 5 or RecSizeMarker;
  787. end;
  788. function TTestInterfaceClass.TestRecSize6(aArg1: TTestRecord6): TTestRecord6;
  789. var
  790. i: LongInt;
  791. begin
  792. SetLength(InputArgs, 1);
  793. TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]);
  794. SetLength(OutputArgs, 0);
  795. for i := 0 to High(aArg1.b) do
  796. Result.b[High(Result.b) - i] := aArg1.b[i];
  797. TValue.Make(@Result, TypeInfo(Result), ResultValue);
  798. CalledMethod := 6 or RecSizeMarker;
  799. end;
  800. function TTestInterfaceClass.TestRecSize7(aArg1: TTestRecord7): TTestRecord7;
  801. var
  802. i: LongInt;
  803. begin
  804. SetLength(InputArgs, 1);
  805. TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]);
  806. SetLength(OutputArgs, 0);
  807. for i := 0 to High(aArg1.b) do
  808. Result.b[High(Result.b) - i] := aArg1.b[i];
  809. TValue.Make(@Result, TypeInfo(Result), ResultValue);
  810. CalledMethod := 7 or RecSizeMarker;
  811. end;
  812. function TTestInterfaceClass.TestRecSize8(aArg1: TTestRecord8): TTestRecord8;
  813. var
  814. i: LongInt;
  815. begin
  816. SetLength(InputArgs, 1);
  817. TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]);
  818. SetLength(OutputArgs, 0);
  819. for i := 0 to High(aArg1.b) do
  820. Result.b[High(Result.b) - i] := aArg1.b[i];
  821. TValue.Make(@Result, TypeInfo(Result), ResultValue);
  822. CalledMethod := 8 or RecSizeMarker;
  823. end;
  824. function TTestInterfaceClass.TestRecSize9(aArg1: TTestRecord9): TTestRecord9;
  825. var
  826. i: LongInt;
  827. begin
  828. SetLength(InputArgs, 1);
  829. TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]);
  830. SetLength(OutputArgs, 0);
  831. for i := 0 to High(aArg1.b) do
  832. Result.b[High(Result.b) - i] := aArg1.b[i];
  833. TValue.Make(@Result, TypeInfo(Result), ResultValue);
  834. CalledMethod := 9 or RecSizeMarker;
  835. end;
  836. function TTestInterfaceClass.TestRecSize10(aArg1: TTestRecord10): TTestRecord10;
  837. var
  838. i: LongInt;
  839. begin
  840. SetLength(InputArgs, 1);
  841. TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]);
  842. SetLength(OutputArgs, 0);
  843. for i := 0 to High(aArg1.b) do
  844. Result.b[High(Result.b) - i] := aArg1.b[i];
  845. TValue.Make(@Result, TypeInfo(Result), ResultValue);
  846. CalledMethod := 10 or RecSizeMarker;
  847. end;
  848. procedure TTestInterfaceClass.TestUntyped(var aArg1; out aArg2; const aArg3; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4);
  849. begin
  850. if Length(ExpectedArgs) <> 4 then
  851. Exit;
  852. if Length(OutArgs) <> 2 then
  853. Exit;
  854. SetLength(InputArgs, 4);
  855. TValue.Make(@aArg1, ExpectedArgs[0].TypeInfo, InputArgs[0]);
  856. TValue.Make(@aArg2, ExpectedArgs[1].TypeInfo, InputArgs[1]);
  857. TValue.Make(@aArg3, ExpectedArgs[2].TypeInfo, InputArgs[2]);
  858. TValue.Make(@aArg4, ExpectedArgs[3].TypeInfo, InputArgs[3]);
  859. Move(PPointer(OutArgs[0].GetReferenceToRawData)^, aArg1, OutArgs[0].DataSize);
  860. Move(PPointer(OutArgs[1].GetReferenceToRawData)^, aArg2, OutArgs[1].DataSize);
  861. SetLength(OutputArgs, 2);
  862. TValue.Make(@aArg1, ExpectedArgs[0].TypeInfo, OutputArgs[0]);
  863. TValue.Make(@aArg2, ExpectedArgs[1].TypeInfo, OutputArgs[1]);
  864. SetLength(InOutMapping, 2);
  865. InOutMapping[0] := 0;
  866. InOutMapping[1] := 1;
  867. CalledMethod := -1;
  868. end;
  869. procedure TTestInterfaceClass.Reset;
  870. begin
  871. InputArgs := Nil;
  872. OutputArgs := Nil;
  873. ExpectedArgs := Nil;
  874. OutArgs := Nil;
  875. InOutMapping := Nil;
  876. ResultValue := TValue.Empty;
  877. CalledMethod := 0;
  878. end;
  879. function TTestInterfaceClass.DoAddRef: longint;
  880. begin
  881. Result:=_AddRef;
  882. end;
  883. function TTestInterfaceClass.DoRelease: longint;
  884. begin
  885. Result:=_Release
  886. end;
  887. destructor TTestInterfaceClass.Destroy;
  888. begin
  889. // Empty, for debugging purposes
  890. inherited Destroy;
  891. end;
  892. { TTestParent }
  893. function TTestParent.DoTest: String;
  894. begin
  895. Result:='Parent';
  896. end;
  897. procedure ProcTest1;
  898. begin
  899. TTestInterfaceClass.ProcVarInst.Test1;
  900. end;
  901. function ProcTest2: SizeInt;
  902. begin
  903. Result := TTestInterfaceClass.ProcVarInst.Test2;
  904. end;
  905. function ProcTest3(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: SizeInt): SizeInt;
  906. begin
  907. Result := TTestInterfaceClass.ProcVarInst.Test3(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10);
  908. end;
  909. procedure ProcTest4(aArg1: AnsiString; aArg2: UnicodeString; aArg3: WideString; aArg4: ShortString);
  910. begin
  911. TTestInterfaceClass.ProcVarInst.Test4(aArg1, aArg2, aArg3, aArg4);
  912. end;
  913. function ProcTest5: AnsiString;
  914. begin
  915. Result := TTestInterfaceClass.ProcVarInst.Test5;
  916. end;
  917. function ProcTest6: UnicodeString;
  918. begin
  919. Result := TTestInterfaceClass.ProcVarInst.Test6;
  920. end;
  921. function ProcTest7: WideString;
  922. begin
  923. Result := TTestInterfaceClass.ProcVarInst.Test7;
  924. end;
  925. function ProcTest8: ShortString;
  926. begin
  927. Result := TTestInterfaceClass.ProcVarInst.Test8;
  928. end;
  929. procedure ProcTest9(aArg1: SizeInt; var aArg2: SizeInt; out aArg3: SizeInt; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: SizeInt);
  930. begin
  931. TTestInterfaceClass.ProcVarInst.Test9(aArg1, aArg2, aArg3, aArg4);
  932. end;
  933. procedure ProcTest10(aArg1: AnsiString; var aArg2: AnsiString; out aArg3: AnsiString; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: AnsiString);
  934. begin
  935. TTestInterfaceClass.ProcVarInst.Test10(aArg1, aArg2, aArg3, aArg4);
  936. end;
  937. procedure ProcTest11(aArg1: ShortString; var aArg2: ShortString; out aArg3: ShortString; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: ShortString);
  938. begin
  939. TTestInterfaceClass.ProcVarInst.Test11(aArg1, aArg2, aArg3, aArg4);
  940. end;
  941. 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);
  942. begin
  943. TTestInterfaceClass.ProcVarInst.Test12(aArg1, aArg2, aArg3, aArg4);
  944. end;
  945. function ProcTest13(aArg1: Single; var aArg2: Single; out aArg3: Single; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Single): Single;
  946. begin
  947. Result := TTestInterfaceClass.ProcVarInst.Test13(aArg1, aArg2, aArg3, aArg4);
  948. end;
  949. function ProcTest14(aArg1: Double; var aArg2: Double; out aArg3: Double; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Double): Double;
  950. begin
  951. Result := TTestInterfaceClass.ProcVarInst.Test14(aArg1, aArg2, aArg3, aArg4);
  952. end;
  953. function ProcTest15(aArg1: Extended; var aArg2: Extended; out aArg3: Extended; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Extended): Extended;
  954. begin
  955. Result := TTestInterfaceClass.ProcVarInst.Test15(aArg1, aArg2, aArg3, aArg4);
  956. end;
  957. function ProcTest16(aArg1: Comp; var aArg2: Comp; out aArg3: Comp; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Comp): Comp;
  958. begin
  959. Result := TTestInterfaceClass.ProcVarInst.Test16(aArg1, aArg2, aArg3, aArg4);
  960. end;
  961. function ProcTest17(aArg1: Currency; var aArg2: Currency; out aArg3: Currency; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Currency): Currency;
  962. begin
  963. Result := TTestInterfaceClass.ProcVarInst.Test17(aArg1, aArg2, aArg3, aArg4);
  964. end;
  965. function ProcTest18(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Single): Single;
  966. begin
  967. Result := TTestInterfaceClass.ProcVarInst.Test18(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10);
  968. end;
  969. function ProcTest19(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Double): Double;
  970. begin
  971. Result := TTestInterfaceClass.ProcVarInst.Test19(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10);
  972. end;
  973. function ProcTest20(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Extended): Extended;
  974. begin
  975. Result := TTestInterfaceClass.ProcVarInst.Test20(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10);
  976. end;
  977. function ProcTest21(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Comp): Comp;
  978. begin
  979. Result := TTestInterfaceClass.ProcVarInst.Test21(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10);
  980. end;
  981. function ProcTest22(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Currency): Currency;
  982. begin
  983. Result := TTestInterfaceClass.ProcVarInst.Test22(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10);
  984. end;
  985. function ProcTestRecSize1(aArg1: TTestRecord1): TTestRecord1;
  986. begin
  987. Result := TTestInterfaceClass.ProcVarRecInst.TestRecSize1(aArg1);
  988. end;
  989. function ProcTestRecSize2(aArg1: TTestRecord2): TTestRecord2;
  990. begin
  991. Result := TTestInterfaceClass.ProcVarRecInst.TestRecSize2(aArg1);
  992. end;
  993. function ProcTestRecSize3(aArg1: TTestRecord3): TTestRecord3;
  994. begin
  995. Result := TTestInterfaceClass.ProcVarRecInst.TestRecSize3(aArg1);
  996. end;
  997. function ProcTestRecSize4(aArg1: TTestRecord4): TTestRecord4;
  998. begin
  999. Result := TTestInterfaceClass.ProcVarRecInst.TestRecSize4(aArg1);
  1000. end;
  1001. function ProcTestRecSize5(aArg1: TTestRecord5): TTestRecord5;
  1002. begin
  1003. Result := TTestInterfaceClass.ProcVarRecInst.TestRecSize5(aArg1);
  1004. end;
  1005. function ProcTestRecSize6(aArg1: TTestRecord6): TTestRecord6;
  1006. begin
  1007. Result := TTestInterfaceClass.ProcVarRecInst.TestRecSize6(aArg1);
  1008. end;
  1009. function ProcTestRecSize7(aArg1: TTestRecord7): TTestRecord7;
  1010. begin
  1011. Result := TTestInterfaceClass.ProcVarRecInst.TestRecSize7(aArg1);
  1012. end;
  1013. function ProcTestRecSize8(aArg1: TTestRecord8): TTestRecord8;
  1014. begin
  1015. Result := TTestInterfaceClass.ProcVarRecInst.TestRecSize8(aArg1);
  1016. end;
  1017. function ProcTestRecSize9(aArg1: TTestRecord9): TTestRecord9;
  1018. begin
  1019. Result := TTestInterfaceClass.ProcVarRecInst.TestRecSize9(aArg1);
  1020. end;
  1021. function ProcTestRecSize10(aArg1: TTestRecord10): TTestRecord10;
  1022. begin
  1023. Result := TTestInterfaceClass.ProcVarRecInst.TestRecSize10(aArg1);
  1024. end;
  1025. procedure ProcTestUntyped(var aArg1; out aArg2; const aArg3; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4);
  1026. begin
  1027. TTestInterfaceClass.ProcVarInst.TestUntyped(aArg1, aArg2, aArg3, aArg4);
  1028. end;
  1029. constructor TTestConstructorCall.Create(aTest: ITestMethodCall);
  1030. begin
  1031. FTest:=aTest;
  1032. end;
  1033. function TTestConstructorCall.DoTest : string;
  1034. begin
  1035. Result:=FTest.Test;
  1036. end;
  1037. { TTest }
  1038. function TTest.Test : string;
  1039. begin
  1040. FTestCalled:=True;
  1041. Result:='In test';
  1042. end;
  1043. { TTestInvokeCast }
  1044. function TTestInvokeCast.Test(Arg: Single): Double;
  1045. begin
  1046. Result := Arg + 1;
  1047. end;
  1048. procedure TTestInvokeCast.Test2(var Arg: Single);
  1049. begin
  1050. Arg := Arg + 1;
  1051. end;
  1052. procedure TTestInvokeCast.Test3(Arg: TEnum1);
  1053. begin
  1054. end;
  1055. function TTestInvokeCast.Test4(Arg: UInt8): UInt8;
  1056. begin
  1057. Result := Arg + 1;
  1058. end;
  1059. { Test }
  1060. constructor TTestBaseNewInstance.create;
  1061. begin
  1062. //
  1063. end;
  1064. class function TTestBaseNewInstance.NewInstance: TObject;
  1065. begin
  1066. Result := inherited NewInstance;
  1067. Inc(BaseNewCount);
  1068. end;
  1069. class function TTestNewInstance.NewInstance: TObject;
  1070. begin
  1071. Result := inherited NewInstance;
  1072. Inc(TestNewCount);
  1073. end;
  1074. end.