tests.rtti.invoke.pas 117 KB

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