tests.rtti.invoke.pas 120 KB

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