tests.rtti.invoke.pas 120 KB

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