tests.rtti.invoke.pas 114 KB

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