tests.rtti.invoke.pas 108 KB

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