tests.rtti.invoke.pas 83 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070
  1. unit tests.rtti.invoke;
  2. {$ifdef fpc}
  3. {$mode objfpc}{$H+}
  4. {$endif}
  5. {.$define debug}
  6. interface
  7. uses
  8. {$IFDEF FPC}
  9. fpcunit,testregistry, testutils,
  10. {$ELSE FPC}
  11. TestFramework,
  12. {$ENDIF FPC}
  13. sysutils, typinfo, Rtti;
  14. type
  15. {$ifndef fpc}
  16. CodePointer = Pointer;
  17. {$endif}
  18. TTestInvoke = class(TTestCase)
  19. private type
  20. TInvokeFlag = (
  21. ifStatic,
  22. ifConstructor
  23. );
  24. TInvokeFlags = set of TInvokeFlag;
  25. private
  26. function EqualValues(aValue1, aValue2: TValue): Boolean;
  27. function DoInvoke(aCodeAddress: CodePointer; aArgs: TValueArray; aCallConv: TCallConv; aResultType: PTypeInfo; aFlags: TInvokeFlags; out aValid: Boolean): TValue;
  28. procedure DoStaticInvokeTestOrdinalCompare(const aTestName: String; aAddress: CodePointer; aCallConv: TCallConv; aValues: TValueArray; aReturnType: PTypeInfo; aResult: Int64);
  29. procedure DoStaticInvokeTestAnsiStringCompare(const aTestName: String; aAddress: CodePointer; aCallConv: TCallConv; aValues: TValueArray; aReturnType: PTypeInfo; constref aResult: AnsiString);
  30. procedure DoStaticInvokeTestUnicodeStringCompare(const aTestName: String; aAddress: CodePointer; aCallConv: TCallConv; aValues: TValueArray; aReturnType: PTypeInfo; constref aResult: UnicodeString);
  31. procedure DoIntfInvoke(aIndex: SizeInt; aInputArgs, aOutputArgs: TValueArray; aResult: TValue);
  32. procedure DoMethodInvoke(aInst: TObject; aMethod: TMethod; aTypeInfo: PTypeInfo; aIndex: SizeInt; aInputArgs, aOutputArgs: TValueArray; aResult: TValue);
  33. procedure DoProcVarInvoke(aInst: TObject; aProc: CodePointer; aTypeInfo: PTypeInfo; aIndex: SizeInt; aInputArgs, aOutputArgs: TValueArray; aResult: TValue);
  34. {$ifndef InLazIDE}
  35. {$ifdef fpc}generic{$endif} procedure GenDoMethodInvoke<T>(aInst: TObject; aMethod: T; aIndex: SizeInt; aInputArgs, aOutputArgs: TValueArray; aResult: TValue);
  36. {$ifdef fpc}generic{$endif} procedure GenDoProcvarInvoke<T>(aInst: TObject; aProc: T; aIndex: SizeInt; aInputArgs, aOutputArgs: TValueArray; aResult: TValue);
  37. {$ifdef fpc}generic{$endif} function GetRecValue<T>(aReverse: Boolean): TValue;
  38. {$endif}
  39. {$ifdef fpc}
  40. procedure Status(const aMsg: String);
  41. {$endif}
  42. published
  43. procedure TestShortString;
  44. procedure TestAnsiString;
  45. procedure TestWideString;
  46. procedure TestUnicodeString;
  47. procedure TestLongInt;
  48. procedure TestInt64;
  49. procedure TestTObject;
  50. procedure TestIntfMethods;
  51. procedure TestIntfMethodsRecs;
  52. procedure TestMethodVars;
  53. procedure TestMethodVarsRecs;
  54. procedure TestProcVars;
  55. procedure TestProcVarsRecs;
  56. end;
  57. {$ifndef fpc}
  58. TValueHelper = record helper for TValue
  59. function AsUnicodeString: UnicodeString;
  60. function AsAnsiString: AnsiString;
  61. end;
  62. {$endif}
  63. implementation
  64. {$ifndef fpc}
  65. function TValueHelper.AsUnicodeString: UnicodeString;
  66. begin
  67. Result := UnicodeString(AsString);
  68. end;
  69. function TValueHelper.AsAnsiString: AnsiString;
  70. begin
  71. Result := AnsiString(AsString);
  72. end;
  73. {$endif}
  74. function TTestInvoke.EqualValues(aValue1, aValue2: TValue): Boolean;
  75. var
  76. td1, td2: PTypeData;
  77. i: SizeInt;
  78. begin
  79. {$ifdef debug}
  80. Writeln('Empty: ', aValue1.IsEmpty, ' ', aValue2.IsEmpty);
  81. Writeln('Kind: ', aValue1.Kind, ' ', aValue2.Kind);
  82. Writeln('Array: ', aValue1.IsArray, ' ', aValue2.IsArray);
  83. {$endif}
  84. if aValue1.IsEmpty and aValue2.IsEmpty then
  85. Result := True
  86. else if aValue1.IsEmpty and not aValue2.IsEmpty then
  87. Result := False
  88. else if not aValue1.IsEmpty and aValue2.IsEmpty then
  89. Result := False
  90. else if aValue1.IsArray and aValue2.IsArray then begin
  91. if aValue1.GetArrayLength = aValue2.GetArrayLength then begin
  92. Result := True;
  93. for i := 0 to aValue1.GetArrayLength - 1 do
  94. if not EqualValues(aValue1.GetArrayElement(i), aValue2.GetArrayElement(i)) then begin
  95. Writeln('Element ', i, ' differs: ', HexStr(aValue1.GetArrayElement(i).AsOrdinal, 4), ' ', HexStr(aValue2.GetArrayElement(i).AsOrdinal, 4));
  96. Result := False;
  97. Break;
  98. end;
  99. end else
  100. Result := False;
  101. end else if aValue1.Kind = aValue2.Kind then begin
  102. td1 := aValue1.TypeData;
  103. td2 := aValue2.TypeData;
  104. case aValue1.Kind of
  105. tkBool:
  106. Result := aValue1.AsBoolean xor not aValue2.AsBoolean;
  107. tkSet:
  108. if td1^.SetSize = td2^.SetSize then
  109. if td1^.SetSize < SizeOf(SizeInt) then
  110. Result := aValue1.AsOrdinal = aValue2.AsOrdinal
  111. else
  112. Result := CompareMem(aValue1.GetReferenceToRawData, aValue2.GetReferenceToRawData, td1^.SetSize)
  113. else
  114. Result := False;
  115. tkEnumeration,
  116. tkChar,
  117. tkWChar,
  118. tkUChar,
  119. tkInt64,
  120. tkInteger:
  121. Result := aValue1.AsOrdinal = aValue2.AsOrdinal;
  122. tkQWord:
  123. Result := aValue1.AsUInt64 = aValue2.AsUInt64;
  124. tkFloat:
  125. if td1^.FloatType <> td2^.FloatType then
  126. Result := False
  127. else begin
  128. case td1^.FloatType of
  129. ftSingle,
  130. ftDouble,
  131. ftExtended:
  132. Result := aValue1.AsExtended = aValue2.AsExtended;
  133. ftComp:
  134. Result := aValue1.AsInt64 = aValue2.AsInt64;
  135. ftCurr:
  136. Result := aValue1.AsCurrency = aValue2.AsCurrency;
  137. end;
  138. end;
  139. tkSString,
  140. tkUString,
  141. tkAString,
  142. tkWString:
  143. Result := aValue1.AsString = aValue2.AsString;
  144. tkDynArray,
  145. tkArray:
  146. if aValue1.GetArrayLength = aValue2.GetArrayLength then begin
  147. Result := True;
  148. for i := 0 to aValue1.GetArrayLength - 1 do
  149. if not EqualValues(aValue1.GetArrayElement(i), aValue2.GetArrayElement(i)) then begin
  150. Result := False;
  151. Break;
  152. end;
  153. end else
  154. Result := False;
  155. tkClass,
  156. tkClassRef,
  157. tkInterface,
  158. tkInterfaceRaw,
  159. tkPointer:
  160. Result := PPointer(aValue1.GetReferenceToRawData)^ = PPointer(aValue2.GetReferenceToRawData)^;
  161. tkProcVar:
  162. Result := PCodePointer(aValue1.GetReferenceToRawData)^ = PCodePointer(aValue2.GetReferenceToRawData)^;
  163. tkRecord,
  164. tkObject,
  165. tkMethod,
  166. tkVariant: begin
  167. if aValue1.DataSize = aValue2.DataSize then
  168. Result := CompareMem(aValue1.GetReferenceToRawData, aValue2.GetReferenceToRawData, aValue1.DataSize)
  169. else
  170. Result := False;
  171. end
  172. else
  173. Result := False;
  174. end;
  175. end else
  176. Result := False;
  177. end;
  178. function TTestInvoke.DoInvoke(aCodeAddress: CodePointer; aArgs: TValueArray;
  179. aCallConv: TCallConv; aResultType: PTypeInfo; aFlags: TInvokeFlags; out aValid: Boolean): TValue;
  180. begin
  181. try
  182. Result := Rtti.Invoke(aCodeAddress, aArgs, aCallConv, aResultType, ifStatic in aFlags, ifConstructor in aFlags);
  183. aValid := True;
  184. except
  185. on e: ENotImplemented do begin
  186. Status('Ignoring unimplemented functionality of test');
  187. aValid := False;
  188. end else
  189. raise;
  190. end;
  191. end;
  192. procedure TTestInvoke.DoStaticInvokeTestOrdinalCompare(const aTestName: String; aAddress: CodePointer; aCallConv: TCallConv; aValues: TValueArray; aReturnType: PTypeInfo; aResult: Int64);
  193. var
  194. resval: TValue;
  195. valid: Boolean;
  196. begin
  197. resval := DoInvoke(aAddress, aValues, aCallConv, aReturnType, [ifStatic], valid);
  198. if valid and Assigned(aReturnType) and (resval.AsOrdinal <> aResult) then begin
  199. Fail('Result of test "%s" is unexpected; expected: %s, got: %s', [aTestName, IntToStr(aResult), IntToStr(resval.AsOrdinal)]);
  200. end;
  201. end;
  202. procedure TTestInvoke.DoStaticInvokeTestAnsiStringCompare(
  203. const aTestName: String; aAddress: CodePointer; aCallConv: TCallConv;
  204. aValues: TValueArray; aReturnType: PTypeInfo; constref aResult: AnsiString);
  205. var
  206. resval: TValue;
  207. valid: Boolean;
  208. begin
  209. resval := DoInvoke(aAddress, aValues, aCallConv, aReturnType, [ifStatic], valid);
  210. if valid and Assigned(aReturnType) and (resval.AsAnsiString <> aResult) then begin
  211. Fail('Result of test "%s" is unexpected; expected: "%s", got: "%s"', [aTestName, aResult, resval.AsString]);
  212. end;
  213. end;
  214. procedure TTestInvoke.DoStaticInvokeTestUnicodeStringCompare(
  215. const aTestName: String; aAddress: CodePointer; aCallConv: TCallConv;
  216. aValues: TValueArray; aReturnType: PTypeInfo; constref aResult: UnicodeString
  217. );
  218. var
  219. resval: TValue;
  220. valid: Boolean;
  221. begin
  222. resval := DoInvoke(aAddress, aValues, aCallConv, aReturnType, [ifStatic], valid);
  223. if valid and Assigned(aReturnType) and (resval.AsUnicodeString <> aResult) then begin
  224. Fail('Result of test "%s" is unexpected; expected: "%s", got: "%s"', [aTestName, aResult, resval.AsString]);
  225. end;
  226. end;
  227. {$ifdef fpc}
  228. procedure TTestInvoke.Status(const aMsg: String);
  229. begin
  230. {$ifdef debug}
  231. Writeln(aMsg);
  232. {$endif}
  233. end;
  234. {$endif}
  235. function TestShortStringRegister(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6: ShortString): ShortString; register;
  236. begin
  237. Result := aArg1 + aArg2 + aArg3 + aArg4 + aArg5 + aArg6;
  238. end;
  239. function TestShortStringCdecl(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6: ShortString): ShortString; cdecl;
  240. begin
  241. Result := aArg1 + aArg2 + aArg3 + aArg4 + aArg5 + aArg6;
  242. end;
  243. function TestShortStringStdCall(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6: ShortString): ShortString; stdcall;
  244. begin
  245. Result := aArg1 + aArg2 + aArg3 + aArg4 + aArg5 + aArg6;
  246. end;
  247. function TestShortStringPascal(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6: ShortString): ShortString; pascal;
  248. begin
  249. Result := aArg1 + aArg2 + aArg3 + aArg4 + aArg5 + aArg6;
  250. end;
  251. procedure TTestInvoke.TestShortString;
  252. const
  253. strs: array[0..5] of ShortString = (
  254. 'This ',
  255. 'is a ',
  256. 'test ',
  257. 'of ',
  258. 'shortstring ',
  259. 'concatenation'
  260. );
  261. var
  262. values: TValueArray;
  263. resstr: ShortString;
  264. i: LongInt;
  265. begin
  266. SetLength(values, Length(strs));
  267. resstr := '';
  268. for i := Low(values) to High(values) do begin
  269. TValue.Make(@strs[i], TypeInfo(ShortString), values[i]);
  270. resstr := resstr + strs[i];
  271. end;
  272. DoStaticInvokeTestAnsiStringCompare('ShortString Register', @TestShortStringRegister, ccReg, values, TypeInfo(ShortString), resstr);
  273. DoStaticInvokeTestAnsiStringCompare('ShortString Cdecl', @TestShortStringCdecl, ccCdecl, values, TypeInfo(ShortString), resstr);
  274. DoStaticInvokeTestAnsiStringCompare('ShortString StdCall', @TestShortStringStdCall, ccStdCall, values, TypeInfo(ShortString), resstr);
  275. DoStaticInvokeTestAnsiStringCompare('ShortString Pascal', @TestShortStringPascal, ccPascal, values, TypeInfo(ShortString), resstr);
  276. end;
  277. function TestAnsiStringRegister(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6: AnsiString): AnsiString; register;
  278. begin
  279. Result := aArg1 + aArg2 + aArg3 + aArg4 + aArg5 + aArg6;
  280. end;
  281. function TestAnsiStringCdecl(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6: AnsiString): AnsiString; cdecl;
  282. begin
  283. Result := aArg1 + aArg2 + aArg3 + aArg4 + aArg5 + aArg6;
  284. end;
  285. function TestAnsiStringStdCall(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6: AnsiString): AnsiString; stdcall;
  286. begin
  287. Result := aArg1 + aArg2 + aArg3 + aArg4 + aArg5 + aArg6;
  288. end;
  289. function TestAnsiStringPascal(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6: AnsiString): AnsiString; pascal;
  290. begin
  291. Result := aArg1 + aArg2 + aArg3 + aArg4 + aArg5 + aArg6;
  292. end;
  293. procedure TTestInvoke.TestAnsiString;
  294. const
  295. strs: array[0..5] of AnsiString = (
  296. 'This ',
  297. 'is a ',
  298. 'test ',
  299. 'of ',
  300. 'AnsiString ',
  301. 'concatenation'
  302. );
  303. var
  304. values: TValueArray;
  305. resstr: AnsiString;
  306. i: LongInt;
  307. begin
  308. SetLength(values, Length(strs));
  309. resstr := '';
  310. for i := Low(values) to High(values) do begin
  311. TValue.Make(@strs[i], TypeInfo(AnsiString), values[i]);
  312. resstr := resstr + strs[i];
  313. end;
  314. DoStaticInvokeTestAnsiStringCompare('AnsiString Register', @TestAnsiStringRegister, ccReg, values, TypeInfo(AnsiString), resstr);
  315. DoStaticInvokeTestAnsiStringCompare('AnsiString Cdecl', @TestAnsiStringCdecl, ccCdecl, values, TypeInfo(AnsiString), resstr);
  316. DoStaticInvokeTestAnsiStringCompare('AnsiString StdCall', @TestAnsiStringStdCall, ccStdCall, values, TypeInfo(AnsiString), resstr);
  317. DoStaticInvokeTestAnsiStringCompare('AnsiString Pascal', @TestAnsiStringPascal, ccPascal, values, TypeInfo(AnsiString), resstr);
  318. end;
  319. function TestWideStringRegister(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6: WideString): WideString; register;
  320. begin
  321. Result := aArg1 + aArg2 + aArg3 + aArg4 + aArg5 + aArg6;
  322. end;
  323. function TestWideStringCdecl(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6: WideString): WideString; cdecl;
  324. begin
  325. Result := aArg1 + aArg2 + aArg3 + aArg4 + aArg5 + aArg6;
  326. end;
  327. function TestWideStringStdCall(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6: WideString): WideString; stdcall;
  328. begin
  329. Result := aArg1 + aArg2 + aArg3 + aArg4 + aArg5 + aArg6;
  330. end;
  331. function TestWideStringPascal(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6: WideString): WideString; pascal;
  332. begin
  333. Result := aArg1 + aArg2 + aArg3 + aArg4 + aArg5 + aArg6;
  334. end;
  335. procedure TTestInvoke.TestWideString;
  336. const
  337. strs: array[0..5] of WideString = (
  338. 'This ',
  339. 'is a ',
  340. 'test ',
  341. 'of ',
  342. 'WideString ',
  343. 'concatenation'
  344. );
  345. var
  346. values: TValueArray;
  347. resstr: WideString;
  348. i: LongInt;
  349. begin
  350. SetLength(values, Length(strs));
  351. resstr := '';
  352. for i := Low(values) to High(values) do begin
  353. TValue.Make(@strs[i], TypeInfo(WideString), values[i]);
  354. resstr := resstr + strs[i];
  355. end;
  356. DoStaticInvokeTestUnicodeStringCompare('WideString Register', @TestWideStringRegister, ccReg, values, TypeInfo(WideString), resstr);
  357. DoStaticInvokeTestUnicodeStringCompare('WideString Cdecl', @TestWideStringCdecl, ccCdecl, values, TypeInfo(WideString), resstr);
  358. DoStaticInvokeTestUnicodeStringCompare('WideString StdCall', @TestWideStringStdCall, ccStdCall, values, TypeInfo(WideString), resstr);
  359. DoStaticInvokeTestUnicodeStringCompare('WideString Pascal', @TestWideStringPascal, ccPascal, values, TypeInfo(WideString), resstr);
  360. end;
  361. function TestUnicodeStringRegister(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6: UnicodeString): UnicodeString; register;
  362. begin
  363. Result := aArg1 + aArg2 + aArg3 + aArg4 + aArg5 + aArg6;
  364. end;
  365. function TestUnicodeStringCdecl(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6: UnicodeString): UnicodeString; cdecl;
  366. begin
  367. Result := aArg1 + aArg2 + aArg3 + aArg4 + aArg5 + aArg6;
  368. end;
  369. function TestUnicodeStringStdCall(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6: UnicodeString): UnicodeString; stdcall;
  370. begin
  371. Result := aArg1 + aArg2 + aArg3 + aArg4 + aArg5 + aArg6;
  372. end;
  373. function TestUnicodeStringPascal(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6: UnicodeString): UnicodeString; pascal;
  374. begin
  375. Result := aArg1 + aArg2 + aArg3 + aArg4 + aArg5 + aArg6;
  376. end;
  377. procedure TTestInvoke.TestUnicodeString;
  378. const
  379. strs: array[0..5] of UnicodeString = (
  380. 'This ',
  381. 'is a ',
  382. 'test ',
  383. 'of ',
  384. 'UnicodeString ',
  385. 'concatenation'
  386. );
  387. var
  388. values: TValueArray;
  389. resstr: UnicodeString;
  390. i: LongInt;
  391. begin
  392. SetLength(values, Length(strs));
  393. resstr := '';
  394. for i := Low(values) to High(values) do begin
  395. TValue.Make(@strs[i], TypeInfo(UnicodeString), values[i]);
  396. resstr := resstr + strs[i];
  397. end;
  398. DoStaticInvokeTestUnicodeStringCompare('UnicodeString Register', @TestUnicodeStringRegister, ccReg, values, TypeInfo(UnicodeString), resstr);
  399. DoStaticInvokeTestUnicodeStringCompare('UnicodeString Cdecl', @TestUnicodeStringCdecl, ccCdecl, values, TypeInfo(UnicodeString), resstr);
  400. DoStaticInvokeTestUnicodeStringCompare('UnicodeString StdCall', @TestUnicodeStringStdCall, ccStdCall, values, TypeInfo(UnicodeString), resstr);
  401. DoStaticInvokeTestUnicodeStringCompare('UnicodeString Pascal', @TestUnicodeStringPascal, ccPascal, values, TypeInfo(UnicodeString), resstr);
  402. end;
  403. function TestLongIntRegister(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6: LongInt): LongInt; register;
  404. begin
  405. Result := aArg1 + aArg2 * 10 + aArg3 * 100 + aArg4 * 1000 + aArg5 * 10000 + aArg6 * 100000;
  406. end;
  407. function TestLongIntCdecl(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6: LongInt): LongInt; cdecl;
  408. begin
  409. Result := aArg1 + aArg2 * 10 + aArg3 * 100 + aArg4 * 1000 + aArg5 * 10000 + aArg6 * 100000;
  410. end;
  411. function TestLongIntStdCall(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6: LongInt): LongInt; stdcall;
  412. begin
  413. Result := aArg1 + aArg2 * 10 + aArg3 * 100 + aArg4 * 1000 + aArg5 * 10000 + aArg6 * 100000;
  414. end;
  415. function TestLongIntPascal(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6: LongInt): LongInt; pascal;
  416. begin
  417. Result := aArg1 + aArg2 * 10 + aArg3 * 100 + aArg4 * 1000 + aArg5 * 10000 + aArg6 * 100000;
  418. end;
  419. procedure TTestInvoke.TestLongInt;
  420. const
  421. vals: array[0..5] of LongInt = (
  422. 8,
  423. 4,
  424. 7,
  425. 3,
  426. 6,
  427. 1
  428. );
  429. var
  430. values: TValueArray;
  431. resval, factor: LongInt;
  432. i: LongInt;
  433. begin
  434. SetLength(values, Length(vals));
  435. resval := 0;
  436. factor := 1;
  437. for i := Low(values) to High(values) do begin
  438. TValue.Make(@vals[i], TypeInfo(LongInt), values[i]);
  439. resval := resval + vals[i] * factor;
  440. factor := factor * 10;
  441. end;
  442. DoStaticInvokeTestOrdinalCompare('LongInt Register', @TestLongIntRegister, ccReg, values, TypeInfo(LongInt), resval);
  443. DoStaticInvokeTestOrdinalCompare('LongInt Cdecl', @TestLongIntCdecl, ccCdecl, values, TypeInfo(LongInt), resval);
  444. DoStaticInvokeTestOrdinalCompare('LongInt StdCall', @TestLongIntStdCall, ccStdCall, values, TypeInfo(LongInt), resval);
  445. DoStaticInvokeTestOrdinalCompare('LongInt Pascal', @TestLongIntPascal, ccPascal, values, TypeInfo(LongInt), resval);
  446. end;
  447. function TestInt64Register(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6: Int64): Int64; register;
  448. begin
  449. Result := aArg1 + aArg2 * 100 + aArg3 * 10000 + aArg4 * 1000000 + aArg5 * 100000000 + aArg6 * 10000000000;
  450. end;
  451. function TestInt64Cdecl(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6: Int64): Int64; cdecl;
  452. begin
  453. Result := aArg1 + aArg2 * 100 + aArg3 * 10000 + aArg4 * 1000000 + aArg5 * 100000000 + aArg6 * 10000000000;
  454. end;
  455. function TestInt64StdCall(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6: Int64): Int64; stdcall;
  456. begin
  457. Result := aArg1 + aArg2 * 100 + aArg3 * 10000 + aArg4 * 1000000 + aArg5 * 100000000 + aArg6 * 10000000000;
  458. end;
  459. function TestInt64Pascal(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6: Int64): Int64; pascal;
  460. begin
  461. Result := aArg1 + aArg2 * 100 + aArg3 * 10000 + aArg4 * 1000000 + aArg5 * 100000000 + aArg6 * 10000000000;
  462. end;
  463. procedure TTestInvoke.TestInt64;
  464. const
  465. vals: array[0..5] of Int64 = (
  466. 8,
  467. 4,
  468. 7,
  469. 3,
  470. 6,
  471. 1
  472. );
  473. var
  474. values: TValueArray;
  475. resval, factor: Int64;
  476. i: LongInt;
  477. begin
  478. SetLength(values, Length(vals));
  479. resval := 0;
  480. factor := 1;
  481. for i := Low(values) to High(values) do begin
  482. TValue.Make(@vals[i], TypeInfo(Int64), values[i]);
  483. resval := resval + vals[i] * factor;
  484. factor := factor * 100;
  485. end;
  486. DoStaticInvokeTestOrdinalCompare('Int64 Register', @TestInt64Register, ccReg, values, TypeInfo(Int64), resval);
  487. DoStaticInvokeTestOrdinalCompare('Int64 Cdecl', @TestInt64Cdecl, ccCdecl, values, TypeInfo(Int64), resval);
  488. DoStaticInvokeTestOrdinalCompare('Int64 StdCall', @TestInt64StdCall, ccStdCall, values, TypeInfo(Int64), resval);
  489. DoStaticInvokeTestOrdinalCompare('Int64 Pascal', @TestInt64Pascal, ccPascal, values, TypeInfo(Int64), resval);
  490. end;
  491. type
  492. TTestClass = class
  493. fString: String;
  494. fValue: LongInt;
  495. end;
  496. function TestTTestClassRegister(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6: TTestClass): TTestClass; register;
  497. begin
  498. Result := TTestClass.Create;
  499. Result.fString := aArg1.fString + aArg2.fString + aArg3.fString + aArg4.fString + aArg5.fString + aArg6.fString;
  500. Result.fValue := aArg1.fValue + aArg2.fValue * 10 + aArg3.fValue * 100 + aArg4.fValue * 1000 + aArg5.fValue * 10000 + aArg6.fValue * 100000;
  501. end;
  502. function TestTTestClassCdecl(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6: TTestClass): TTestClass; cdecl;
  503. begin
  504. Result := TTestClass.Create;
  505. Result.fString := aArg1.fString + aArg2.fString + aArg3.fString + aArg4.fString + aArg5.fString + aArg6.fString;
  506. Result.fValue := aArg1.fValue + aArg2.fValue * 10 + aArg3.fValue * 100 + aArg4.fValue * 1000 + aArg5.fValue * 10000 + aArg6.fValue * 100000;
  507. end;
  508. function TestTTestClassStdCall(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6: TTestClass): TTestClass; stdcall;
  509. begin
  510. Result := TTestClass.Create;
  511. Result.fString := aArg1.fString + aArg2.fString + aArg3.fString + aArg4.fString + aArg5.fString + aArg6.fString;
  512. Result.fValue := aArg1.fValue + aArg2.fValue * 10 + aArg3.fValue * 100 + aArg4.fValue * 1000 + aArg5.fValue * 10000 + aArg6.fValue * 100000;
  513. end;
  514. function TestTTestClassPascal(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6: TTestClass): TTestClass; pascal;
  515. begin
  516. Result := TTestClass.Create;
  517. Result.fString := aArg1.fString + aArg2.fString + aArg3.fString + aArg4.fString + aArg5.fString + aArg6.fString;
  518. Result.fValue := aArg1.fValue + aArg2.fValue * 10 + aArg3.fValue * 100 + aArg4.fValue * 1000 + aArg5.fValue * 10000 + aArg6.fValue * 100000;
  519. end;
  520. procedure TTestInvoke.TestTObject;
  521. procedure DoStaticInvokeTestClassCompare(
  522. const aTestName: String; aAddress: CodePointer; aCallConv: TCallConv;
  523. aValues: TValueArray; aReturnType: PTypeInfo; aResult: TTestClass
  524. );
  525. var
  526. resval: TValue;
  527. rescls: TTestClass;
  528. valid: Boolean;
  529. begin
  530. resval := DoInvoke(aAddress, aValues, aCallConv, aReturnType, [ifStatic], valid);
  531. if valid and Assigned(aReturnType) then begin
  532. rescls := TTestClass(PPointer(resval.GetReferenceToRawData)^);
  533. if (rescls.fString <> aResult.fString) or (rescls.fValue <> aResult.fValue) then
  534. Fail('Result of test "%s" is unexpected; expected: "%s"/%s, got: "%s"/%s', [aTestName, aResult.fString, IntToStr(aResult.fValue), rescls.fString, IntToStr(rescls.fValue)]);
  535. end;
  536. end;
  537. const
  538. strs: array[0..5] of AnsiString = (
  539. 'This ',
  540. 'is a ',
  541. 'test ',
  542. 'of ',
  543. 'AnsiString ',
  544. 'concatenation'
  545. );
  546. vals: array[0..5] of Int64 = (
  547. 8,
  548. 4,
  549. 7,
  550. 3,
  551. 6,
  552. 1
  553. );
  554. var
  555. values: TValueArray;
  556. t, rescls: TTestClass;
  557. i, factor: LongInt;
  558. begin
  559. SetLength(values, Length(vals));
  560. factor := 1;
  561. rescls := TTestClass.Create;
  562. for i := Low(values) to High(values) do begin
  563. t := TTestClass.Create;
  564. t.fString := strs[i];
  565. t.fValue := vals[i];
  566. TValue.Make(@t, TypeInfo(TTestClass), values[i]);
  567. rescls.fValue := rescls.fValue + vals[i] * factor;
  568. rescls.fString := rescls.fString + strs[i];
  569. factor := factor * 10;
  570. end;
  571. DoStaticInvokeTestClassCompare('TTestClass Register', @TestTTestClassRegister, ccReg, values, TypeInfo(TTestClass), rescls);
  572. DoStaticInvokeTestClassCompare('TTestClass Cdecl', @TestTTestClassCdecl, ccCdecl, values, TypeInfo(TTestClass), rescls);
  573. DoStaticInvokeTestClassCompare('TTestClass StdCall', @TestTTestClassStdCall, ccStdCall, values, TypeInfo(TTestClass), rescls);
  574. DoStaticInvokeTestClassCompare('TTestClass Pascal', @TestTTestClassPascal, ccPascal, values, TypeInfo(TTestClass), rescls);
  575. end;
  576. const
  577. SingleArg1: Single = 1.23;
  578. SingleArg2In: Single = 3.21;
  579. SingleArg2Out: Single = 2.34;
  580. SingleArg3Out: Single = 9.87;
  581. SingleArg4: Single = 7.89;
  582. SingleRes: Single = 4.32;
  583. DoubleArg1: Double = 1.23;
  584. DoubleArg2In: Double = 3.21;
  585. DoubleArg2Out: Double = 2.34;
  586. DoubleArg3Out: Double = 9.87;
  587. DoubleArg4: Double = 7.89;
  588. DoubleRes: Double = 4.32;
  589. ExtendedArg1: Extended = 1.23;
  590. ExtendedArg2In: Extended = 3.21;
  591. ExtendedArg2Out: Extended = 2.34;
  592. ExtendedArg3Out: Extended = 9.87;
  593. ExtendedArg4: Extended = 7.89;
  594. ExtendedRes: Extended = 4.32;
  595. CurrencyArg1: Currency = 1.23;
  596. CurrencyArg2In: Currency = 3.21;
  597. CurrencyArg2Out: Currency = 2.34;
  598. CurrencyArg3Out: Currency = 9.87;
  599. CurrencyArg4: Currency = 7.89;
  600. CurrencyRes: Currency = 4.32;
  601. CompArg1: Comp = 123;
  602. CompArg2In: Comp = 321;
  603. CompArg2Out: Comp = 234;
  604. CompArg3Out: Comp = 987;
  605. CompArg4: Comp = 789;
  606. CompRes: Comp = 432;
  607. type
  608. TTestRecord1 = packed record
  609. b: array[0..0] of Byte;
  610. end;
  611. TTestRecord2 = packed record
  612. b: array[0..1] of Byte;
  613. end;
  614. TTestRecord3 = packed record
  615. b: array[0..2] of Byte;
  616. end;
  617. TTestRecord4 = packed record
  618. b: array[0..3] of Byte;
  619. end;
  620. TTestRecord5 = packed record
  621. b: array[0..4] of Byte;
  622. end;
  623. TTestRecord6 = packed record
  624. b: array[0..5] of Byte;
  625. end;
  626. TTestRecord7 = packed record
  627. b: array[0..6] of Byte;
  628. end;
  629. TTestRecord8 = packed record
  630. b: array[0..7] of Byte;
  631. end;
  632. TTestRecord9 = packed record
  633. b: array[0..8] of Byte;
  634. end;
  635. TTestRecord10 = packed record
  636. b: array[0..9] of Byte;
  637. end;
  638. {$M+}
  639. ITestInterface = interface
  640. procedure Test1;
  641. function Test2: SizeInt;
  642. function Test3(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: SizeInt): SizeInt;
  643. procedure Test4(aArg1: AnsiString; aArg2: UnicodeString; aArg3: WideString; aArg4: ShortString);
  644. function Test5: AnsiString;
  645. function Test6: UnicodeString;
  646. function Test7: WideString;
  647. function Test8: ShortString;
  648. procedure Test9(aArg1: SizeInt; var aArg2: SizeInt; out aArg3: SizeInt; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: SizeInt);
  649. procedure Test10(aArg1: AnsiString; var aArg2: AnsiString; out aArg3: AnsiString; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: AnsiString);
  650. procedure Test11(aArg1: ShortString; var aArg2: ShortString; out aArg3: ShortString; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: ShortString);
  651. 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);
  652. function Test13(aArg1: Single; var aArg2: Single; out aArg3: Single; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Single): Single;
  653. function Test14(aArg1: Double; var aArg2: Double; out aArg3: Double; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Double): Double;
  654. function Test15(aArg1: Extended; var aArg2: Extended; out aArg3: Extended; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Extended): Extended;
  655. function Test16(aArg1: Comp; var aArg2: Comp; out aArg3: Comp; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Comp): Comp;
  656. function Test17(aArg1: Currency; var aArg2: Currency; out aArg3: Currency; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Currency): Currency;
  657. function TestRecSize1(aArg1: TTestRecord1): TTestRecord1;
  658. function TestRecSize2(aArg1: TTestRecord2): TTestRecord2;
  659. function TestRecSize3(aArg1: TTestRecord3): TTestRecord3;
  660. function TestRecSize4(aArg1: TTestRecord4): TTestRecord4;
  661. function TestRecSize5(aArg1: TTestRecord5): TTestRecord5;
  662. function TestRecSize6(aArg1: TTestRecord6): TTestRecord6;
  663. function TestRecSize7(aArg1: TTestRecord7): TTestRecord7;
  664. function TestRecSize8(aArg1: TTestRecord8): TTestRecord8;
  665. function TestRecSize9(aArg1: TTestRecord9): TTestRecord9;
  666. function TestRecSize10(aArg1: TTestRecord10): TTestRecord10;
  667. end;
  668. {$M-}
  669. TTestInterfaceClass = class(TInterfacedObject, ITestInterface)
  670. private
  671. procedure Test1;
  672. function Test2: SizeInt;
  673. function Test3(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: SizeInt): SizeInt;
  674. procedure Test4(aArg1: AnsiString; aArg2: UnicodeString; aArg3: WideString; aArg4: ShortString);
  675. function Test5: AnsiString;
  676. function Test6: UnicodeString;
  677. function Test7: WideString;
  678. function Test8: ShortString;
  679. procedure Test9(aArg1: SizeInt; var aArg2: SizeInt; out aArg3: SizeInt; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: SizeInt);
  680. procedure Test10(aArg1: AnsiString; var aArg2: AnsiString; out aArg3: AnsiString; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: AnsiString);
  681. procedure Test11(aArg1: ShortString; var aArg2: ShortString; out aArg3: ShortString; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: ShortString);
  682. 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);
  683. function Test13(aArg1: Single; var aArg2: Single; out aArg3: Single; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Single): Single;
  684. function Test14(aArg1: Double; var aArg2: Double; out aArg3: Double; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Double): Double;
  685. function Test15(aArg1: Extended; var aArg2: Extended; out aArg3: Extended; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Extended): Extended;
  686. function Test16(aArg1: Comp; var aArg2: Comp; out aArg3: Comp; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Comp): Comp;
  687. function Test17(aArg1: Currency; var aArg2: Currency; out aArg3: Currency; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Currency): Currency;
  688. function TestRecSize1(aArg1: TTestRecord1): TTestRecord1;
  689. function TestRecSize2(aArg1: TTestRecord2): TTestRecord2;
  690. function TestRecSize3(aArg1: TTestRecord3): TTestRecord3;
  691. function TestRecSize4(aArg1: TTestRecord4): TTestRecord4;
  692. function TestRecSize5(aArg1: TTestRecord5): TTestRecord5;
  693. function TestRecSize6(aArg1: TTestRecord6): TTestRecord6;
  694. function TestRecSize7(aArg1: TTestRecord7): TTestRecord7;
  695. function TestRecSize8(aArg1: TTestRecord8): TTestRecord8;
  696. function TestRecSize9(aArg1: TTestRecord9): TTestRecord9;
  697. function TestRecSize10(aArg1: TTestRecord10): TTestRecord10;
  698. public
  699. InputArgs: array of TValue;
  700. OutputArgs: array of TValue;
  701. ResultValue: TValue;
  702. CalledMethod: SizeInt;
  703. InOutMapping: array of SizeInt;
  704. procedure Reset;
  705. public class var
  706. ProcVarInst: TTestInterfaceClass;
  707. ProcVarRecInst: TTestInterfaceClass;
  708. public const
  709. RecSizeMarker = SizeInt($80000000);
  710. end;
  711. TMethodTest1 = procedure of object;
  712. TMethodTest2 = function: SizeInt of object;
  713. TMethodTest3 = function(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: SizeInt): SizeInt of object;
  714. TMethodTest4 = procedure(aArg1: AnsiString; aArg2: UnicodeString; aArg3: WideString; aArg4: ShortString) of object;
  715. TMethodTest5 = function: AnsiString of object;
  716. TMethodTest6 = function: UnicodeString of object;
  717. TMethodTest7 = function: WideString of object;
  718. TMethodTest8 = function: ShortString of object;
  719. TMethodTest9 = procedure(aArg1: SizeInt; var aArg2: SizeInt; out aArg3: SizeInt; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: SizeInt) of object;
  720. TMethodTest10 = procedure(aArg1: AnsiString; var aArg2: AnsiString; out aArg3: AnsiString; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: AnsiString) of object;
  721. TMethodTest11 = procedure(aArg1: ShortString; var aArg2: ShortString; out aArg3: ShortString; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: ShortString) of object;
  722. 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;
  723. TMethodTest13 = function(aArg1: Single; var aArg2: Single; out aArg3: Single; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Single): Single of object;
  724. TMethodTest14 = function(aArg1: Double; var aArg2: Double; out aArg3: Double; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Double): Double of object;
  725. TMethodTest15 = function(aArg1: Extended; var aArg2: Extended; out aArg3: Extended; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Extended): Extended of object;
  726. TMethodTest16 = function(aArg1: Comp; var aArg2: Comp; out aArg3: Comp; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Comp): Comp of object;
  727. TMethodTest17 = function(aArg1: Currency; var aArg2: Currency; out aArg3: Currency; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Currency): Currency of object;
  728. TMethodTestRecSize1 = function(aArg1: TTestRecord1): TTestRecord1 of object;
  729. TMethodTestRecSize2 = function(aArg1: TTestRecord2): TTestRecord2 of object;
  730. TMethodTestRecSize3 = function(aArg1: TTestRecord3): TTestRecord3 of object;
  731. TMethodTestRecSize4 = function(aArg1: TTestRecord4): TTestRecord4 of object;
  732. TMethodTestRecSize5 = function(aArg1: TTestRecord5): TTestRecord5 of object;
  733. TMethodTestRecSize6 = function(aArg1: TTestRecord6): TTestRecord6 of object;
  734. TMethodTestRecSize7 = function(aArg1: TTestRecord7): TTestRecord7 of object;
  735. TMethodTestRecSize8 = function(aArg1: TTestRecord8): TTestRecord8 of object;
  736. TMethodTestRecSize9 = function(aArg1: TTestRecord9): TTestRecord9 of object;
  737. TMethodTestRecSize10 = function(aArg1: TTestRecord10): TTestRecord10 of object;
  738. TProcVarTest1 = procedure;
  739. TProcVarTest2 = function: SizeInt;
  740. TProcVarTest3 = function(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: SizeInt): SizeInt;
  741. TProcVarTest4 = procedure(aArg1: AnsiString; aArg2: UnicodeString; aArg3: WideString; aArg4: ShortString);
  742. TProcVarTest5 = function: AnsiString;
  743. TProcVarTest6 = function: UnicodeString;
  744. TProcVarTest7 = function: WideString;
  745. TProcVarTest8 = function: ShortString;
  746. TProcVarTest9 = procedure(aArg1: SizeInt; var aArg2: SizeInt; out aArg3: SizeInt; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: SizeInt);
  747. TProcVarTest10 = procedure(aArg1: AnsiString; var aArg2: AnsiString; out aArg3: AnsiString; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: AnsiString);
  748. TProcVarTest11 = procedure(aArg1: ShortString; var aArg2: ShortString; out aArg3: ShortString; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: ShortString);
  749. 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);
  750. TProcVarTest13 = function(aArg1: Single; var aArg2: Single; out aArg3: Single; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Single): Single;
  751. TProcVarTest14 = function(aArg1: Double; var aArg2: Double; out aArg3: Double; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Double): Double;
  752. TProcVarTest15 = function(aArg1: Extended; var aArg2: Extended; out aArg3: Extended; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Extended): Extended;
  753. TProcVarTest16 = function(aArg1: Comp; var aArg2: Comp; out aArg3: Comp; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Comp): Comp;
  754. TProcVarTest17 = function(aArg1: Currency; var aArg2: Currency; out aArg3: Currency; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Currency): Currency;
  755. TProcVarTestRecSize1 = function(aArg1: TTestRecord1): TTestRecord1;
  756. TProcVarTestRecSize2 = function(aArg1: TTestRecord2): TTestRecord2;
  757. TProcVarTestRecSize3 = function(aArg1: TTestRecord3): TTestRecord3;
  758. TProcVarTestRecSize4 = function(aArg1: TTestRecord4): TTestRecord4;
  759. TProcVarTestRecSize5 = function(aArg1: TTestRecord5): TTestRecord5;
  760. TProcVarTestRecSize6 = function(aArg1: TTestRecord6): TTestRecord6;
  761. TProcVarTestRecSize7 = function(aArg1: TTestRecord7): TTestRecord7;
  762. TProcVarTestRecSize8 = function(aArg1: TTestRecord8): TTestRecord8;
  763. TProcVarTestRecSize9 = function(aArg1: TTestRecord9): TTestRecord9;
  764. TProcVarTestRecSize10 = function(aArg1: TTestRecord10): TTestRecord10;
  765. procedure TTestInterfaceClass.Test1;
  766. begin
  767. SetLength(InputArgs, 0);
  768. SetLength(OutputArgs, 0);
  769. ResultValue := TValue.Empty;
  770. CalledMethod := 1;
  771. end;
  772. function TTestInterfaceClass.Test2: SizeInt;
  773. begin
  774. SetLength(InputArgs, 0);
  775. SetLength(OutputArgs, 0);
  776. Result := 42;
  777. TValue.Make(@Result, TypeInfo(Result), ResultValue);
  778. CalledMethod := 2;
  779. end;
  780. function TTestInterfaceClass.Test3(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: SizeInt): SizeInt;
  781. begin
  782. SetLength(InputArgs, 10);
  783. TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]);
  784. TValue.Make(@aArg2, TypeInfo(aArg2), InputArgs[1]);
  785. TValue.Make(@aArg3, TypeInfo(aArg3), InputArgs[2]);
  786. TValue.Make(@aArg4, TypeInfo(aArg4), InputArgs[3]);
  787. TValue.Make(@aArg5, TypeInfo(aArg5), InputArgs[4]);
  788. TValue.Make(@aArg6, TypeInfo(aArg6), InputArgs[5]);
  789. TValue.Make(@aArg7, TypeInfo(aArg7), InputArgs[6]);
  790. TValue.Make(@aArg8, TypeInfo(aArg8), InputArgs[7]);
  791. TValue.Make(@aArg9, TypeInfo(aArg9), InputArgs[8]);
  792. TValue.Make(@aArg10, TypeInfo(aArg10), InputArgs[9]);
  793. SetLength(OutputArgs, 0);
  794. Result := 42;
  795. TValue.Make(@Result, TypeInfo(Result), ResultValue);
  796. CalledMethod := 3;
  797. end;
  798. procedure TTestInterfaceClass.Test4(aArg1: AnsiString; aArg2: UnicodeString; aArg3: WideString; aArg4: ShortString);
  799. begin
  800. SetLength(InputArgs, 4);
  801. TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]);
  802. TValue.Make(@aArg2, TypeInfo(aArg2), InputArgs[1]);
  803. TValue.Make(@aArg3, TypeInfo(aArg3), InputArgs[2]);
  804. TValue.Make(@aArg4, TypeInfo(aArg4), InputArgs[3]);
  805. SetLength(OutputArgs, 0);
  806. ResultValue := TValue.Empty;
  807. CalledMethod := 4;
  808. end;
  809. function TTestInterfaceClass.Test5: AnsiString;
  810. begin
  811. SetLength(InputArgs, 0);
  812. SetLength(OutputArgs, 0);
  813. Result := 'Hello World';
  814. TValue.Make(@Result, TypeInfo(Result), ResultValue);
  815. CalledMethod := 5;
  816. end;
  817. function TTestInterfaceClass.Test6: UnicodeString;
  818. begin
  819. SetLength(InputArgs, 0);
  820. SetLength(OutputArgs, 0);
  821. Result := 'Hello World';
  822. TValue.Make(@Result, TypeInfo(Result), ResultValue);
  823. CalledMethod := 6;
  824. end;
  825. function TTestInterfaceClass.Test7: WideString;
  826. begin
  827. SetLength(InputArgs, 0);
  828. SetLength(OutputArgs, 0);
  829. Result := 'Hello World';
  830. TValue.Make(@Result, TypeInfo(Result), ResultValue);
  831. CalledMethod := 7;
  832. end;
  833. function TTestInterfaceClass.Test8: ShortString;
  834. begin
  835. SetLength(InputArgs, 0);
  836. SetLength(OutputArgs, 0);
  837. Result := 'Hello World';
  838. TValue.Make(@Result, TypeInfo(Result), ResultValue);
  839. CalledMethod := 8;
  840. end;
  841. procedure TTestInterfaceClass.Test9(aArg1: SizeInt; var aArg2: SizeInt; out aArg3: SizeInt; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: SizeInt);
  842. begin
  843. SetLength(InputArgs, 4);
  844. TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]);
  845. TValue.Make(@aArg2, TypeInfo(aArg2), InputArgs[1]);
  846. TValue.Make(@aArg3, TypeInfo(aArg3), InputArgs[2]);
  847. TValue.Make(@aArg4, TypeInfo(aArg4), InputArgs[3]);
  848. aArg2 := $1234;
  849. aArg3 := $5678;
  850. SetLength(OutputArgs, 2);
  851. TValue.Make(@aArg2, TypeInfo(aArg2), OutputArgs[0]);
  852. TValue.Make(@aArg3, TypeInfo(aArg3), OutputArgs[1]);
  853. SetLength(InOutMapping, 2);
  854. InOutMapping[0] := 1;
  855. InOutMapping[1] := 2;
  856. ResultValue := TValue.Empty;
  857. CalledMethod := 9;
  858. end;
  859. procedure TTestInterfaceClass.Test10(aArg1: AnsiString; var aArg2: AnsiString; out aArg3: AnsiString; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: AnsiString);
  860. begin
  861. SetLength(InputArgs, 4);
  862. TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]);
  863. TValue.Make(@aArg2, TypeInfo(aArg2), InputArgs[1]);
  864. TValue.Make(@aArg3, TypeInfo(aArg3), InputArgs[2]);
  865. TValue.Make(@aArg4, TypeInfo(aArg4), InputArgs[3]);
  866. aArg2 := 'Foo';
  867. aArg3 := 'Bar';
  868. SetLength(OutputArgs, 2);
  869. TValue.Make(@aArg2, TypeInfo(aArg2), OutputArgs[0]);
  870. TValue.Make(@aArg3, TypeInfo(aArg3), OutputArgs[1]);
  871. SetLength(InOutMapping, 2);
  872. InOutMapping[0] := 1;
  873. InOutMapping[1] := 2;
  874. ResultValue := TValue.Empty;
  875. CalledMethod := 10;
  876. end;
  877. procedure TTestInterfaceClass.Test11(aArg1: ShortString; var aArg2: ShortString; out aArg3: ShortString; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: ShortString);
  878. begin
  879. SetLength(InputArgs, 4);
  880. TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]);
  881. TValue.Make(@aArg2, TypeInfo(aArg2), InputArgs[1]);
  882. TValue.Make(@aArg3, TypeInfo(aArg3), InputArgs[2]);
  883. TValue.Make(@aArg4, TypeInfo(aArg4), InputArgs[3]);
  884. aArg2 := 'Foo';
  885. aArg3 := 'Bar';
  886. SetLength(OutputArgs, 2);
  887. TValue.Make(@aArg2, TypeInfo(aArg2), OutputArgs[0]);
  888. TValue.Make(@aArg3, TypeInfo(aArg3), OutputArgs[1]);
  889. SetLength(InOutMapping, 2);
  890. InOutMapping[0] := 1;
  891. InOutMapping[1] := 2;
  892. ResultValue := TValue.Empty;
  893. CalledMethod := 11;
  894. end;
  895. 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);
  896. {$ifdef fpc}
  897. var
  898. i: SizeInt;
  899. start: SizeInt;
  900. {$endif}
  901. begin
  902. {$ifdef fpc}
  903. SetLength(InputArgs, 4);
  904. InputArgs[0] := specialize OpenArrayToDynArrayValue<SizeInt>(aArg1);
  905. InputArgs[1] := specialize OpenArrayToDynArrayValue<SizeInt>(aArg2);
  906. InputArgs[2] := specialize OpenArrayToDynArrayValue<SizeInt>(aArg3);
  907. InputArgs[3] := specialize OpenArrayToDynArrayValue<SizeInt>(aArg4);
  908. SetLength(OutputArgs, 2);
  909. start := $4321;
  910. for i := 0 to High(aArg2) do
  911. aArg2[i] := start + i;
  912. start := $9876;
  913. for i := 0 to High(aArg3) do
  914. aArg3[i] := start + i;
  915. OutputArgs[0] := specialize OpenArrayToDynArrayValue<SizeInt>(aArg2);
  916. OutputArgs[1] := specialize OpenArrayToDynArrayValue<SizeInt>(aArg3);
  917. SetLength(InOutMapping, 2);
  918. InOutMapping[0] := 1;
  919. InOutMapping[1] := 2;
  920. ResultValue := TValue.Empty;
  921. CalledMethod := 12;
  922. {$endif}
  923. end;
  924. function TTestInterfaceClass.Test13(aArg1: Single; var aArg2: Single; out aArg3: Single; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Single): Single;
  925. begin
  926. SetLength(InputArgs, 4);
  927. TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]);
  928. TValue.Make(@aArg2, TypeInfo(aArg2), InputArgs[1]);
  929. TValue.Make(@aArg3, TypeInfo(aArg3), InputArgs[2]);
  930. TValue.Make(@aArg4, TypeInfo(aArg4), InputArgs[3]);
  931. aArg2 := SingleArg2Out;
  932. aArg3 := SingleArg3Out;
  933. SetLength(OutputArgs, 2);
  934. TValue.Make(@aArg2, TypeInfo(aArg2), OutputArgs[0]);
  935. TValue.Make(@aArg3, TypeInfo(aArg3), OutputArgs[1]);
  936. SetLength(InOutMapping, 2);
  937. InOutMapping[0] := 1;
  938. InOutMapping[1] := 2;
  939. Result := SingleRes;
  940. TValue.Make(@Result, TypeInfo(Result), ResultValue);
  941. CalledMethod := 13;
  942. end;
  943. function TTestInterfaceClass.Test14(aArg1: Double; var aArg2: Double; out aArg3: Double; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Double): Double;
  944. begin
  945. SetLength(InputArgs, 4);
  946. TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]);
  947. TValue.Make(@aArg2, TypeInfo(aArg2), InputArgs[1]);
  948. TValue.Make(@aArg3, TypeInfo(aArg3), InputArgs[2]);
  949. TValue.Make(@aArg4, TypeInfo(aArg4), InputArgs[3]);
  950. aArg2 := DoubleArg2Out;
  951. aArg3 := DoubleArg3Out;
  952. SetLength(OutputArgs, 2);
  953. TValue.Make(@aArg2, TypeInfo(aArg2), OutputArgs[0]);
  954. TValue.Make(@aArg3, TypeInfo(aArg3), OutputArgs[1]);
  955. SetLength(InOutMapping, 2);
  956. InOutMapping[0] := 1;
  957. InOutMapping[1] := 2;
  958. Result := DoubleRes;
  959. TValue.Make(@Result, TypeInfo(Result), ResultValue);
  960. CalledMethod := 14;
  961. end;
  962. function TTestInterfaceClass.Test15(aArg1: Extended; var aArg2: Extended; out aArg3: Extended; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Extended): Extended;
  963. begin
  964. SetLength(InputArgs, 4);
  965. TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]);
  966. TValue.Make(@aArg2, TypeInfo(aArg2), InputArgs[1]);
  967. TValue.Make(@aArg3, TypeInfo(aArg3), InputArgs[2]);
  968. TValue.Make(@aArg4, TypeInfo(aArg4), InputArgs[3]);
  969. aArg2 := ExtendedArg2Out;
  970. aArg3 := ExtendedArg3Out;
  971. SetLength(OutputArgs, 2);
  972. TValue.Make(@aArg2, TypeInfo(aArg2), OutputArgs[0]);
  973. TValue.Make(@aArg3, TypeInfo(aArg3), OutputArgs[1]);
  974. SetLength(InOutMapping, 2);
  975. InOutMapping[0] := 1;
  976. InOutMapping[1] := 2;
  977. Result := ExtendedRes;
  978. TValue.Make(@Result, TypeInfo(Result), ResultValue);
  979. CalledMethod := 15;
  980. end;
  981. function TTestInterfaceClass.Test16(aArg1: Comp; var aArg2: Comp; out aArg3: Comp; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Comp): Comp;
  982. begin
  983. SetLength(InputArgs, 4);
  984. TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]);
  985. TValue.Make(@aArg2, TypeInfo(aArg2), InputArgs[1]);
  986. TValue.Make(@aArg3, TypeInfo(aArg3), InputArgs[2]);
  987. TValue.Make(@aArg4, TypeInfo(aArg4), InputArgs[3]);
  988. aArg2 := CompArg2Out;
  989. aArg3 := CompArg3Out;
  990. SetLength(OutputArgs, 2);
  991. TValue.Make(@aArg2, TypeInfo(aArg2), OutputArgs[0]);
  992. TValue.Make(@aArg3, TypeInfo(aArg3), OutputArgs[1]);
  993. SetLength(InOutMapping, 2);
  994. InOutMapping[0] := 1;
  995. InOutMapping[1] := 2;
  996. Result := CompRes;
  997. TValue.Make(@Result, TypeInfo(Result), ResultValue);
  998. CalledMethod := 16;
  999. end;
  1000. function TTestInterfaceClass.Test17(aArg1: Currency; var aArg2: Currency; out aArg3: Currency; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Currency): Currency;
  1001. begin
  1002. SetLength(InputArgs, 4);
  1003. TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]);
  1004. TValue.Make(@aArg2, TypeInfo(aArg2), InputArgs[1]);
  1005. TValue.Make(@aArg3, TypeInfo(aArg3), InputArgs[2]);
  1006. TValue.Make(@aArg4, TypeInfo(aArg4), InputArgs[3]);
  1007. aArg2 := CurrencyArg2Out;
  1008. aArg3 := CurrencyArg3Out;
  1009. SetLength(OutputArgs, 2);
  1010. TValue.Make(@aArg2, TypeInfo(aArg2), OutputArgs[0]);
  1011. TValue.Make(@aArg3, TypeInfo(aArg3), OutputArgs[1]);
  1012. SetLength(InOutMapping, 2);
  1013. InOutMapping[0] := 1;
  1014. InOutMapping[1] := 2;
  1015. Result := CurrencyRes;
  1016. TValue.Make(@Result, TypeInfo(Result), ResultValue);
  1017. CalledMethod := 17;
  1018. end;
  1019. function TTestInterfaceClass.TestRecSize1(aArg1: TTestRecord1): TTestRecord1;
  1020. var
  1021. i: LongInt;
  1022. begin
  1023. SetLength(InputArgs, 1);
  1024. TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]);
  1025. SetLength(OutputArgs, 0);
  1026. for i := 0 to High(aArg1.b) do
  1027. Result.b[High(Result.b) - i] := aArg1.b[i];
  1028. TValue.Make(@Result, TypeInfo(Result), ResultValue);
  1029. CalledMethod := 1 or RecSizeMarker;
  1030. end;
  1031. function TTestInterfaceClass.TestRecSize2(aArg1: TTestRecord2): TTestRecord2;
  1032. var
  1033. i: LongInt;
  1034. begin
  1035. SetLength(InputArgs, 1);
  1036. TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]);
  1037. SetLength(OutputArgs, 0);
  1038. for i := 0 to High(aArg1.b) do
  1039. Result.b[High(Result.b) - i] := aArg1.b[i];
  1040. TValue.Make(@Result, TypeInfo(Result), ResultValue);
  1041. CalledMethod := 2 or RecSizeMarker;
  1042. end;
  1043. function TTestInterfaceClass.TestRecSize3(aArg1: TTestRecord3): TTestRecord3;
  1044. var
  1045. i: LongInt;
  1046. begin
  1047. SetLength(InputArgs, 1);
  1048. TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]);
  1049. SetLength(OutputArgs, 0);
  1050. for i := 0 to High(aArg1.b) do
  1051. Result.b[High(Result.b) - i] := aArg1.b[i];
  1052. TValue.Make(@Result, TypeInfo(Result), ResultValue);
  1053. CalledMethod := 3 or RecSizeMarker;
  1054. end;
  1055. function TTestInterfaceClass.TestRecSize4(aArg1: TTestRecord4): TTestRecord4;
  1056. var
  1057. i: LongInt;
  1058. begin
  1059. SetLength(InputArgs, 1);
  1060. TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]);
  1061. SetLength(OutputArgs, 0);
  1062. for i := 0 to High(aArg1.b) do
  1063. Result.b[High(Result.b) - i] := aArg1.b[i];
  1064. TValue.Make(@Result, TypeInfo(Result), ResultValue);
  1065. CalledMethod := 4 or RecSizeMarker;
  1066. end;
  1067. function TTestInterfaceClass.TestRecSize5(aArg1: TTestRecord5): TTestRecord5;
  1068. var
  1069. i: LongInt;
  1070. begin
  1071. SetLength(InputArgs, 1);
  1072. TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]);
  1073. SetLength(OutputArgs, 0);
  1074. for i := 0 to High(aArg1.b) do
  1075. Result.b[High(Result.b) - i] := aArg1.b[i];
  1076. TValue.Make(@Result, TypeInfo(Result), ResultValue);
  1077. CalledMethod := 5 or RecSizeMarker;
  1078. end;
  1079. function TTestInterfaceClass.TestRecSize6(aArg1: TTestRecord6): TTestRecord6;
  1080. var
  1081. i: LongInt;
  1082. begin
  1083. SetLength(InputArgs, 1);
  1084. TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]);
  1085. SetLength(OutputArgs, 0);
  1086. for i := 0 to High(aArg1.b) do
  1087. Result.b[High(Result.b) - i] := aArg1.b[i];
  1088. TValue.Make(@Result, TypeInfo(Result), ResultValue);
  1089. CalledMethod := 6 or RecSizeMarker;
  1090. end;
  1091. function TTestInterfaceClass.TestRecSize7(aArg1: TTestRecord7): TTestRecord7;
  1092. var
  1093. i: LongInt;
  1094. begin
  1095. SetLength(InputArgs, 1);
  1096. TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]);
  1097. SetLength(OutputArgs, 0);
  1098. for i := 0 to High(aArg1.b) do
  1099. Result.b[High(Result.b) - i] := aArg1.b[i];
  1100. TValue.Make(@Result, TypeInfo(Result), ResultValue);
  1101. CalledMethod := 7 or RecSizeMarker;
  1102. end;
  1103. function TTestInterfaceClass.TestRecSize8(aArg1: TTestRecord8): TTestRecord8;
  1104. var
  1105. i: LongInt;
  1106. begin
  1107. SetLength(InputArgs, 1);
  1108. TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]);
  1109. SetLength(OutputArgs, 0);
  1110. for i := 0 to High(aArg1.b) do
  1111. Result.b[High(Result.b) - i] := aArg1.b[i];
  1112. TValue.Make(@Result, TypeInfo(Result), ResultValue);
  1113. CalledMethod := 8 or RecSizeMarker;
  1114. end;
  1115. function TTestInterfaceClass.TestRecSize9(aArg1: TTestRecord9): TTestRecord9;
  1116. var
  1117. i: LongInt;
  1118. begin
  1119. SetLength(InputArgs, 1);
  1120. TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]);
  1121. SetLength(OutputArgs, 0);
  1122. for i := 0 to High(aArg1.b) do
  1123. Result.b[High(Result.b) - i] := aArg1.b[i];
  1124. TValue.Make(@Result, TypeInfo(Result), ResultValue);
  1125. CalledMethod := 9 or RecSizeMarker;
  1126. end;
  1127. function TTestInterfaceClass.TestRecSize10(aArg1: TTestRecord10): TTestRecord10;
  1128. var
  1129. i: LongInt;
  1130. begin
  1131. SetLength(InputArgs, 1);
  1132. TValue.Make(@aArg1, TypeInfo(aArg1), InputArgs[0]);
  1133. SetLength(OutputArgs, 0);
  1134. for i := 0 to High(aArg1.b) do
  1135. Result.b[High(Result.b) - i] := aArg1.b[i];
  1136. TValue.Make(@Result, TypeInfo(Result), ResultValue);
  1137. CalledMethod := 10 or RecSizeMarker;
  1138. end;
  1139. procedure TTestInterfaceClass.Reset;
  1140. begin
  1141. InputArgs := Nil;
  1142. OutputArgs := Nil;
  1143. InOutMapping := Nil;
  1144. ResultValue := TValue.Empty;
  1145. CalledMethod := 0;
  1146. end;
  1147. procedure ProcTest1;
  1148. begin
  1149. TTestInterfaceClass.ProcVarInst.Test1;
  1150. end;
  1151. function ProcTest2: SizeInt;
  1152. begin
  1153. Result := TTestInterfaceClass.ProcVarInst.Test2;
  1154. end;
  1155. function ProcTest3(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: SizeInt): SizeInt;
  1156. begin
  1157. Result := TTestInterfaceClass.ProcVarInst.Test3(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10);
  1158. end;
  1159. procedure ProcTest4(aArg1: AnsiString; aArg2: UnicodeString; aArg3: WideString; aArg4: ShortString);
  1160. begin
  1161. TTestInterfaceClass.ProcVarInst.Test4(aArg1, aArg2, aArg3, aArg4);
  1162. end;
  1163. function ProcTest5: AnsiString;
  1164. begin
  1165. Result := TTestInterfaceClass.ProcVarInst.Test5;
  1166. end;
  1167. function ProcTest6: UnicodeString;
  1168. begin
  1169. Result := TTestInterfaceClass.ProcVarInst.Test6;
  1170. end;
  1171. function ProcTest7: WideString;
  1172. begin
  1173. Result := TTestInterfaceClass.ProcVarInst.Test7;
  1174. end;
  1175. function ProcTest8: ShortString;
  1176. begin
  1177. Result := TTestInterfaceClass.ProcVarInst.Test8;
  1178. end;
  1179. procedure ProcTest9(aArg1: SizeInt; var aArg2: SizeInt; out aArg3: SizeInt; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: SizeInt);
  1180. begin
  1181. TTestInterfaceClass.ProcVarInst.Test9(aArg1, aArg2, aArg3, aArg4);
  1182. end;
  1183. procedure ProcTest10(aArg1: AnsiString; var aArg2: AnsiString; out aArg3: AnsiString; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: AnsiString);
  1184. begin
  1185. TTestInterfaceClass.ProcVarInst.Test10(aArg1, aArg2, aArg3, aArg4);
  1186. end;
  1187. procedure ProcTest11(aArg1: ShortString; var aArg2: ShortString; out aArg3: ShortString; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: ShortString);
  1188. begin
  1189. TTestInterfaceClass.ProcVarInst.Test11(aArg1, aArg2, aArg3, aArg4);
  1190. end;
  1191. 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);
  1192. begin
  1193. TTestInterfaceClass.ProcVarInst.Test12(aArg1, aArg2, aArg3, aArg4);
  1194. end;
  1195. function ProcTest13(aArg1: Single; var aArg2: Single; out aArg3: Single; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Single): Single;
  1196. begin
  1197. Result := TTestInterfaceClass.ProcVarInst.Test13(aArg1, aArg2, aArg3, aArg4);
  1198. end;
  1199. function ProcTest14(aArg1: Double; var aArg2: Double; out aArg3: Double; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Double): Double;
  1200. begin
  1201. Result := TTestInterfaceClass.ProcVarInst.Test14(aArg1, aArg2, aArg3, aArg4);
  1202. end;
  1203. function ProcTest15(aArg1: Extended; var aArg2: Extended; out aArg3: Extended; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Extended): Extended;
  1204. begin
  1205. Result := TTestInterfaceClass.ProcVarInst.Test15(aArg1, aArg2, aArg3, aArg4);
  1206. end;
  1207. function ProcTest16(aArg1: Comp; var aArg2: Comp; out aArg3: Comp; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Comp): Comp;
  1208. begin
  1209. Result := TTestInterfaceClass.ProcVarInst.Test16(aArg1, aArg2, aArg3, aArg4);
  1210. end;
  1211. function ProcTest17(aArg1: Currency; var aArg2: Currency; out aArg3: Currency; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4: Currency): Currency;
  1212. begin
  1213. Result := TTestInterfaceClass.ProcVarInst.Test17(aArg1, aArg2, aArg3, aArg4);
  1214. end;
  1215. function ProcTestRecSize1(aArg1: TTestRecord1): TTestRecord1;
  1216. begin
  1217. Result := TTestInterfaceClass.ProcVarRecInst.TestRecSize1(aArg1);
  1218. end;
  1219. function ProcTestRecSize2(aArg1: TTestRecord2): TTestRecord2;
  1220. begin
  1221. Result := TTestInterfaceClass.ProcVarRecInst.TestRecSize2(aArg1);
  1222. end;
  1223. function ProcTestRecSize3(aArg1: TTestRecord3): TTestRecord3;
  1224. begin
  1225. Result := TTestInterfaceClass.ProcVarRecInst.TestRecSize3(aArg1);
  1226. end;
  1227. function ProcTestRecSize4(aArg1: TTestRecord4): TTestRecord4;
  1228. begin
  1229. Result := TTestInterfaceClass.ProcVarRecInst.TestRecSize4(aArg1);
  1230. end;
  1231. function ProcTestRecSize5(aArg1: TTestRecord5): TTestRecord5;
  1232. begin
  1233. Result := TTestInterfaceClass.ProcVarRecInst.TestRecSize5(aArg1);
  1234. end;
  1235. function ProcTestRecSize6(aArg1: TTestRecord6): TTestRecord6;
  1236. begin
  1237. Result := TTestInterfaceClass.ProcVarRecInst.TestRecSize6(aArg1);
  1238. end;
  1239. function ProcTestRecSize7(aArg1: TTestRecord7): TTestRecord7;
  1240. begin
  1241. Result := TTestInterfaceClass.ProcVarRecInst.TestRecSize7(aArg1);
  1242. end;
  1243. function ProcTestRecSize8(aArg1: TTestRecord8): TTestRecord8;
  1244. begin
  1245. Result := TTestInterfaceClass.ProcVarRecInst.TestRecSize8(aArg1);
  1246. end;
  1247. function ProcTestRecSize9(aArg1: TTestRecord9): TTestRecord9;
  1248. begin
  1249. Result := TTestInterfaceClass.ProcVarRecInst.TestRecSize9(aArg1);
  1250. end;
  1251. function ProcTestRecSize10(aArg1: TTestRecord10): TTestRecord10;
  1252. begin
  1253. Result := TTestInterfaceClass.ProcVarRecInst.TestRecSize10(aArg1);
  1254. end;
  1255. function CopyValue({$ifdef fpc}constref{$else}const [ref]{$endif} aValue: TValue): TValue;
  1256. var
  1257. arrptr: Pointer;
  1258. len, i: SizeInt;
  1259. begin
  1260. if aValue.Kind = tkDynArray then begin
  1261. { we need to decouple the source reference, so we're going to be a bit
  1262. cheeky here }
  1263. len := aValue.GetArrayLength;
  1264. arrptr := Nil;
  1265. DynArraySetLength(arrptr, aValue.TypeInfo, 1, @len);
  1266. TValue.Make(@arrptr, aValue.TypeInfo, Result);
  1267. for i := 0 to len - 1 do
  1268. Result.SetArrayElement(i, aValue.GetArrayElement(i));
  1269. end else
  1270. TValue.Make(aValue.GetReferenceToRawData, aValue.TypeInfo, Result);
  1271. end;
  1272. procedure TTestInvoke.DoIntfInvoke(aIndex: SizeInt; aInputArgs,
  1273. aOutputArgs: TValueArray; aResult: TValue);
  1274. var
  1275. cls: TTestInterfaceClass;
  1276. intf: ITestInterface;
  1277. name: String;
  1278. context: TRttiContext;
  1279. t: TRttiType;
  1280. inst, res: TValue;
  1281. method: TRttiMethod;
  1282. i: SizeInt;
  1283. input: array of TValue;
  1284. begin
  1285. cls := TTestInterfaceClass.Create;
  1286. intf := cls;
  1287. TValue.Make(@intf, TypeInfo(intf), inst);
  1288. if aIndex and TTestInterfaceClass.RecSizeMarker <> 0 then
  1289. name := 'TestRecSize' + IntToStr(aIndex and not TTestInterfaceClass.RecSizeMarker)
  1290. else
  1291. name := 'Test' + IntToStr(aIndex);
  1292. context := TRttiContext.Create;
  1293. try
  1294. t := context.GetType(TypeInfo(ITestInterface));
  1295. method := t.GetMethod(name);
  1296. Check(Assigned(method), 'Method not found: ' + name);
  1297. { arguments might be modified by Invoke (Note: Copy() does not uniquify the
  1298. IValueData of managed types) }
  1299. SetLength(input, Length(aInputArgs));
  1300. for i := 0 to High(input) do
  1301. input[i] := CopyValue(aInputArgs[i]);
  1302. try
  1303. res := method.Invoke(inst, aInputArgs);
  1304. except
  1305. DumpExceptionBacktrace(output);
  1306. raise;
  1307. end;
  1308. CheckEquals(aIndex, cls.CalledMethod, 'Wrong method called for ' + name);
  1309. Check(EqualValues(cls.ResultValue, res), 'Reported result value differs from returned for ' + name);
  1310. Check(EqualValues(aResult, res), 'Expected result value differs from returned for ' + name);
  1311. CheckEquals(Length(aInputArgs), Length(cls.InputArgs), 'Count of input args differs for ' + name);
  1312. CheckEquals(Length(cls.OutputArgs), Length(cls.InOutMapping), 'Count of output args and in-out-mapping differs for ' + name);
  1313. CheckEquals(Length(aOutputArgs), Length(cls.OutputArgs), 'Count of output args differs for ' + name);
  1314. for i := 0 to High(aInputArgs) do begin
  1315. Check(EqualValues(input[i], cls.InputArgs[i]), Format('Input argument %d differs for %s', [i + 1, name]));
  1316. end;
  1317. for i := 0 to High(aOutputArgs) do begin
  1318. Check(EqualValues(aOutputArgs[i], cls.OutputArgs[i]), Format('Output argument %d differs for %s', [i + 1, name]));
  1319. Check(EqualValues(aOutputArgs[i], aInputArgs[cls.InOutMapping[i]]), Format('New output argument %d differs from expected output for %s', [i + 1, name]));
  1320. end;
  1321. finally
  1322. context.Free;
  1323. end;
  1324. end;
  1325. procedure TTestInvoke.DoMethodInvoke(aInst: TObject; aMethod: TMethod;
  1326. aTypeInfo: PTypeInfo; aIndex: SizeInt; aInputArgs, aOutputArgs: TValueArray; aResult: TValue);
  1327. var
  1328. cls: TTestInterfaceClass;
  1329. name: String;
  1330. context: TRttiContext;
  1331. t: TRttiType;
  1332. callable, res: TValue;
  1333. method: TRttiMethodType;
  1334. i: SizeInt;
  1335. input: array of TValue;
  1336. begin
  1337. cls := aInst as TTestInterfaceClass;
  1338. cls.Reset;
  1339. if aIndex and TTestInterfaceClass.RecSizeMarker <> 0 then
  1340. name := 'TestRecSize' + IntToStr(aIndex and not TTestInterfaceClass.RecSizeMarker)
  1341. else
  1342. name := 'Test' + IntToStr(aIndex);
  1343. TValue.Make(@aMethod, aTypeInfo, callable);
  1344. context := TRttiContext.Create;
  1345. try
  1346. t := context.GetType(aTypeInfo);
  1347. Check(t is TRttiMethodType, 'Not a method variable: ' + aTypeInfo^.Name);
  1348. method := t as TRttiMethodType;
  1349. { arguments might be modified by Invoke (Note: Copy() does not uniquify the
  1350. IValueData of managed types) }
  1351. SetLength(input, Length(aInputArgs));
  1352. for i := 0 to High(input) do
  1353. input[i] := CopyValue(aInputArgs[i]);
  1354. res := method.Invoke(callable, aInputArgs);
  1355. CheckEquals(aIndex, cls.CalledMethod, 'Wrong method called for ' + name);
  1356. Check(EqualValues(cls.ResultValue, res), 'Reported result value differs from returned for ' + name);
  1357. Check(EqualValues(aResult, res), 'Expected result value differs from returned for ' + name);
  1358. CheckEquals(Length(aInputArgs), Length(cls.InputArgs), 'Count of input args differs for ' + name);
  1359. CheckEquals(Length(cls.OutputArgs), Length(cls.InOutMapping), 'Count of output args and in-out-mapping differs for ' + name);
  1360. CheckEquals(Length(aOutputArgs), Length(cls.OutputArgs), 'Count of output args differs for ' + name);
  1361. for i := 0 to High(aInputArgs) do begin
  1362. Check(EqualValues(input[i], cls.InputArgs[i]), Format('Input argument %d differs for %s', [i + 1, name]));
  1363. end;
  1364. for i := 0 to High(aOutputArgs) do begin
  1365. Check(EqualValues(aOutputArgs[i], cls.OutputArgs[i]), Format('Output argument %d differs for %s', [i + 1, name]));
  1366. Check(EqualValues(aOutputArgs[i], aInputArgs[cls.InOutMapping[i]]), Format('New output argument %d differs from expected output for %s', [i + 1, name]));
  1367. end;
  1368. finally
  1369. context.Free;
  1370. end;
  1371. end;
  1372. procedure TTestInvoke.DoProcVarInvoke(aInst: TObject; aProc: CodePointer;
  1373. aTypeInfo: PTypeInfo; aIndex: SizeInt; aInputArgs, aOutputArgs: TValueArray; aResult: TValue);
  1374. var
  1375. cls: TTestInterfaceClass;
  1376. name: String;
  1377. context: TRttiContext;
  1378. t: TRttiType;
  1379. callable, res: TValue;
  1380. proc: TRttiProcedureType;
  1381. i: SizeInt;
  1382. input: array of TValue;
  1383. begin
  1384. cls := aInst as TTestInterfaceClass;
  1385. cls.Reset;
  1386. if aIndex and TTestInterfaceClass.RecSizeMarker <> 0 then begin
  1387. name := 'TestRecSize' + IntToStr(aIndex and not TTestInterfaceClass.RecSizeMarker);
  1388. TTestInterfaceClass.ProcVarRecInst := cls;
  1389. end else begin
  1390. name := 'Test' + IntToStr(aIndex);
  1391. TTestInterfaceClass.ProcVarInst := cls;
  1392. end;
  1393. TValue.Make(@aProc, aTypeInfo, callable);
  1394. context := TRttiContext.Create;
  1395. try
  1396. t := context.GetType(aTypeInfo);
  1397. Check(t is TRttiProcedureType, 'Not a procedure variable: ' + aTypeInfo^.Name);
  1398. proc := t as TRttiProcedureType;
  1399. { arguments might be modified by Invoke (Note: Copy() does not uniquify the
  1400. IValueData of managed types) }
  1401. SetLength(input, Length(aInputArgs));
  1402. for i := 0 to High(input) do
  1403. input[i] := CopyValue(aInputArgs[i]);
  1404. res := proc.Invoke(callable, aInputArgs);
  1405. CheckEquals(aIndex, cls.CalledMethod, 'Wrong method called for ' + name);
  1406. Check(EqualValues(cls.ResultValue, res), 'Reported result value differs from returned for ' + name);
  1407. Check(EqualValues(aResult, res), 'Expected result value differs from returned for ' + name);
  1408. CheckEquals(Length(aInputArgs), Length(cls.InputArgs), 'Count of input args differs for ' + name);
  1409. CheckEquals(Length(cls.OutputArgs), Length(cls.InOutMapping), 'Count of output args and in-out-mapping differs for ' + name);
  1410. CheckEquals(Length(aOutputArgs), Length(cls.OutputArgs), 'Count of output args differs for ' + name);
  1411. for i := 0 to High(aInputArgs) do begin
  1412. Check(EqualValues(input[i], cls.InputArgs[i]), Format('Input argument %d differs for %s', [i + 1, name]));
  1413. end;
  1414. for i := 0 to High(aOutputArgs) do begin
  1415. Check(EqualValues(aOutputArgs[i], cls.OutputArgs[i]), Format('Output argument %d differs for %s', [i + 1, name]));
  1416. Check(EqualValues(aOutputArgs[i], aInputArgs[cls.InOutMapping[i]]), Format('New output argument %d differs from expected output for %s', [i + 1, name]));
  1417. end;
  1418. finally
  1419. context.Free;
  1420. end;
  1421. end;
  1422. {$ifndef InLazIDE}
  1423. {$ifdef fpc}generic{$endif} procedure TTestInvoke.GenDoMethodInvoke<T>(aInst: TObject; aMethod: T; aIndex: SizeInt; aInputArgs, aOutputArgs: TValueArray; aResult: TValue);
  1424. begin
  1425. DoMethodInvoke(aInst, TMethod(aMethod), TypeInfo(T), aIndex, aInputArgs, aOutputArgs, aResult);
  1426. end;
  1427. {$ifdef fpc}generic{$endif} procedure TTestInvoke.GenDoProcVarInvoke<T>(aInst: TObject; aProc: T; aIndex: SizeInt; aInputArgs, aOutputArgs: TValueArray; aResult: TValue);
  1428. begin
  1429. DoProcVarInvoke(aInst, CodePointer(aProc), TypeInfo(T), aIndex, aInputArgs, aOutputArgs, aResult);
  1430. end;
  1431. {$ifdef fpc}generic{$endif} function TTestInvoke.GetRecValue<T>(aReverse: Boolean): TValue;
  1432. var
  1433. i: LongInt;
  1434. arr: array of Byte;
  1435. begin
  1436. SetLength(arr, SizeOf(T));
  1437. RandSeed := $54827982;
  1438. if not aReverse then begin
  1439. for i := 0 to High(arr) do
  1440. arr[i] := Random($ff);
  1441. end else begin
  1442. for i := High(arr) downto 0 do
  1443. arr[i] := Random($ff);
  1444. end;
  1445. TValue.Make(@arr[0], PTypeInfo(TypeInfo(T)), Result);
  1446. end;
  1447. {$endif}
  1448. function GetIntValue(aValue: SizeInt): TValue;
  1449. begin
  1450. Result := TValue.{$ifdef fpc}specialize{$endif}From<SizeInt>(aValue);
  1451. end;
  1452. function GetAnsiString(const aValue: AnsiString): TValue;
  1453. begin
  1454. Result := TValue.{$ifdef fpc}specialize{$endif}From<AnsiString>(aValue);
  1455. end;
  1456. function GetShortString(const aValue: ShortString): TValue;
  1457. begin
  1458. Result := TValue.{$ifdef fpc}specialize{$endif}From<ShortString>(aValue);
  1459. end;
  1460. function GetSingleValue(aValue: Single): TValue;
  1461. begin
  1462. Result := TValue.{$ifdef fpc}specialize{$endif}From<Single>(aValue);
  1463. end;
  1464. function GetDoubleValue(aValue: Double): TValue;
  1465. begin
  1466. Result := TValue.{$ifdef fpc}specialize{$endif}From<Double>(aValue);
  1467. end;
  1468. function GetExtendedValue(aValue: Extended): TValue;
  1469. begin
  1470. Result := TValue.{$ifdef fpc}specialize{$endif}From<Extended>(aValue);
  1471. end;
  1472. function GetCompValue(aValue: Comp): TValue;
  1473. begin
  1474. Result := TValue.{$ifdef fpc}specialize{$endif}From<Comp>(aValue);
  1475. end;
  1476. function GetCurrencyValue(aValue: Currency): TValue;
  1477. begin
  1478. Result := TValue.{$ifdef fpc}specialize{$endif}From<Currency>(aValue);
  1479. end;
  1480. {$ifdef fpc}
  1481. function GetArray(const aArg: array of SizeInt): TValue;
  1482. begin
  1483. Result := specialize OpenArrayToDynArrayValue<SizeInt>(aArg);
  1484. end;
  1485. {$endif}
  1486. procedure TTestInvoke.TestIntfMethods;
  1487. begin
  1488. DoIntfInvoke(1, [], [], TValue.Empty);
  1489. DoIntfInvoke(2, [], [], TValue.{$ifdef fpc}specialize{$endif}From<SizeInt>(42));
  1490. DoIntfInvoke(3, [
  1491. GetIntValue(7), GetIntValue(2), GetIntValue(5), GetIntValue(1), GetIntValue(10), GetIntValue(8), GetIntValue(6), GetIntValue(3), GetIntValue(9), GetIntValue(3)
  1492. ], [], GetIntValue(42));
  1493. DoIntfInvoke(4, [
  1494. TValue.{$ifdef fpc}specialize{$endif}From<AnsiString>('Alpha'),
  1495. TValue.{$ifdef fpc}specialize{$endif}From<UnicodeString>('Beta'),
  1496. TValue.{$ifdef fpc}specialize{$endif}From<WideString>('Gamma'),
  1497. TValue.{$ifdef fpc}specialize{$endif}From<ShortString>('Delta')
  1498. ], [], TValue.Empty);
  1499. DoIntfInvoke(5, [], [], TValue.{$ifdef fpc}specialize{$endif}From<AnsiString>('Hello World'));
  1500. DoIntfInvoke(6, [], [], TValue.{$ifdef fpc}specialize{$endif}From<UnicodeString>('Hello World'));
  1501. DoIntfInvoke(7, [], [], TValue.{$ifdef fpc}specialize{$endif}From<WideString>('Hello World'));
  1502. DoIntfInvoke(8, [], [], TValue.{$ifdef fpc}specialize{$endif}From<ShortString>('Hello World'));
  1503. DoIntfInvoke(9, [
  1504. GetIntValue($1234), GetIntValue($4321), GetIntValue($8765), GetIntValue($5678)
  1505. ], [
  1506. GetIntValue($1234), GetIntValue($5678)
  1507. ], TValue.Empty);
  1508. DoIntfInvoke(10, [
  1509. GetAnsiString('Alpha'), GetAnsiString('Beta'), GetAnsiString(''), GetAnsiString('Delta')
  1510. ], [
  1511. GetAnsiString('Foo'), GetAnsiString('Bar')
  1512. ], TValue.Empty);
  1513. DoIntfInvoke(11, [
  1514. GetShortString('Alpha'), GetShortString('Beta'), GetShortString(''), GetShortString('Delta')
  1515. ], [
  1516. GetShortString('Foo'), GetShortString('Bar')
  1517. ], TValue.Empty);
  1518. {$ifdef fpc}
  1519. DoIntfInvoke(12, [
  1520. GetArray([$1234, $2345, $3456, $4567]), GetArray([$4321, $5431, $6543, $7654]), GetArray([$5678, $6789, $7890, $8901]), GetArray([$8765, $7654, $6543, $5432])
  1521. ], [
  1522. GetArray([$4321, $4322, $4323, $4324]), GetArray([$9876, $9877, $9878, $9879])
  1523. ], TValue.Empty);
  1524. {$endif}
  1525. DoIntfInvoke(13, [
  1526. GetSingleValue(SingleArg1), GetSingleValue(SingleArg2In), GetSingleValue(0), GetSingleValue(SingleArg4)
  1527. ], [
  1528. GetSingleValue(SingleArg2Out), GetSingleValue(SingleArg3Out)
  1529. ], GetSingleValue(SingleRes));
  1530. DoIntfInvoke(14, [
  1531. GetDoubleValue(DoubleArg1), GetDoubleValue(DoubleArg2In), GetDoubleValue(0), GetDoubleValue(DoubleArg4)
  1532. ], [
  1533. GetDoubleValue(DoubleArg2Out), GetDoubleValue(DoubleArg3Out)
  1534. ], GetDoubleValue(DoubleRes));
  1535. DoIntfInvoke(15, [
  1536. GetExtendedValue(ExtendedArg1), GetExtendedValue(ExtendedArg2In), GetExtendedValue(0), GetExtendedValue(ExtendedArg4)
  1537. ], [
  1538. GetExtendedValue(ExtendedArg2Out), GetExtendedValue(ExtendedArg3Out)
  1539. ], GetExtendedValue(ExtendedRes));
  1540. DoIntfInvoke(16, [
  1541. GetCompValue(CompArg1), GetCompValue(CompArg2In), GetCompValue(0), GetCompValue(CompArg4)
  1542. ], [
  1543. GetCompValue(CompArg2Out), GetCompValue(CompArg3Out)
  1544. ], GetCompValue(CompRes));
  1545. DoIntfInvoke(17, [
  1546. GetCurrencyValue(CurrencyArg1), GetCurrencyValue(CurrencyArg2In), GetCurrencyValue(0), GetCurrencyValue(CurrencyArg4)
  1547. ], [
  1548. GetCurrencyValue(CurrencyArg2Out), GetCurrencyValue(CurrencyArg3Out)
  1549. ], GetCurrencyValue(CurrencyRes));
  1550. end;
  1551. procedure TTestInvoke.TestIntfMethodsRecs;
  1552. begin
  1553. DoIntfInvoke(1 or TTestInterfaceClass.RecSizeMarker,
  1554. [{$ifdef fpc}specialize{$endif} GetRecValue<TTestRecord1>(False)], [],
  1555. {$ifdef fpc}specialize{$endif} GetRecValue<TTestRecord1>(True));
  1556. DoIntfInvoke(2 or TTestInterfaceClass.RecSizeMarker,
  1557. [{$ifdef fpc}specialize{$endif} GetRecValue<TTestRecord2>(False)], [],
  1558. {$ifdef fpc}specialize{$endif} GetRecValue<TTestRecord2>(True));
  1559. DoIntfInvoke(3 or TTestInterfaceClass.RecSizeMarker,
  1560. [{$ifdef fpc}specialize{$endif} GetRecValue<TTestRecord3>(False)], [],
  1561. {$ifdef fpc}specialize{$endif} GetRecValue<TTestRecord3>(True));
  1562. DoIntfInvoke(4 or TTestInterfaceClass.RecSizeMarker,
  1563. [{$ifdef fpc}specialize{$endif} GetRecValue<TTestRecord4>(False)], [],
  1564. {$ifdef fpc}specialize{$endif} GetRecValue<TTestRecord4>(True));
  1565. DoIntfInvoke(5 or TTestInterfaceClass.RecSizeMarker,
  1566. [{$ifdef fpc}specialize{$endif} GetRecValue<TTestRecord5>(False)], [],
  1567. {$ifdef fpc}specialize{$endif} GetRecValue<TTestRecord5>(True));
  1568. DoIntfInvoke(6 or TTestInterfaceClass.RecSizeMarker,
  1569. [{$ifdef fpc}specialize{$endif} GetRecValue<TTestRecord6>(False)], [],
  1570. {$ifdef fpc}specialize{$endif} GetRecValue<TTestRecord6>(True));
  1571. DoIntfInvoke(7 or TTestInterfaceClass.RecSizeMarker,
  1572. [{$ifdef fpc}specialize{$endif} GetRecValue<TTestRecord7>(False)], [],
  1573. {$ifdef fpc}specialize{$endif} GetRecValue<TTestRecord7>(True));
  1574. DoIntfInvoke(8 or TTestInterfaceClass.RecSizeMarker,
  1575. [{$ifdef fpc}specialize{$endif} GetRecValue<TTestRecord8>(False)], [],
  1576. {$ifdef fpc}specialize{$endif} GetRecValue<TTestRecord8>(True));
  1577. DoIntfInvoke(9 or TTestInterfaceClass.RecSizeMarker,
  1578. [{$ifdef fpc}specialize{$endif} GetRecValue<TTestRecord9>(False)], [],
  1579. {$ifdef fpc}specialize{$endif} GetRecValue<TTestRecord9>(True));
  1580. DoIntfInvoke(10 or TTestInterfaceClass.RecSizeMarker,
  1581. [{$ifdef fpc}specialize{$endif} GetRecValue<TTestRecord10>(False)], [],
  1582. {$ifdef fpc}specialize{$endif} GetRecValue<TTestRecord10>(True));
  1583. end;
  1584. procedure TTestInvoke.TestMethodVars;
  1585. var
  1586. cls: TTestInterfaceClass;
  1587. begin
  1588. cls := TTestInterfaceClass.Create;
  1589. try
  1590. {$ifdef fpc}specialize{$endif} GenDoMethodInvoke<TMethodTest1>(cls, {$ifdef fpc}@{$endif}cls.Test1, 1, [], [], TValue.Empty);
  1591. {$ifdef fpc}specialize{$endif} GenDoMethodInvoke<TMethodTest2>(cls, {$ifdef fpc}@{$endif}cls.Test2, 2, [], [], TValue.{$ifdef fpc}{$ifdef fpc}specialize{$endif}{$endif}From<SizeInt>(42));
  1592. {$ifdef fpc}specialize{$endif} GenDoMethodInvoke<TMethodTest3>(cls, {$ifdef fpc}@{$endif}cls.Test3, 3, [
  1593. GetIntValue(7), GetIntValue(2), GetIntValue(5), GetIntValue(1), GetIntValue(10), GetIntValue(8), GetIntValue(6), GetIntValue(3), GetIntValue(9), GetIntValue(3)
  1594. ], [], GetIntValue(42));
  1595. {$ifdef fpc}specialize{$endif} GenDoMethodInvoke<TMethodTest4>(cls, {$ifdef fpc}@{$endif}cls.Test4, 4, [
  1596. TValue.{$ifdef fpc}specialize{$endif}From<AnsiString>('Alpha'),
  1597. TValue.{$ifdef fpc}specialize{$endif}From<UnicodeString>('Beta'),
  1598. TValue.{$ifdef fpc}specialize{$endif}From<WideString>('Gamma'),
  1599. TValue.{$ifdef fpc}specialize{$endif}From<ShortString>('Delta')
  1600. ], [], TValue.Empty);
  1601. {$ifdef fpc}specialize{$endif} GenDoMethodInvoke<TMethodTest5>(cls, {$ifdef fpc}@{$endif}cls.Test5, 5, [], [], TValue.{$ifdef fpc}specialize{$endif}From<AnsiString>('Hello World'));
  1602. {$ifdef fpc}specialize{$endif} GenDoMethodInvoke<TMethodTest6>(cls, {$ifdef fpc}@{$endif}cls.Test6, 6, [], [], TValue.{$ifdef fpc}specialize{$endif}From<UnicodeString>('Hello World'));
  1603. {$ifdef fpc}specialize{$endif} GenDoMethodInvoke<TMethodTest7>(cls, {$ifdef fpc}@{$endif}cls.Test7, 7, [], [], TValue.{$ifdef fpc}specialize{$endif}From<WideString>('Hello World'));
  1604. {$ifdef fpc}specialize{$endif} GenDoMethodInvoke<TMethodTest8>(cls, {$ifdef fpc}@{$endif}cls.Test8, 8, [], [], TValue.{$ifdef fpc}specialize{$endif}From<ShortString>('Hello World'));
  1605. {$ifdef fpc}specialize{$endif} GenDoMethodInvoke<TMethodTest9>(cls, {$ifdef fpc}@{$endif}cls.Test9, 9, [
  1606. GetIntValue($1234), GetIntValue($4321), GetIntValue($8765), GetIntValue($5678)
  1607. ], [
  1608. GetIntValue($1234), GetIntValue($5678)
  1609. ], TValue.Empty);
  1610. {$ifdef fpc}specialize{$endif} GenDoMethodInvoke<TMethodTest10>(cls, {$ifdef fpc}@{$endif}cls.Test10, 10, [
  1611. GetAnsiString('Alpha'), GetAnsiString('Beta'), GetAnsiString(''), GetAnsiString('Delta')
  1612. ], [
  1613. GetAnsiString('Foo'), GetAnsiString('Bar')
  1614. ], TValue.Empty);
  1615. {$ifdef fpc}specialize{$endif} GenDoMethodInvoke<TMethodTest11>(cls, {$ifdef fpc}@{$endif}cls.Test11, 11, [
  1616. GetShortString('Alpha'), GetShortString('Beta'), GetShortString(''), GetShortString('Delta')
  1617. ], [
  1618. GetShortString('Foo'), GetShortString('Bar')
  1619. ], TValue.Empty);
  1620. {$ifdef fpc}
  1621. specialize GenDoMethodInvoke<TMethodTest12>(cls, {$ifdef fpc}@{$endif}cls.Test12, 12, [
  1622. GetArray([$1234, $2345, $3456, $4567]), GetArray([$4321, $5431, $6543, $7654]), GetArray([$5678, $6789, $7890, $8901]), GetArray([$8765, $7654, $6543, $5432])
  1623. ], [
  1624. GetArray([$4321, $4322, $4323, $4324]), GetArray([$9876, $9877, $9878, $9879])
  1625. ], TValue.Empty);
  1626. {$endif}
  1627. {$ifdef fpc}specialize{$endif} GenDoMethodInvoke<TMethodTest13>(cls, {$ifdef fpc}@{$endif}cls.Test13, 13, [
  1628. GetSingleValue(SingleArg1), GetSingleValue(SingleArg2In), GetSingleValue(0), GetSingleValue(SingleArg4)
  1629. ], [
  1630. GetSingleValue(SingleArg2Out), GetSingleValue(SingleArg3Out)
  1631. ], GetSingleValue(SingleRes));
  1632. {$ifdef fpc}specialize{$endif} GenDoMethodInvoke<TMethodTest14>(cls, {$ifdef fpc}@{$endif}cls.Test14, 14, [
  1633. GetDoubleValue(DoubleArg1), GetDoubleValue(DoubleArg2In), GetDoubleValue(0), GetDoubleValue(DoubleArg4)
  1634. ], [
  1635. GetDoubleValue(DoubleArg2Out), GetDoubleValue(DoubleArg3Out)
  1636. ], GetDoubleValue(DoubleRes));
  1637. {$ifdef fpc}specialize{$endif} GenDoMethodInvoke<TMethodTest15>(cls, {$ifdef fpc}@{$endif}cls.Test15, 15, [
  1638. GetExtendedValue(ExtendedArg1), GetExtendedValue(ExtendedArg2In), GetExtendedValue(0), GetExtendedValue(ExtendedArg4)
  1639. ], [
  1640. GetExtendedValue(ExtendedArg2Out), GetExtendedValue(ExtendedArg3Out)
  1641. ], GetExtendedValue(ExtendedRes));
  1642. {$ifdef fpc}specialize{$endif} GenDoMethodInvoke<TMethodTest16>(cls, {$ifdef fpc}@{$endif}cls.Test16, 16, [
  1643. GetCompValue(CompArg1), GetCompValue(CompArg2In), GetCompValue(0), GetCompValue(CompArg4)
  1644. ], [
  1645. GetCompValue(CompArg2Out), GetCompValue(CompArg3Out)
  1646. ], GetCompValue(CompRes));
  1647. {$ifdef fpc}specialize{$endif} GenDoMethodInvoke<TMethodTest17>(cls, {$ifdef fpc}@{$endif}cls.Test17, 17, [
  1648. GetCurrencyValue(CurrencyArg1), GetCurrencyValue(CurrencyArg2In), GetCurrencyValue(0), GetCurrencyValue(CurrencyArg4)
  1649. ], [
  1650. GetCurrencyValue(CurrencyArg2Out), GetCurrencyValue(CurrencyArg3Out)
  1651. ], GetCurrencyValue(CurrencyRes));
  1652. finally
  1653. cls.Free;
  1654. end;
  1655. end;
  1656. procedure TTestInvoke.TestMethodVarsRecs;
  1657. var
  1658. cls: TTestInterfaceClass;
  1659. begin
  1660. cls := TTestInterfaceClass.Create;
  1661. try
  1662. {$ifdef fpc}specialize{$endif} GenDoMethodInvoke<TMethodTestRecSize1>(cls, {$ifdef fpc}@{$endif}cls.TestRecSize1, 1 or TTestInterfaceClass.RecSizeMarker,
  1663. [{$ifdef fpc}specialize{$endif} GetRecValue<TTestRecord1>(False)], [],
  1664. {$ifdef fpc}specialize{$endif} GetRecValue<TTestRecord1>(True));
  1665. {$ifdef fpc}specialize{$endif} GenDoMethodInvoke<TMethodTestRecSize2>(cls, {$ifdef fpc}@{$endif}cls.TestRecSize2, 2 or TTestInterfaceClass.RecSizeMarker,
  1666. [{$ifdef fpc}specialize{$endif} GetRecValue<TTestRecord2>(False)], [],
  1667. {$ifdef fpc}specialize{$endif} GetRecValue<TTestRecord2>(True));
  1668. {$ifdef fpc}specialize{$endif} GenDoMethodInvoke<TMethodTestRecSize3>(cls, {$ifdef fpc}@{$endif}cls.TestRecSize3, 3 or TTestInterfaceClass.RecSizeMarker,
  1669. [{$ifdef fpc}specialize{$endif} GetRecValue<TTestRecord3>(False)], [],
  1670. {$ifdef fpc}specialize{$endif} GetRecValue<TTestRecord3>(True));
  1671. {$ifdef fpc}specialize{$endif} GenDoMethodInvoke<TMethodTestRecSize4>(cls, {$ifdef fpc}@{$endif}cls.TestRecSize4, 4 or TTestInterfaceClass.RecSizeMarker,
  1672. [{$ifdef fpc}specialize{$endif} GetRecValue<TTestRecord4>(False)], [],
  1673. {$ifdef fpc}specialize{$endif} GetRecValue<TTestRecord4>(True));
  1674. {$ifdef fpc}specialize{$endif} GenDoMethodInvoke<TMethodTestRecSize5>(cls, {$ifdef fpc}@{$endif}cls.TestRecSize5, 5 or TTestInterfaceClass.RecSizeMarker,
  1675. [{$ifdef fpc}specialize{$endif} GetRecValue<TTestRecord5>(False)], [],
  1676. {$ifdef fpc}specialize{$endif} GetRecValue<TTestRecord5>(True));
  1677. {$ifdef fpc}specialize{$endif} GenDoMethodInvoke<TMethodTestRecSize6>(cls, {$ifdef fpc}@{$endif}cls.TestRecSize6, 6 or TTestInterfaceClass.RecSizeMarker,
  1678. [{$ifdef fpc}specialize{$endif} GetRecValue<TTestRecord6>(False)], [],
  1679. {$ifdef fpc}specialize{$endif} GetRecValue<TTestRecord6>(True));
  1680. {$ifdef fpc}specialize{$endif} GenDoMethodInvoke<TMethodTestRecSize7>(cls, {$ifdef fpc}@{$endif}cls.TestRecSize7, 7 or TTestInterfaceClass.RecSizeMarker,
  1681. [{$ifdef fpc}specialize{$endif} GetRecValue<TTestRecord7>(False)], [],
  1682. {$ifdef fpc}specialize{$endif} GetRecValue<TTestRecord7>(True));
  1683. {$ifdef fpc}specialize{$endif} GenDoMethodInvoke<TMethodTestRecSize8>(cls, {$ifdef fpc}@{$endif}cls.TestRecSize8, 8 or TTestInterfaceClass.RecSizeMarker,
  1684. [{$ifdef fpc}specialize{$endif} GetRecValue<TTestRecord8>(False)], [],
  1685. {$ifdef fpc}specialize{$endif} GetRecValue<TTestRecord8>(True));
  1686. {$ifdef fpc}specialize{$endif} GenDoMethodInvoke<TMethodTestRecSize9>(cls, {$ifdef fpc}@{$endif}cls.TestRecSize9, 9 or TTestInterfaceClass.RecSizeMarker,
  1687. [{$ifdef fpc}specialize{$endif} GetRecValue<TTestRecord9>(False)], [],
  1688. {$ifdef fpc}specialize{$endif} GetRecValue<TTestRecord9>(True));
  1689. {$ifdef fpc}specialize{$endif} GenDoMethodInvoke<TMethodTestRecSize10>(cls, {$ifdef fpc}@{$endif}cls.TestRecSize10, 10 or TTestInterfaceClass.RecSizeMarker,
  1690. [{$ifdef fpc}specialize{$endif} GetRecValue<TTestRecord10>(False)], [],
  1691. {$ifdef fpc}specialize{$endif} GetRecValue<TTestRecord10>(True));
  1692. finally
  1693. cls.Free;
  1694. end;
  1695. end;
  1696. procedure TTestInvoke.TestProcVars;
  1697. var
  1698. cls: TTestInterfaceClass;
  1699. begin
  1700. cls := TTestInterfaceClass.Create;
  1701. try
  1702. {$ifdef fpc}specialize{$endif} GenDoProcVarInvoke<TProcVarTest1>(cls, {$ifdef fpc}@{$endif}ProcTest1, 1, [], [], TValue.Empty);
  1703. {$ifdef fpc}specialize{$endif} GenDoProcVarInvoke<TProcVarTest2>(cls, {$ifdef fpc}@{$endif}ProcTest2, 2, [], [], TValue.{$ifdef fpc}{$ifdef fpc}specialize{$endif}{$endif}From<SizeInt>(42));
  1704. {$ifdef fpc}specialize{$endif} GenDoProcVarInvoke<TProcVarTest3>(cls, {$ifdef fpc}@{$endif}ProcTest3, 3, [
  1705. GetIntValue(7), GetIntValue(2), GetIntValue(5), GetIntValue(1), GetIntValue(10), GetIntValue(8), GetIntValue(6), GetIntValue(3), GetIntValue(9), GetIntValue(3)
  1706. ], [], GetIntValue(42));
  1707. {$ifdef fpc}specialize{$endif} GenDoProcVarInvoke<TProcVarTest4>(cls, {$ifdef fpc}@{$endif}ProcTest4, 4, [
  1708. TValue.{$ifdef fpc}specialize{$endif}From<AnsiString>('Alpha'),
  1709. TValue.{$ifdef fpc}specialize{$endif}From<UnicodeString>('Beta'),
  1710. TValue.{$ifdef fpc}specialize{$endif}From<WideString>('Gamma'),
  1711. TValue.{$ifdef fpc}specialize{$endif}From<ShortString>('Delta')
  1712. ], [], TValue.Empty);
  1713. {$ifdef fpc}specialize{$endif} GenDoProcVarInvoke<TProcVarTest5>(cls, {$ifdef fpc}@{$endif}ProcTest5, 5, [], [], TValue.{$ifdef fpc}specialize{$endif}From<AnsiString>('Hello World'));
  1714. {$ifdef fpc}specialize{$endif} GenDoProcVarInvoke<TProcVarTest6>(cls, {$ifdef fpc}@{$endif}ProcTest6, 6, [], [], TValue.{$ifdef fpc}specialize{$endif}From<UnicodeString>('Hello World'));
  1715. {$ifdef fpc}specialize{$endif} GenDoProcVarInvoke<TProcVarTest7>(cls, {$ifdef fpc}@{$endif}ProcTest7, 7, [], [], TValue.{$ifdef fpc}specialize{$endif}From<WideString>('Hello World'));
  1716. {$ifdef fpc}specialize{$endif} GenDoProcVarInvoke<TProcVarTest8>(cls, {$ifdef fpc}@{$endif}ProcTest8, 8, [], [], TValue.{$ifdef fpc}specialize{$endif}From<ShortString>('Hello World'));
  1717. {$ifdef fpc}specialize{$endif} GenDoProcVarInvoke<TProcVarTest9>(cls, {$ifdef fpc}@{$endif}ProcTest9, 9, [
  1718. GetIntValue($1234), GetIntValue($4321), GetIntValue($8765), GetIntValue($5678)
  1719. ], [
  1720. GetIntValue($1234), GetIntValue($5678)
  1721. ], TValue.Empty);
  1722. {$ifdef fpc}specialize{$endif} GenDoProcVarInvoke<TProcVarTest10>(cls, {$ifdef fpc}@{$endif}ProcTest10, 10, [
  1723. GetAnsiString('Alpha'), GetAnsiString('Beta'), GetAnsiString(''), GetAnsiString('Delta')
  1724. ], [
  1725. GetAnsiString('Foo'), GetAnsiString('Bar')
  1726. ], TValue.Empty);
  1727. {$ifdef fpc}specialize{$endif} GenDoProcVarInvoke<TProcVarTest11>(cls, {$ifdef fpc}@{$endif}ProcTest11, 11, [
  1728. GetShortString('Alpha'), GetShortString('Beta'), GetShortString(''), GetShortString('Delta')
  1729. ], [
  1730. GetShortString('Foo'), GetShortString('Bar')
  1731. ], TValue.Empty);
  1732. {$ifdef fpc}
  1733. specialize GenDoProcVarInvoke<TProcVarTest12>(cls, {$ifdef fpc}@{$endif}ProcTest12, 12, [
  1734. GetArray([$1234, $2345, $3456, $4567]), GetArray([$4321, $5431, $6543, $7654]), GetArray([$5678, $6789, $7890, $8901]), GetArray([$8765, $7654, $6543, $5432])
  1735. ], [
  1736. GetArray([$4321, $4322, $4323, $4324]), GetArray([$9876, $9877, $9878, $9879])
  1737. ], TValue.Empty);
  1738. {$endif}
  1739. {$ifdef fpc}specialize{$endif} GenDoProcvarInvoke<TProcVarTest13>(cls, {$ifdef fpc}@{$endif}ProcTest13, 13, [
  1740. GetSingleValue(SingleArg1), GetSingleValue(SingleArg2In), GetSingleValue(0), GetSingleValue(SingleArg4)
  1741. ], [
  1742. GetSingleValue(SingleArg2Out), GetSingleValue(SingleArg3Out)
  1743. ], GetSingleValue(SingleRes));
  1744. {$ifdef fpc}specialize{$endif} GenDoProcvarInvoke<TProcVarTest14>(cls, {$ifdef fpc}@{$endif}ProcTest14, 14, [
  1745. GetDoubleValue(DoubleArg1), GetDoubleValue(DoubleArg2In), GetDoubleValue(0), GetDoubleValue(DoubleArg4)
  1746. ], [
  1747. GetDoubleValue(DoubleArg2Out), GetDoubleValue(DoubleArg3Out)
  1748. ], GetDoubleValue(DoubleRes));
  1749. {$ifdef fpc}specialize{$endif} GenDoProcvarInvoke<TProcVarTest15>(cls, {$ifdef fpc}@{$endif}ProcTest15, 15, [
  1750. GetExtendedValue(ExtendedArg1), GetExtendedValue(ExtendedArg2In), GetExtendedValue(0), GetExtendedValue(ExtendedArg4)
  1751. ], [
  1752. GetExtendedValue(ExtendedArg2Out), GetExtendedValue(ExtendedArg3Out)
  1753. ], GetExtendedValue(ExtendedRes));
  1754. {$ifdef fpc}specialize{$endif} GenDoProcvarInvoke<TProcVarTest16>(cls, {$ifdef fpc}@{$endif}ProcTest16, 16, [
  1755. GetCompValue(CompArg1), GetCompValue(CompArg2In), GetCompValue(0), GetCompValue(CompArg4)
  1756. ], [
  1757. GetCompValue(CompArg2Out), GetCompValue(CompArg3Out)
  1758. ], GetCompValue(CompRes));
  1759. {$ifdef fpc}specialize{$endif} GenDoProcvarInvoke<TProcVarTest17>(cls, {$ifdef fpc}@{$endif}ProcTest17, 17, [
  1760. GetCurrencyValue(CurrencyArg1), GetCurrencyValue(CurrencyArg2In), GetCurrencyValue(0), GetCurrencyValue(CurrencyArg4)
  1761. ], [
  1762. GetCurrencyValue(CurrencyArg2Out), GetCurrencyValue(CurrencyArg3Out)
  1763. ], GetCurrencyValue(CurrencyRes));
  1764. finally
  1765. cls.Free;
  1766. end;
  1767. end;
  1768. procedure TTestInvoke.TestProcVarsRecs;
  1769. var
  1770. cls: TTestInterfaceClass;
  1771. begin
  1772. cls := TTestInterfaceClass.Create;
  1773. try
  1774. {$ifdef fpc}specialize{$endif} GenDoProcVarInvoke<TProcVarTestRecSize1>(cls, {$ifdef fpc}@{$endif}ProcTestRecSize1, 1 or TTestInterfaceClass.RecSizeMarker,
  1775. [{$ifdef fpc}specialize{$endif} GetRecValue<TTestRecord1>(False)], [],
  1776. {$ifdef fpc}specialize{$endif} GetRecValue<TTestRecord1>(True));
  1777. {$ifdef fpc}specialize{$endif} GenDoProcVarInvoke<TProcVarTestRecSize2>(cls, {$ifdef fpc}@{$endif}ProcTestRecSize2, 2 or TTestInterfaceClass.RecSizeMarker,
  1778. [{$ifdef fpc}specialize{$endif} GetRecValue<TTestRecord2>(False)], [],
  1779. {$ifdef fpc}specialize{$endif} GetRecValue<TTestRecord2>(True));
  1780. {$ifdef fpc}specialize{$endif} GenDoProcVarInvoke<TProcVarTestRecSize3>(cls, {$ifdef fpc}@{$endif}ProcTestRecSize3, 3 or TTestInterfaceClass.RecSizeMarker,
  1781. [{$ifdef fpc}specialize{$endif} GetRecValue<TTestRecord3>(False)], [],
  1782. {$ifdef fpc}specialize{$endif} GetRecValue<TTestRecord3>(True));
  1783. {$ifdef fpc}specialize{$endif} GenDoProcVarInvoke<TProcVarTestRecSize4>(cls, {$ifdef fpc}@{$endif}ProcTestRecSize4, 4 or TTestInterfaceClass.RecSizeMarker,
  1784. [{$ifdef fpc}specialize{$endif} GetRecValue<TTestRecord4>(False)], [],
  1785. {$ifdef fpc}specialize{$endif} GetRecValue<TTestRecord4>(True));
  1786. {$ifdef fpc}specialize{$endif} GenDoProcVarInvoke<TProcVarTestRecSize5>(cls, {$ifdef fpc}@{$endif}ProcTestRecSize5, 5 or TTestInterfaceClass.RecSizeMarker,
  1787. [{$ifdef fpc}specialize{$endif} GetRecValue<TTestRecord5>(False)], [],
  1788. {$ifdef fpc}specialize{$endif} GetRecValue<TTestRecord5>(True));
  1789. {$ifdef fpc}specialize{$endif} GenDoProcVarInvoke<TProcVarTestRecSize6>(cls, {$ifdef fpc}@{$endif}ProcTestRecSize6, 6 or TTestInterfaceClass.RecSizeMarker,
  1790. [{$ifdef fpc}specialize{$endif} GetRecValue<TTestRecord6>(False)], [],
  1791. {$ifdef fpc}specialize{$endif} GetRecValue<TTestRecord6>(True));
  1792. {$ifdef fpc}specialize{$endif} GenDoProcVarInvoke<TProcVarTestRecSize7>(cls, {$ifdef fpc}@{$endif}ProcTestRecSize7, 7 or TTestInterfaceClass.RecSizeMarker,
  1793. [{$ifdef fpc}specialize{$endif} GetRecValue<TTestRecord7>(False)], [],
  1794. {$ifdef fpc}specialize{$endif} GetRecValue<TTestRecord7>(True));
  1795. {$ifdef fpc}specialize{$endif} GenDoProcVarInvoke<TProcVarTestRecSize8>(cls, {$ifdef fpc}@{$endif}ProcTestRecSize8, 8 or TTestInterfaceClass.RecSizeMarker,
  1796. [{$ifdef fpc}specialize{$endif} GetRecValue<TTestRecord8>(False)], [],
  1797. {$ifdef fpc}specialize{$endif} GetRecValue<TTestRecord8>(True));
  1798. {$ifdef fpc}specialize{$endif} GenDoProcVarInvoke<TProcVarTestRecSize9>(cls, {$ifdef fpc}@{$endif}ProcTestRecSize9, 9 or TTestInterfaceClass.RecSizeMarker,
  1799. [{$ifdef fpc}specialize{$endif} GetRecValue<TTestRecord9>(False)], [],
  1800. {$ifdef fpc}specialize{$endif} GetRecValue<TTestRecord9>(True));
  1801. {$ifdef fpc}specialize{$endif} GenDoProcVarInvoke<TProcVarTestRecSize10>(cls, {$ifdef fpc}@{$endif}ProcTestRecSize10, 10 or TTestInterfaceClass.RecSizeMarker,
  1802. [{$ifdef fpc}specialize{$endif} GetRecValue<TTestRecord10>(False)], [],
  1803. {$ifdef fpc}specialize{$endif} GetRecValue<TTestRecord10>(True));
  1804. finally
  1805. cls.Free;
  1806. end;
  1807. end;
  1808. begin
  1809. {$ifdef fpc}
  1810. RegisterTest(TTestInvoke);
  1811. {$else fpc}
  1812. RegisterTest(TTestInvoke.Suite);
  1813. {$endif fpc}
  1814. end.