tcalobj4.pp 102 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294
  1. { %version=1.1 }
  2. {****************************************************************}
  3. { CODE GENERATOR TEST PROGRAM }
  4. { Copyright (c) 2002 Carl Eric Codere }
  5. {****************************************************************}
  6. { NODE TESTED : secondcalln() }
  7. {****************************************************************}
  8. { PRE-REQUISITES: secondload() }
  9. { secondassign() }
  10. { secondtypeconv() }
  11. { secondtryexcept() }
  12. {****************************************************************}
  13. { DEFINES: }
  14. { FPC = Target is FreePascal compiler }
  15. {****************************************************************}
  16. { REMARKS: This tests secondcalln(), genentrycode() and }
  17. { genexitcode() for standard object with the oldfpccall }
  18. { calling convention. }
  19. { }
  20. {****************************************************************}
  21. program tcalobj4;
  22. {$STATIC ON}
  23. {$R+}
  24. const
  25. { should be defined depending on CPU target }
  26. {$ifdef cpu68k}
  27. BIG_INDEX = 8000;
  28. SMALL_INDEX = 13;
  29. {$else}
  30. BIG_INDEX = 33000;
  31. SMALL_INDEX = 13; { value should not be aligned! }
  32. {$endif}
  33. RESULT_U8BIT = $55;
  34. RESULT_U16BIT = 2*RESULT_U8BIT;
  35. RESULT_S32BIT = $500F0000;
  36. RESULT_S64BIT = $500F0000;
  37. RESULT_S32REAL = 1777.12;
  38. RESULT_S64REAL = 3444.24;
  39. RESULT_BOOL8BIT = 1;
  40. RESULT_BOOL16BIT = 1;
  41. RESULT_BOOL32BIT = 1;
  42. RESULT_PCHAR = 'Hello world';
  43. RESULT_BIGSTRING = 'Hello world';
  44. RESULT_SMALLSTRING = 'H';
  45. RESULT_CHAR = 'I';
  46. RESULT_BOOLEAN = TRUE;
  47. type
  48. tprocedure = procedure;
  49. tsmallrecord = packed record
  50. b: byte;
  51. w: word;
  52. end;
  53. tlargerecord = packed record
  54. b: array[1..BIG_INDEX] of byte;
  55. end;
  56. tsmallarray = packed array[1..SMALL_INDEX] of byte;
  57. tsmallsetenum =
  58. (A_A,A_B,A_C,A_D);
  59. tsmallset = set of tsmallsetenum;
  60. tlargeset = set of char;
  61. tsmallstring = string[2];
  62. var
  63. global_u8bit : byte;
  64. global_u16bit : word;
  65. global_s32bit : longint;
  66. global_s32real : single;
  67. global_s64real : double;
  68. global_ptr : pchar;
  69. global_proc : tprocedure;
  70. global_bigstring : shortstring;
  71. global_boolean : boolean;
  72. global_char : char;
  73. global_s64bit : int64;
  74. value_s64bit : int64;
  75. value_ansistring : ansistring;
  76. value_u8bit : byte;
  77. value_u16bit : word;
  78. value_s32bit : longint;
  79. value_s32real : single;
  80. value_s64real : double;
  81. value_proc : tprocedure;
  82. value_ptr : pchar;
  83. value_smallrec : tsmallrecord;
  84. value_largerec : tlargerecord;
  85. value_smallset : tsmallset;
  86. value_smallstring : tsmallstring;
  87. value_bigstring : shortstring;
  88. value_largeset : tlargeset;
  89. value_smallarray : tsmallarray;
  90. value_boolean : boolean;
  91. value_char : char;
  92. procedure fail;
  93. begin
  94. WriteLn('Failure.');
  95. halt(1);
  96. end;
  97. procedure clear_globals;
  98. begin
  99. global_u8bit := 0;
  100. global_u16bit := 0;
  101. global_s32bit := 0;
  102. global_s32real := 0.0;
  103. global_s64real := 0.0;
  104. global_ptr := nil;
  105. global_proc := nil;
  106. global_bigstring := '';
  107. global_boolean := false;
  108. global_char := #0;
  109. global_s64bit := 0;
  110. end;
  111. procedure clear_values;
  112. begin
  113. value_u8bit := 0;
  114. value_u16bit := 0;
  115. value_s32bit := 0;
  116. value_s32real := 0.0;
  117. value_s64real := 0.0;
  118. value_proc := nil;
  119. value_ptr := nil;
  120. fillchar(value_smallrec, sizeof(value_smallrec), #0);
  121. fillchar(value_largerec, sizeof(value_largerec), #0);
  122. value_smallset := [];
  123. value_smallstring := '';
  124. value_bigstring := '';
  125. value_largeset := [];
  126. fillchar(value_smallarray, sizeof(value_smallarray), #0);
  127. value_boolean := false;
  128. value_char:=#0;
  129. value_ansistring := '';
  130. value_s64bit := 0;
  131. end;
  132. function getu8: byte;
  133. begin
  134. getu8 := RESULT_U8BIT;
  135. end;
  136. type
  137. { object without vmt }
  138. pnovmtobject = ^tnovmtobject;
  139. tnovmtobject = object
  140. public
  141. object_bigstring : shortstring;
  142. object_u16bit : word;
  143. { no parameter testing }
  144. procedure method_public_none;oldfpccall;
  145. procedure method_public_static_none; static;oldfpccall;
  146. procedure method_call_private_none;oldfpccall;
  147. procedure method_call_private_static_none; static;oldfpccall;
  148. { simple value parameter testing }
  149. procedure method_public_u8(x : byte);oldfpccall;
  150. procedure method_public_static_u8(x: byte); static;oldfpccall;
  151. procedure method_call_private_u8(x: byte);oldfpccall;
  152. procedure method_call_private_static_u8(x: byte); static;oldfpccall;
  153. function func_array_mixed_nested(b: byte): tsmallarray;oldfpccall;
  154. private
  155. procedure method_private_none;oldfpccall;
  156. procedure method_private_static_none; static;oldfpccall;
  157. function func_getu16bit : word;oldfpccall;
  158. { simple value parameter testing }
  159. procedure method_private_u8(x: byte);oldfpccall;
  160. procedure method_private_static_u8(x: byte); static;oldfpccall;
  161. end;
  162. { object with vmt }
  163. pvmtobject = ^tvmtobject;
  164. tvmtobject = object
  165. public
  166. object_u8bit : byte;
  167. object_u16bit : word;
  168. object_bigstring : shortstring;
  169. object_s32bit : longint;
  170. object_s64bit : int64;
  171. constructor constructor_params_mixed(u8 :byte; u16: word;
  172. bigstring: shortstring; s32: longint; s64: int64);
  173. constructor constructor_init;
  174. destructor destructor_params_done;
  175. procedure method_normal_params_mixed(u8 :byte; u16: word;
  176. bigstring: shortstring; s32: longint; s64: int64);oldfpccall;
  177. procedure method_virtual_params_mixed(u8 :byte; u16: word;
  178. bigstring: shortstring; s32: longint; s64: int64);virtual;oldfpccall;
  179. procedure method_virtual_overriden_params_mixed(u8 :byte; u16: word;
  180. bigstring: shortstring; s32: longint; s64: int64);virtual;oldfpccall;
  181. procedure method_static_params_mixed(u8 :byte; u16: word;
  182. bigstring: shortstring; s32: longint; s64: int64);static;oldfpccall;
  183. procedure method_normal_call_inherited_params_mixed(
  184. u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);oldfpccall;
  185. { virtual methods which call other methods }
  186. procedure method_virtual_call_static_params_mixed(
  187. u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;oldfpccall;
  188. procedure method_virtual_call_virtual_params_mixed(
  189. u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;oldfpccall;
  190. procedure method_virtual_call_overriden_params_mixed(
  191. u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;oldfpccall;
  192. procedure method_virtual_call_normal_params_mixed(
  193. u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;oldfpccall;
  194. procedure method_virtual_call_constructor_params_mixed(
  195. u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;oldfpccall;
  196. procedure method_virtual_call_inherited_params_mixed(
  197. u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;oldfpccall;
  198. end;
  199. pheritedvmtobject = ^theritedvmtobject;
  200. theritedvmtobject = object(tvmtobject)
  201. constructor constructor_params_mixed_call_virtual(u8 :byte; u16: word;
  202. bigstring: shortstring; s32: longint; s64: int64);
  203. constructor constructor_params_mixed_call_overriden(u8 :byte; u16: word;
  204. bigstring: shortstring; s32: longint; s64: int64);
  205. constructor constructor_params_mixed_call_static(u8 :byte; u16: word;
  206. bigstring: shortstring; s32: longint; s64: int64);
  207. constructor constructor_params_mixed_call_normal(u8 :byte; u16: word;
  208. bigstring: shortstring; s32: longint; s64: int64);
  209. constructor constructor_params_mixed_call_inherited(u8 :byte; u16: word;
  210. bigstring: shortstring; s32: longint; s64: int64);
  211. procedure method_virtual_overriden_params_mixed(
  212. u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;oldfpccall;
  213. { normal methods which call other methods }
  214. procedure method_normal_call_static_params_mixed(
  215. u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);oldfpccall;
  216. procedure method_normal_call_virtual_params_mixed(
  217. u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);oldfpccall;
  218. procedure method_normal_call_overriden_params_mixed(
  219. u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);oldfpccall;
  220. procedure method_normal_call_normal_params_mixed(
  221. u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);oldfpccall;
  222. procedure method_normal_call_constructor_params_mixed(
  223. u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);oldfpccall;
  224. procedure method_normal_call_inherited_params_mixed(
  225. u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);oldfpccall;
  226. { virtual methods which call other methods }
  227. procedure method_virtual_call_inherited_params_mixed(
  228. u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;oldfpccall;
  229. end;
  230. pfailvmtobject = ^tfailvmtobject;
  231. tfailvmtobject = object(tvmtobject)
  232. public
  233. constructor constructor_public_none;
  234. end;
  235. {**************************************************************************}
  236. { NO VMT OBJECT }
  237. {**************************************************************************}
  238. {****************** NO PARAMETERS ******************}
  239. procedure tnovmtobject.method_public_none;oldfpccall;
  240. begin
  241. global_u8bit := RESULT_U8BIT;
  242. end;
  243. procedure tnovmtobject.method_public_static_none;oldfpccall;
  244. begin
  245. global_u8bit := RESULT_U8BIT;
  246. end;
  247. procedure tnovmtobject.method_call_private_none;oldfpccall;
  248. begin
  249. method_private_none;
  250. method_private_static_none;
  251. end;
  252. procedure tnovmtobject.method_call_private_static_none;oldfpccall;
  253. begin
  254. method_private_static_none;
  255. end;
  256. procedure tnovmtobject.method_private_none;oldfpccall;
  257. begin
  258. Inc(global_u16bit, RESULT_U8BIT);
  259. end;
  260. procedure tnovmtobject.method_private_static_none;oldfpccall;
  261. begin
  262. Inc(global_u16bit, RESULT_U8BIT);
  263. end;
  264. {******************** PARAMETERS ******************}
  265. procedure tnovmtobject.method_public_u8(x : byte);oldfpccall;
  266. begin
  267. global_u8bit := x;
  268. end;
  269. procedure tnovmtobject.method_public_static_u8(x: byte);oldfpccall;
  270. begin
  271. global_u8bit := x;
  272. end;
  273. procedure tnovmtobject.method_call_private_u8(x: byte);oldfpccall;
  274. begin
  275. method_private_static_u8(x);
  276. method_private_u8(x);
  277. end;
  278. procedure tnovmtobject. method_call_private_static_u8(x: byte);oldfpccall;
  279. begin
  280. method_private_static_u8(x);
  281. end;
  282. procedure tnovmtobject.method_private_u8(x: byte);oldfpccall;
  283. begin
  284. Inc(global_u16bit,x);
  285. end;
  286. procedure tnovmtobject.method_private_static_u8(x: byte);oldfpccall;
  287. begin
  288. Inc(global_u16bit,x);
  289. end;
  290. function tnovmtobject.func_getu16bit : word;oldfpccall;
  291. begin
  292. func_getu16bit := object_u16bit;
  293. end;
  294. {
  295. complex testing, nested field access, with parameters and
  296. comple return value.
  297. On exit : global_u8bit := x;
  298. global_u16bit := object_u16bit (from func_getu16bit);
  299. global_s32bit := RESULT_S32BIT
  300. global_bigstring := object_bigstring
  301. global_s64bit := x;
  302. }
  303. function tnovmtobject.func_array_mixed_nested(b: byte): tsmallarray;oldfpccall;
  304. procedure nested_one_proc(l: longint);
  305. begin
  306. global_u16bit := func_getu16bit;
  307. global_s32bit := l;
  308. end;
  309. procedure nested_two_proc(l : longint);
  310. begin
  311. global_s64bit := l;
  312. end;
  313. function nested_one_func(level1_b : byte; s: shortstring): byte;
  314. var
  315. s1 : shortstring;
  316. function nested_two_func(level2_b : byte; s :shortstring): byte;
  317. begin
  318. nested_two_func:=level2_b;
  319. global_bigstring := s;
  320. nested_one_proc(RESULT_S32BIT);
  321. end;
  322. begin
  323. s1:=s;
  324. nested_one_func := nested_two_func(level1_b,s1);
  325. nested_two_proc(level1_b);
  326. end;
  327. var
  328. local_b: byte;
  329. smallarray: tsmallarray;
  330. begin
  331. fillchar(smallarray, sizeof(smallarray), #0);
  332. smallarray[1] := RESULT_U8BIT;
  333. smallarray[SMALL_INDEX] := RESULT_U8BIT;
  334. func_array_mixed_nested := smallarray;
  335. local_b:=b;
  336. global_u8bit := nested_one_func(local_b, object_bigstring);
  337. end;
  338. {**************************************************************************}
  339. { FAILED OBJECT }
  340. {**************************************************************************}
  341. constructor tfailvmtobject.constructor_public_none;
  342. begin
  343. { this calls the constructor fail special keyword }
  344. fail;
  345. end;
  346. {**************************************************************************}
  347. { VMT OBJECT }
  348. {**************************************************************************}
  349. constructor tvmtobject.constructor_params_mixed(u8 :byte; u16: word;
  350. bigstring: shortstring; s32: longint; s64: int64);
  351. begin
  352. object_u8bit := u8;
  353. object_u16bit := u16;
  354. object_bigstring := bigstring;
  355. object_s32bit := s32;
  356. object_s64bit := s64;
  357. end;
  358. constructor tvmtobject.constructor_init;
  359. begin
  360. object_u8bit := 0;
  361. object_u16bit := 0;
  362. object_bigstring := '';
  363. object_s32bit := 0;
  364. object_s64bit := 0;
  365. end;
  366. destructor tvmtobject.destructor_params_done;
  367. begin
  368. object_u8bit := 0;
  369. object_u16bit := 0;
  370. object_bigstring := '';
  371. object_s32bit := 0;
  372. object_s64bit := 0;
  373. end;
  374. procedure tvmtobject.method_normal_params_mixed(
  375. u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);oldfpccall;
  376. begin
  377. object_u8bit := u8;
  378. object_u16bit := u16;
  379. object_bigstring := bigstring;
  380. object_s32bit := s32;
  381. object_s64bit := s64;
  382. end;
  383. procedure tvmtobject.method_virtual_params_mixed(
  384. u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);oldfpccall;
  385. begin
  386. object_u8bit := u8;
  387. object_u16bit := u16;
  388. object_bigstring := bigstring;
  389. object_s32bit := s32;
  390. object_s64bit := s64;
  391. end;
  392. { this one should be overriden }
  393. procedure tvmtobject.method_virtual_overriden_params_mixed(
  394. u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);oldfpccall;
  395. begin
  396. RunError(211);
  397. end;
  398. { can't access field of instances in static methods }
  399. procedure tvmtobject.method_static_params_mixed(
  400. u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);oldfpccall;
  401. begin
  402. global_u8bit := u8;
  403. global_u16bit := u16;
  404. global_bigstring := bigstring;
  405. global_s32bit := s32;
  406. global_s64bit := s64;
  407. end;
  408. procedure tvmtobject.method_normal_call_inherited_params_mixed(
  409. u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);oldfpccall;
  410. begin
  411. object_u8bit := u8;
  412. object_u16bit := u16;
  413. object_bigstring := bigstring;
  414. object_s32bit := s32;
  415. object_s64bit := s64;
  416. end;
  417. procedure tvmtobject.method_virtual_call_static_params_mixed(
  418. u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);oldfpccall;
  419. begin
  420. method_static_params_mixed(u8, u16, bigstring, s32, s64);
  421. end;
  422. procedure tvmtobject.method_virtual_call_virtual_params_mixed(
  423. u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);oldfpccall;
  424. begin
  425. method_virtual_params_mixed(u8, u16, bigstring, s32, s64);
  426. end;
  427. procedure tvmtobject.method_virtual_call_overriden_params_mixed(
  428. u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);oldfpccall;
  429. begin
  430. method_virtual_overriden_params_mixed(u8, u16, bigstring, s32, s64);
  431. end;
  432. procedure tvmtobject.method_virtual_call_normal_params_mixed(
  433. u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);oldfpccall;
  434. begin
  435. method_normal_params_mixed(u8, u16, bigstring, s32, s64);
  436. end;
  437. procedure tvmtobject.method_virtual_call_constructor_params_mixed(
  438. u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);oldfpccall;
  439. begin
  440. constructor_params_mixed(u8, u16, bigstring, s32, s64);
  441. end;
  442. procedure tvmtobject.method_virtual_call_inherited_params_mixed(
  443. u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);oldfpccall;
  444. begin
  445. object_u8bit := u8;
  446. object_u16bit := u16;
  447. object_bigstring := bigstring;
  448. object_s32bit := s32;
  449. object_s64bit := s64;
  450. end;
  451. {**************************************************************************}
  452. { INHERITED VMT OBJECT }
  453. {**************************************************************************}
  454. constructor theritedvmtobject.constructor_params_mixed_call_virtual(
  455. u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
  456. begin
  457. object_u8bit := 0;
  458. object_u16bit := 0;
  459. object_bigstring := '';
  460. object_s32bit := 0;
  461. object_s64bit := 0;
  462. method_virtual_params_mixed(u8, u16, bigstring, s32, s64);
  463. end;
  464. constructor theritedvmtobject.constructor_params_mixed_call_overriden(
  465. u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
  466. begin
  467. object_u8bit := 0;
  468. object_u16bit := 0;
  469. object_bigstring := '';
  470. object_s32bit := 0;
  471. object_s64bit := 0;
  472. method_virtual_overriden_params_mixed(u8, u16, bigstring, s32, s64);
  473. end;
  474. constructor theritedvmtobject.constructor_params_mixed_call_static(
  475. u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
  476. begin
  477. object_u8bit := 0;
  478. object_u16bit := 0;
  479. object_bigstring := '';
  480. object_s32bit := 0;
  481. object_s64bit := 0;
  482. method_static_params_mixed(u8, u16, bigstring, s32, s64);
  483. end;
  484. constructor theritedvmtobject.constructor_params_mixed_call_normal(
  485. u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
  486. begin
  487. object_u8bit := 0;
  488. object_u16bit := 0;
  489. object_bigstring := '';
  490. object_s32bit := 0;
  491. object_s64bit := 0;
  492. method_normal_params_mixed(u8, u16, bigstring, s32, s64);
  493. end;
  494. constructor theritedvmtobject.constructor_params_mixed_call_inherited
  495. (u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
  496. begin
  497. object_u8bit := 0;
  498. object_u16bit := 0;
  499. object_bigstring := '';
  500. object_s32bit := 0;
  501. object_s64bit := 0;
  502. inherited constructor_params_mixed(u8, u16, bigstring, s32, s64);
  503. end;
  504. { this one should be overriden }
  505. procedure theritedvmtobject.method_virtual_overriden_params_mixed(
  506. u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);oldfpccall;
  507. begin
  508. object_u8bit := u8;
  509. object_u16bit := u16;
  510. object_bigstring := bigstring;
  511. object_s32bit := s32;
  512. object_s64bit := s64;
  513. end;
  514. procedure theritedvmtobject.method_normal_call_static_params_mixed(
  515. u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);oldfpccall;
  516. begin
  517. method_static_params_mixed(u8, u16, bigstring, s32, s64);
  518. end;
  519. procedure theritedvmtobject.method_normal_call_virtual_params_mixed(
  520. u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);oldfpccall;
  521. begin
  522. method_virtual_params_mixed(u8, u16, bigstring, s32, s64);
  523. end;
  524. procedure theritedvmtobject.method_normal_call_overriden_params_mixed(
  525. u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);oldfpccall;
  526. begin
  527. method_virtual_overriden_params_mixed(u8, u16, bigstring, s32, s64);
  528. end;
  529. procedure theritedvmtobject.method_normal_call_normal_params_mixed(
  530. u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);oldfpccall;
  531. begin
  532. method_normal_params_mixed(u8, u16, bigstring, s32, s64);
  533. end;
  534. procedure theritedvmtobject.method_normal_call_constructor_params_mixed(
  535. u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);oldfpccall;
  536. begin
  537. constructor_params_mixed(u8, u16, bigstring, s32, s64);
  538. end;
  539. procedure theritedvmtobject.method_normal_call_inherited_params_mixed(
  540. u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);oldfpccall;
  541. begin
  542. Inherited method_normal_call_inherited_params_mixed(u8, u16, bigstring,
  543. s32, s64);
  544. end;
  545. procedure theritedvmtobject.method_virtual_call_inherited_params_mixed(
  546. u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);oldfpccall;
  547. begin
  548. Inherited method_virtual_call_inherited_params_mixed(u8, u16, bigstring,
  549. s32, s64);
  550. end;
  551. procedure testnovmtobject;
  552. var
  553. novmtobject : tnovmtobject;
  554. failed : boolean;
  555. begin
  556. {******************** STATIC / METHOD SIMPLE CALL **********************}
  557. Write('No parameter / method call testing...');
  558. failed := false;
  559. clear_globals;
  560. clear_values;
  561. tnovmtobject.method_public_static_none;
  562. if global_u8bit <> RESULT_U8BIT then
  563. failed := true;
  564. clear_globals;
  565. clear_values;
  566. novmtobject.method_public_static_none;
  567. if global_u8bit <> RESULT_U8BIT then
  568. failed := true;
  569. clear_globals;
  570. clear_values;
  571. tnovmtobject.method_call_private_static_none;
  572. if global_u16bit <> RESULT_U8BIT then
  573. failed := true;
  574. clear_globals;
  575. clear_values;
  576. novmtobject.method_call_private_static_none;
  577. if global_u16bit <> RESULT_U8BIT then
  578. failed := true;
  579. clear_globals;
  580. clear_values;
  581. novmtobject.method_public_none;
  582. if global_u8bit <> RESULT_U8BIT then
  583. failed := true;
  584. clear_globals;
  585. clear_values;
  586. novmtobject.method_call_private_none;
  587. if global_u16bit <> (RESULT_U16BIT) then
  588. failed := true;
  589. if failed then
  590. fail
  591. else
  592. WriteLn('Passed!');
  593. Write('Simple parameter (LOC_CONSTANT) / method call testing...');
  594. failed := false;
  595. clear_globals;
  596. clear_values;
  597. { parameter is LOC_CONSTANT }
  598. novmtobject.method_public_u8(RESULT_U8BIT);
  599. if global_u8bit <> RESULT_U8BIT then
  600. failed := true;
  601. clear_globals;
  602. clear_values;
  603. tnovmtobject.method_public_static_u8(RESULT_U8BIT);
  604. if global_u8bit <> RESULT_U8BIT then
  605. failed := true;
  606. clear_globals;
  607. clear_values;
  608. novmtobject.method_public_static_u8(RESULT_U8BIT);
  609. if global_u8bit <> RESULT_U8BIT then
  610. failed := true;
  611. clear_globals;
  612. clear_values;
  613. novmtobject.method_call_private_u8(RESULT_U8BIT);
  614. if global_u16bit <> (RESULT_U16BIT) then
  615. failed := true;
  616. clear_globals;
  617. clear_values;
  618. novmtobject.method_call_private_static_u8(RESULT_U8BIT);
  619. if global_u16bit <> (RESULT_U8BIT) then
  620. failed := true;
  621. if failed then
  622. fail
  623. else
  624. WriteLn('Passed!');
  625. Write('Simple parameter (LOC_REFERENCE) / method call testing...');
  626. failed := false;
  627. clear_globals;
  628. clear_values;
  629. value_u8bit := RESULT_U8BIT;
  630. novmtobject.method_public_u8(value_u8bit);
  631. if global_u8bit <> RESULT_U8BIT then
  632. failed := true;
  633. clear_globals;
  634. clear_values;
  635. value_u8bit := RESULT_U8BIT;
  636. tnovmtobject.method_public_static_u8(value_u8bit);
  637. if global_u8bit <> RESULT_U8BIT then
  638. failed := true;
  639. clear_globals;
  640. clear_values;
  641. value_u8bit := RESULT_U8BIT;
  642. novmtobject.method_public_static_u8(value_u8bit);
  643. if global_u8bit <> RESULT_U8BIT then
  644. failed := true;
  645. clear_globals;
  646. clear_values;
  647. value_u8bit := RESULT_U8BIT;
  648. novmtobject.method_call_private_u8(value_u8bit);
  649. if global_u16bit <> (RESULT_U16BIT) then
  650. failed := true;
  651. clear_globals;
  652. clear_values;
  653. value_u8bit := RESULT_U8BIT;
  654. novmtobject.method_call_private_static_u8(value_u8bit);
  655. if global_u16bit <> (RESULT_U8BIT) then
  656. failed := true;
  657. if failed then
  658. fail
  659. else
  660. WriteLn('Passed!');
  661. Write('Simple parameter (LOC_REGISTER) / method call testing...');
  662. failed := false;
  663. clear_globals;
  664. clear_values;
  665. novmtobject.method_public_u8(getu8);
  666. if global_u8bit <> RESULT_U8BIT then
  667. failed := true;
  668. clear_globals;
  669. clear_values;
  670. tnovmtobject.method_public_static_u8(getu8);
  671. if global_u8bit <> RESULT_U8BIT then
  672. failed := true;
  673. clear_globals;
  674. clear_values;
  675. novmtobject.method_public_static_u8(getu8);
  676. if global_u8bit <> RESULT_U8BIT then
  677. failed := true;
  678. clear_globals;
  679. clear_values;
  680. novmtobject.method_call_private_u8(getu8);
  681. if global_u16bit <> (RESULT_U16BIT) then
  682. failed := true;
  683. clear_globals;
  684. clear_values;
  685. novmtobject.method_call_private_static_u8(getu8);
  686. if global_u16bit <> (RESULT_U8BIT) then
  687. failed := true;
  688. if failed then
  689. fail
  690. else
  691. WriteLn('Passed!');
  692. Write('Simple parameter / complex return / nested method access testing...');
  693. clear_globals;
  694. clear_values;
  695. failed := false;
  696. novmtobject.object_bigstring := RESULT_BIGSTRING;
  697. novmtobject.object_u16bit := RESULT_U16BIT;
  698. value_smallarray := novmtobject.func_array_mixed_nested(RESULT_U8BIT);
  699. if (value_smallarray[1] <> RESULT_U8BIT) or (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) then
  700. failed := true;
  701. if global_u8bit <> RESULT_U8BIT then
  702. failed := true;
  703. if global_bigstring <> RESULT_BIGSTRING then
  704. failed := true;
  705. if global_u16bit <> RESULT_U16BIT then
  706. failed := true;
  707. if global_s32bit <> RESULT_S32BIT then
  708. failed := true;
  709. if global_s64bit <> RESULT_U8BIT then
  710. failed := true;
  711. if failed then
  712. fail
  713. else
  714. WriteLn('Passed!');
  715. end;
  716. procedure testfailedobject;
  717. var
  718. failedobject : tfailvmtobject;
  719. begin
  720. Write('Testing constructor return value...');
  721. if failedobject.constructor_public_none then
  722. fail
  723. else
  724. Writeln('Passed!');
  725. end;
  726. procedure testvmtobject;
  727. var
  728. vmtobject : tvmtobject;
  729. failed : boolean;
  730. begin
  731. clear_globals;
  732. clear_values;
  733. failed := false;
  734. Write('Testing mixed parameter (LOC_CONSTANT) constructor call...');
  735. vmtobject.constructor_params_mixed(RESULT_U8BIT, RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
  736. if vmtobject.object_u8bit <> RESULT_U8BIT then
  737. failed := true;
  738. if vmtobject.object_u16bit <> RESULT_U16BIT then
  739. failed := true;
  740. if vmtobject.object_s32bit <> RESULT_S32BIT then
  741. failed := true;
  742. if vmtobject.object_s64bit <> RESULT_S64BIT then
  743. failed := true;
  744. if vmtobject.object_bigstring <> RESULT_BIGSTRING then
  745. failed := true;
  746. vmtobject.destructor_params_done;
  747. if failed then
  748. fail
  749. else
  750. Writeln('Passed!');
  751. clear_globals;
  752. clear_values;
  753. failed := false;
  754. Write('Testing mixed parameter (LOC_REFERENCE) constructor call...');
  755. value_u8bit := RESULT_U8BIT;
  756. value_u16bit := RESULT_U16BIT;
  757. value_bigstring := RESULT_BIGSTRING;
  758. value_s32bit := RESULT_S32BIT;
  759. value_s64bit := RESULT_S64BIT;
  760. vmtobject.constructor_params_mixed(value_u8bit, value_u16bit, value_bigstring,
  761. value_s32bit, value_s64bit);
  762. if vmtobject.object_u8bit <> RESULT_U8BIT then
  763. failed := true;
  764. if vmtobject.object_u16bit <> RESULT_U16BIT then
  765. failed := true;
  766. if vmtobject.object_s32bit <> RESULT_S32BIT then
  767. failed := true;
  768. if vmtobject.object_s64bit <> RESULT_S64BIT then
  769. failed := true;
  770. if vmtobject.object_bigstring <> RESULT_BIGSTRING then
  771. failed := true;
  772. vmtobject.destructor_params_done;
  773. if failed then
  774. fail
  775. else
  776. Writeln('Passed!');
  777. end;
  778. procedure testheritedvmtobject;
  779. var
  780. vmtobject : theritedvmtobject;
  781. failed : boolean;
  782. begin
  783. {********************** CONSTRUCTOR TESTING ************************}
  784. {********************** DESTRUCTOR TESTING ************************}
  785. clear_globals;
  786. clear_values;
  787. failed := false;
  788. Write('Testing mixed parameter (LOC_CONSTANT) inherited constructor call...');
  789. vmtobject.constructor_params_mixed_call_inherited(RESULT_U8BIT, RESULT_U16BIT, RESULT_BIGSTRING,
  790. RESULT_S32BIT, RESULT_S64BIT);
  791. if vmtobject.object_u8bit <> RESULT_U8BIT then
  792. failed := true;
  793. if vmtobject.object_u16bit <> RESULT_U16BIT then
  794. failed := true;
  795. if vmtobject.object_s32bit <> RESULT_S32BIT then
  796. failed := true;
  797. if vmtobject.object_s64bit <> RESULT_S64BIT then
  798. failed := true;
  799. if vmtobject.object_bigstring <> RESULT_BIGSTRING then
  800. failed := true;
  801. vmtobject.destructor_params_done;
  802. if failed then
  803. fail
  804. else
  805. Writeln('Passed!');
  806. clear_globals;
  807. clear_values;
  808. failed := false;
  809. Write('Testing mixed parameter (LOC_REFERENCE) inherited constructor call...');
  810. value_u8bit := RESULT_U8BIT;
  811. value_u16bit := RESULT_U16BIT;
  812. value_bigstring := RESULT_BIGSTRING;
  813. value_s32bit := RESULT_S32BIT;
  814. value_s64bit := RESULT_S64BIT;
  815. vmtobject.constructor_params_mixed_call_inherited(value_u8bit,
  816. value_u16bit, value_bigstring, value_s32bit, value_s64bit);
  817. if vmtobject.object_u8bit <> RESULT_U8BIT then
  818. failed := true;
  819. if vmtobject.object_u16bit <> RESULT_U16BIT then
  820. failed := true;
  821. if vmtobject.object_s32bit <> RESULT_S32BIT then
  822. failed := true;
  823. if vmtobject.object_s64bit <> RESULT_S64BIT then
  824. failed := true;
  825. if vmtobject.object_bigstring <> RESULT_BIGSTRING then
  826. failed := true;
  827. vmtobject.destructor_params_done;
  828. if failed then
  829. fail
  830. else
  831. Writeln('Passed!');
  832. clear_globals;
  833. clear_values;
  834. failed := false;
  835. Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/virtual call...');
  836. vmtobject.constructor_params_mixed_call_virtual(RESULT_U8BIT,
  837. RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
  838. if vmtobject.object_u8bit <> RESULT_U8BIT then
  839. failed := true;
  840. if vmtobject.object_u16bit <> RESULT_U16BIT then
  841. failed := true;
  842. if vmtobject.object_s32bit <> RESULT_S32BIT then
  843. failed := true;
  844. if vmtobject.object_s64bit <> RESULT_S64BIT then
  845. failed := true;
  846. if vmtobject.object_bigstring <> RESULT_BIGSTRING then
  847. failed := true;
  848. vmtobject.destructor_params_done;
  849. if failed then
  850. fail
  851. else
  852. Writeln('Passed!');
  853. clear_globals;
  854. clear_values;
  855. failed := false;
  856. Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/virtual call...');
  857. value_u8bit := RESULT_U8BIT;
  858. value_u16bit := RESULT_U16BIT;
  859. value_bigstring := RESULT_BIGSTRING;
  860. value_s32bit := RESULT_S32BIT;
  861. value_s64bit := RESULT_S64BIT;
  862. vmtobject.constructor_params_mixed_call_virtual(value_u8bit,
  863. value_u16bit, value_bigstring, value_s32bit, value_s64bit);
  864. if vmtobject.object_u8bit <> RESULT_U8BIT then
  865. failed := true;
  866. if vmtobject.object_u16bit <> RESULT_U16BIT then
  867. failed := true;
  868. if vmtobject.object_s32bit <> RESULT_S32BIT then
  869. failed := true;
  870. if vmtobject.object_s64bit <> RESULT_S64BIT then
  871. failed := true;
  872. if vmtobject.object_bigstring <> RESULT_BIGSTRING then
  873. failed := true;
  874. vmtobject.destructor_params_done;
  875. if failed then
  876. fail
  877. else
  878. Writeln('Passed!');
  879. clear_globals;
  880. clear_values;
  881. failed := false;
  882. Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/virtual call...');
  883. vmtobject.constructor_params_mixed_call_overriden(RESULT_U8BIT,
  884. RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
  885. if vmtobject.object_u8bit <> RESULT_U8BIT then
  886. failed := true;
  887. if vmtobject.object_u16bit <> RESULT_U16BIT then
  888. failed := true;
  889. if vmtobject.object_s32bit <> RESULT_S32BIT then
  890. failed := true;
  891. if vmtobject.object_s64bit <> RESULT_S64BIT then
  892. failed := true;
  893. if vmtobject.object_bigstring <> RESULT_BIGSTRING then
  894. failed := true;
  895. vmtobject.destructor_params_done;
  896. if failed then
  897. fail
  898. else
  899. Writeln('Passed!');
  900. clear_globals;
  901. clear_values;
  902. failed := false;
  903. Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/virtual call...');
  904. value_u8bit := RESULT_U8BIT;
  905. value_u16bit := RESULT_U16BIT;
  906. value_bigstring := RESULT_BIGSTRING;
  907. value_s32bit := RESULT_S32BIT;
  908. value_s64bit := RESULT_S64BIT;
  909. vmtobject.constructor_params_mixed_call_overriden(value_u8bit,
  910. value_u16bit, value_bigstring, value_s32bit, value_s64bit);
  911. if vmtobject.object_u8bit <> RESULT_U8BIT then
  912. failed := true;
  913. if vmtobject.object_u16bit <> RESULT_U16BIT then
  914. failed := true;
  915. if vmtobject.object_s32bit <> RESULT_S32BIT then
  916. failed := true;
  917. if vmtobject.object_s64bit <> RESULT_S64BIT then
  918. failed := true;
  919. if vmtobject.object_bigstring <> RESULT_BIGSTRING then
  920. failed := true;
  921. vmtobject.destructor_params_done;
  922. if failed then
  923. fail
  924. else
  925. Writeln('Passed!');
  926. clear_globals;
  927. clear_values;
  928. failed := false;
  929. Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/method call...');
  930. vmtobject.constructor_params_mixed_call_normal(RESULT_U8BIT,
  931. RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
  932. if vmtobject.object_u8bit <> RESULT_U8BIT then
  933. failed := true;
  934. if vmtobject.object_u16bit <> RESULT_U16BIT then
  935. failed := true;
  936. if vmtobject.object_s32bit <> RESULT_S32BIT then
  937. failed := true;
  938. if vmtobject.object_s64bit <> RESULT_S64BIT then
  939. failed := true;
  940. if vmtobject.object_bigstring <> RESULT_BIGSTRING then
  941. failed := true;
  942. vmtobject.destructor_params_done;
  943. if failed then
  944. fail
  945. else
  946. Writeln('Passed!');
  947. clear_globals;
  948. clear_values;
  949. failed := false;
  950. Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/method call...');
  951. value_u8bit := RESULT_U8BIT;
  952. value_u16bit := RESULT_U16BIT;
  953. value_bigstring := RESULT_BIGSTRING;
  954. value_s32bit := RESULT_S32BIT;
  955. value_s64bit := RESULT_S64BIT;
  956. vmtobject.constructor_params_mixed_call_normal(value_u8bit,
  957. value_u16bit, value_bigstring, value_s32bit, value_s64bit);
  958. if vmtobject.object_u8bit <> RESULT_U8BIT then
  959. failed := true;
  960. if vmtobject.object_u16bit <> RESULT_U16BIT then
  961. failed := true;
  962. if vmtobject.object_s32bit <> RESULT_S32BIT then
  963. failed := true;
  964. if vmtobject.object_s64bit <> RESULT_S64BIT then
  965. failed := true;
  966. if vmtobject.object_bigstring <> RESULT_BIGSTRING then
  967. failed := true;
  968. vmtobject.destructor_params_done;
  969. if failed then
  970. fail
  971. else
  972. Writeln('Passed!');
  973. clear_globals;
  974. clear_values;
  975. failed := false;
  976. Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/static call...');
  977. vmtobject.constructor_params_mixed_call_static(RESULT_U8BIT,
  978. RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
  979. if global_u8bit <> RESULT_U8BIT then
  980. failed := true;
  981. if global_u16bit <> RESULT_U16BIT then
  982. failed := true;
  983. if global_s32bit <> RESULT_S32BIT then
  984. failed := true;
  985. if global_s64bit <> RESULT_S64BIT then
  986. failed := true;
  987. if global_bigstring <> RESULT_BIGSTRING then
  988. failed := true;
  989. vmtobject.destructor_params_done;
  990. if failed then
  991. fail
  992. else
  993. Writeln('Passed!');
  994. clear_globals;
  995. clear_values;
  996. failed := false;
  997. Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/static call...');
  998. value_u8bit := RESULT_U8BIT;
  999. value_u16bit := RESULT_U16BIT;
  1000. value_bigstring := RESULT_BIGSTRING;
  1001. value_s32bit := RESULT_S32BIT;
  1002. value_s64bit := RESULT_S64BIT;
  1003. vmtobject.constructor_params_mixed_call_static(value_u8bit,
  1004. value_u16bit, value_bigstring, value_s32bit, value_s64bit);
  1005. if global_u8bit <> RESULT_U8BIT then
  1006. failed := true;
  1007. if global_u16bit <> RESULT_U16BIT then
  1008. failed := true;
  1009. if global_s32bit <> RESULT_S32BIT then
  1010. failed := true;
  1011. if global_s64bit <> RESULT_S64BIT then
  1012. failed := true;
  1013. if global_bigstring <> RESULT_BIGSTRING then
  1014. failed := true;
  1015. vmtobject.destructor_params_done;
  1016. if failed then
  1017. fail
  1018. else
  1019. Writeln('Passed!');
  1020. {************************* METHOD TESTING **************************}
  1021. clear_globals;
  1022. clear_values;
  1023. failed := false;
  1024. vmtobject.constructor_init;
  1025. Write('Testing mixed parameter (LOC_CONSTANT) virtual method call...');
  1026. vmtobject.method_virtual_params_mixed(RESULT_U8BIT,
  1027. RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
  1028. if vmtobject.object_u8bit <> RESULT_U8BIT then
  1029. failed := true;
  1030. if vmtobject.object_u16bit <> RESULT_U16BIT then
  1031. failed := true;
  1032. if vmtobject.object_s32bit <> RESULT_S32BIT then
  1033. failed := true;
  1034. if vmtobject.object_s64bit <> RESULT_S64BIT then
  1035. failed := true;
  1036. if vmtobject.object_bigstring <> RESULT_BIGSTRING then
  1037. failed := true;
  1038. vmtobject.destructor_params_done;
  1039. if failed then
  1040. fail
  1041. else
  1042. Writeln('Passed!');
  1043. clear_globals;
  1044. clear_values;
  1045. failed := false;
  1046. vmtobject.constructor_init;
  1047. Write('Testing mixed parameter (LOC_REFERENCE) virtual method call...');
  1048. value_u8bit := RESULT_U8BIT;
  1049. value_u16bit := RESULT_U16BIT;
  1050. value_bigstring := RESULT_BIGSTRING;
  1051. value_s32bit := RESULT_S32BIT;
  1052. value_s64bit := RESULT_S64BIT;
  1053. vmtobject.method_virtual_params_mixed(value_u8bit,
  1054. value_u16bit, value_bigstring, value_s32bit, value_s64bit);
  1055. if vmtobject.object_u8bit <> RESULT_U8BIT then
  1056. failed := true;
  1057. if vmtobject.object_u16bit <> RESULT_U16BIT then
  1058. failed := true;
  1059. if vmtobject.object_s32bit <> RESULT_S32BIT then
  1060. failed := true;
  1061. if vmtobject.object_s64bit <> RESULT_S64BIT then
  1062. failed := true;
  1063. if vmtobject.object_bigstring <> RESULT_BIGSTRING then
  1064. failed := true;
  1065. vmtobject.destructor_params_done;
  1066. if failed then
  1067. fail
  1068. else
  1069. Writeln('Passed!');
  1070. clear_globals;
  1071. clear_values;
  1072. failed := false;
  1073. vmtobject.constructor_init;
  1074. Write('Testing mixed parameter (LOC_CONSTANT) virtual method call...');
  1075. vmtobject.method_virtual_overriden_params_mixed(RESULT_U8BIT,
  1076. RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
  1077. if vmtobject.object_u8bit <> RESULT_U8BIT then
  1078. failed := true;
  1079. if vmtobject.object_u16bit <> RESULT_U16BIT then
  1080. failed := true;
  1081. if vmtobject.object_s32bit <> RESULT_S32BIT then
  1082. failed := true;
  1083. if vmtobject.object_s64bit <> RESULT_S64BIT then
  1084. failed := true;
  1085. if vmtobject.object_bigstring <> RESULT_BIGSTRING then
  1086. failed := true;
  1087. vmtobject.destructor_params_done;
  1088. if failed then
  1089. fail
  1090. else
  1091. Writeln('Passed!');
  1092. clear_globals;
  1093. clear_values;
  1094. failed := false;
  1095. vmtobject.constructor_init;
  1096. Write('Testing mixed parameter (LOC_REFERENCE) virtual method call...');
  1097. value_u8bit := RESULT_U8BIT;
  1098. value_u16bit := RESULT_U16BIT;
  1099. value_bigstring := RESULT_BIGSTRING;
  1100. value_s32bit := RESULT_S32BIT;
  1101. value_s64bit := RESULT_S64BIT;
  1102. vmtobject.method_virtual_overriden_params_mixed(value_u8bit,
  1103. value_u16bit, value_bigstring, value_s32bit, value_s64bit);
  1104. if vmtobject.object_u8bit <> RESULT_U8BIT then
  1105. failed := true;
  1106. if vmtobject.object_u16bit <> RESULT_U16BIT then
  1107. failed := true;
  1108. if vmtobject.object_s32bit <> RESULT_S32BIT then
  1109. failed := true;
  1110. if vmtobject.object_s64bit <> RESULT_S64BIT then
  1111. failed := true;
  1112. if vmtobject.object_bigstring <> RESULT_BIGSTRING then
  1113. failed := true;
  1114. vmtobject.destructor_params_done;
  1115. if failed then
  1116. fail
  1117. else
  1118. Writeln('Passed!');
  1119. clear_globals;
  1120. clear_values;
  1121. failed := false;
  1122. vmtobject.constructor_init;
  1123. Write('Testing mixed parameter (LOC_CONSTANT) method call...');
  1124. vmtobject.method_normal_params_mixed(RESULT_U8BIT,
  1125. RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
  1126. if vmtobject.object_u8bit <> RESULT_U8BIT then
  1127. failed := true;
  1128. if vmtobject.object_u16bit <> RESULT_U16BIT then
  1129. failed := true;
  1130. if vmtobject.object_s32bit <> RESULT_S32BIT then
  1131. failed := true;
  1132. if vmtobject.object_s64bit <> RESULT_S64BIT then
  1133. failed := true;
  1134. if vmtobject.object_bigstring <> RESULT_BIGSTRING then
  1135. failed := true;
  1136. vmtobject.destructor_params_done;
  1137. if failed then
  1138. fail
  1139. else
  1140. Writeln('Passed!');
  1141. clear_globals;
  1142. clear_values;
  1143. failed := false;
  1144. vmtobject.constructor_init;
  1145. Write('Testing mixed parameter (LOC_REFERENCE) method call...');
  1146. value_u8bit := RESULT_U8BIT;
  1147. value_u16bit := RESULT_U16BIT;
  1148. value_bigstring := RESULT_BIGSTRING;
  1149. value_s32bit := RESULT_S32BIT;
  1150. value_s64bit := RESULT_S64BIT;
  1151. vmtobject.method_normal_params_mixed(value_u8bit,
  1152. value_u16bit, value_bigstring, value_s32bit, value_s64bit);
  1153. if vmtobject.object_u8bit <> RESULT_U8BIT then
  1154. failed := true;
  1155. if vmtobject.object_u16bit <> RESULT_U16BIT then
  1156. failed := true;
  1157. if vmtobject.object_s32bit <> RESULT_S32BIT then
  1158. failed := true;
  1159. if vmtobject.object_s64bit <> RESULT_S64BIT then
  1160. failed := true;
  1161. if vmtobject.object_bigstring <> RESULT_BIGSTRING then
  1162. failed := true;
  1163. vmtobject.destructor_params_done;
  1164. if failed then
  1165. fail
  1166. else
  1167. Writeln('Passed!');
  1168. clear_globals;
  1169. clear_values;
  1170. failed := false;
  1171. vmtobject.constructor_init;
  1172. Write('Testing mixed parameter (LOC_CONSTANT) static method call...');
  1173. vmtobject.method_static_params_mixed(RESULT_U8BIT,
  1174. RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
  1175. if global_u8bit <> RESULT_U8BIT then
  1176. failed := true;
  1177. if global_u16bit <> RESULT_U16BIT then
  1178. failed := true;
  1179. if global_s32bit <> RESULT_S32BIT then
  1180. failed := true;
  1181. if global_s64bit <> RESULT_S64BIT then
  1182. failed := true;
  1183. if global_bigstring <> RESULT_BIGSTRING then
  1184. failed := true;
  1185. vmtobject.destructor_params_done;
  1186. if failed then
  1187. fail
  1188. else
  1189. Writeln('Passed!');
  1190. clear_globals;
  1191. clear_values;
  1192. failed := false;
  1193. vmtobject.constructor_init;
  1194. Write('Testing mixed parameter (LOC_REFERENCE) static method call...');
  1195. value_u8bit := RESULT_U8BIT;
  1196. value_u16bit := RESULT_U16BIT;
  1197. value_bigstring := RESULT_BIGSTRING;
  1198. value_s32bit := RESULT_S32BIT;
  1199. value_s64bit := RESULT_S64BIT;
  1200. vmtobject.method_static_params_mixed(value_u8bit,
  1201. value_u16bit, value_bigstring, value_s32bit, value_s64bit);
  1202. if global_u8bit <> RESULT_U8BIT then
  1203. failed := true;
  1204. if global_u16bit <> RESULT_U16BIT then
  1205. failed := true;
  1206. if global_s32bit <> RESULT_S32BIT then
  1207. failed := true;
  1208. if global_s64bit <> RESULT_S64BIT then
  1209. failed := true;
  1210. if global_bigstring <> RESULT_BIGSTRING then
  1211. failed := true;
  1212. vmtobject.destructor_params_done;
  1213. if failed then
  1214. fail
  1215. else
  1216. Writeln('Passed!');
  1217. { ********************************************************************
  1218. This calls methods which in turn call other methods, or a constructor
  1219. or a destructor.
  1220. *********************************************************************
  1221. }
  1222. clear_globals;
  1223. clear_values;
  1224. failed := false;
  1225. { Calls the ancestor virtual method }
  1226. vmtobject.constructor_init;
  1227. Write('Testing mixed parameter (LOC_CONSTANT) method call w/virtual call...');
  1228. vmtobject.method_normal_call_virtual_params_mixed(RESULT_U8BIT,
  1229. RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
  1230. if vmtobject.object_u8bit <> RESULT_U8BIT then
  1231. failed := true;
  1232. if vmtobject.object_u16bit <> RESULT_U16BIT then
  1233. failed := true;
  1234. if vmtobject.object_s32bit <> RESULT_S32BIT then
  1235. failed := true;
  1236. if vmtobject.object_s64bit <> RESULT_S64BIT then
  1237. failed := true;
  1238. if vmtobject.object_bigstring <> RESULT_BIGSTRING then
  1239. failed := true;
  1240. vmtobject.destructor_params_done;
  1241. if failed then
  1242. fail
  1243. else
  1244. Writeln('Passed!');
  1245. clear_globals;
  1246. clear_values;
  1247. failed := false;
  1248. vmtobject.constructor_init;
  1249. Write('Testing mixed parameter (LOC_REFERENCE) method call w/virtual call...');
  1250. value_u8bit := RESULT_U8BIT;
  1251. value_u16bit := RESULT_U16BIT;
  1252. value_bigstring := RESULT_BIGSTRING;
  1253. value_s32bit := RESULT_S32BIT;
  1254. value_s64bit := RESULT_S64BIT;
  1255. vmtobject.method_normal_call_virtual_params_mixed(value_u8bit,
  1256. value_u16bit, value_bigstring, value_s32bit, value_s64bit);
  1257. if vmtobject.object_u8bit <> RESULT_U8BIT then
  1258. failed := true;
  1259. if vmtobject.object_u16bit <> RESULT_U16BIT then
  1260. failed := true;
  1261. if vmtobject.object_s32bit <> RESULT_S32BIT then
  1262. failed := true;
  1263. if vmtobject.object_s64bit <> RESULT_S64BIT then
  1264. failed := true;
  1265. if vmtobject.object_bigstring <> RESULT_BIGSTRING then
  1266. failed := true;
  1267. vmtobject.destructor_params_done;
  1268. if failed then
  1269. fail
  1270. else
  1271. Writeln('Passed!');
  1272. { The virtual method has been overriden by the object in this case }
  1273. vmtobject.constructor_init;
  1274. Write('Testing mixed parameter (LOC_CONSTANT) method call w/virtual call...');
  1275. vmtobject.method_normal_call_overriden_params_mixed(RESULT_U8BIT,
  1276. RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
  1277. if vmtobject.object_u8bit <> RESULT_U8BIT then
  1278. failed := true;
  1279. if vmtobject.object_u16bit <> RESULT_U16BIT then
  1280. failed := true;
  1281. if vmtobject.object_s32bit <> RESULT_S32BIT then
  1282. failed := true;
  1283. if vmtobject.object_s64bit <> RESULT_S64BIT then
  1284. failed := true;
  1285. if vmtobject.object_bigstring <> RESULT_BIGSTRING then
  1286. failed := true;
  1287. vmtobject.destructor_params_done;
  1288. if failed then
  1289. fail
  1290. else
  1291. Writeln('Passed!');
  1292. clear_globals;
  1293. clear_values;
  1294. failed := false;
  1295. vmtobject.constructor_init;
  1296. Write('Testing mixed parameter (LOC_REFERENCE) method call w/virtual call...');
  1297. value_u8bit := RESULT_U8BIT;
  1298. value_u16bit := RESULT_U16BIT;
  1299. value_bigstring := RESULT_BIGSTRING;
  1300. value_s32bit := RESULT_S32BIT;
  1301. value_s64bit := RESULT_S64BIT;
  1302. vmtobject.method_normal_call_overriden_params_mixed(value_u8bit,
  1303. value_u16bit, value_bigstring, value_s32bit, value_s64bit);
  1304. if vmtobject.object_u8bit <> RESULT_U8BIT then
  1305. failed := true;
  1306. if vmtobject.object_u16bit <> RESULT_U16BIT then
  1307. failed := true;
  1308. if vmtobject.object_s32bit <> RESULT_S32BIT then
  1309. failed := true;
  1310. if vmtobject.object_s64bit <> RESULT_S64BIT then
  1311. failed := true;
  1312. if vmtobject.object_bigstring <> RESULT_BIGSTRING then
  1313. failed := true;
  1314. vmtobject.destructor_params_done;
  1315. if failed then
  1316. fail
  1317. else
  1318. Writeln('Passed!');
  1319. clear_globals;
  1320. clear_values;
  1321. failed := false;
  1322. vmtobject.constructor_init;
  1323. Write('Testing mixed parameter (LOC_CONSTANT) method call w/normal call...');
  1324. vmtobject.method_normal_call_normal_params_mixed(RESULT_U8BIT,
  1325. RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
  1326. if vmtobject.object_u8bit <> RESULT_U8BIT then
  1327. failed := true;
  1328. if vmtobject.object_u16bit <> RESULT_U16BIT then
  1329. failed := true;
  1330. if vmtobject.object_s32bit <> RESULT_S32BIT then
  1331. failed := true;
  1332. if vmtobject.object_s64bit <> RESULT_S64BIT then
  1333. failed := true;
  1334. if vmtobject.object_bigstring <> RESULT_BIGSTRING then
  1335. failed := true;
  1336. vmtobject.destructor_params_done;
  1337. if failed then
  1338. fail
  1339. else
  1340. Writeln('Passed!');
  1341. clear_globals;
  1342. clear_values;
  1343. failed := false;
  1344. vmtobject.constructor_init;
  1345. Write('Testing mixed parameter (LOC_REFERENCE) method call w/normal call...');
  1346. value_u8bit := RESULT_U8BIT;
  1347. value_u16bit := RESULT_U16BIT;
  1348. value_bigstring := RESULT_BIGSTRING;
  1349. value_s32bit := RESULT_S32BIT;
  1350. value_s64bit := RESULT_S64BIT;
  1351. vmtobject.method_normal_call_normal_params_mixed(value_u8bit,
  1352. value_u16bit, value_bigstring, value_s32bit, value_s64bit);
  1353. if vmtobject.object_u8bit <> RESULT_U8BIT then
  1354. failed := true;
  1355. if vmtobject.object_u16bit <> RESULT_U16BIT then
  1356. failed := true;
  1357. if vmtobject.object_s32bit <> RESULT_S32BIT then
  1358. failed := true;
  1359. if vmtobject.object_s64bit <> RESULT_S64BIT then
  1360. failed := true;
  1361. if vmtobject.object_bigstring <> RESULT_BIGSTRING then
  1362. failed := true;
  1363. vmtobject.destructor_params_done;
  1364. if failed then
  1365. fail
  1366. else
  1367. Writeln('Passed!');
  1368. (* constructor call inside a normal method *)
  1369. clear_globals;
  1370. clear_values;
  1371. failed := false;
  1372. vmtobject.constructor_init;
  1373. Write('Testing mixed parameter (LOC_CONSTANT) method call w/constructor call...');
  1374. vmtobject.method_normal_call_constructor_params_mixed(RESULT_U8BIT,
  1375. RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
  1376. if vmtobject.object_u8bit <> RESULT_U8BIT then
  1377. failed := true;
  1378. if vmtobject.object_u16bit <> RESULT_U16BIT then
  1379. failed := true;
  1380. if vmtobject.object_s32bit <> RESULT_S32BIT then
  1381. failed := true;
  1382. if vmtobject.object_s64bit <> RESULT_S64BIT then
  1383. failed := true;
  1384. if vmtobject.object_bigstring <> RESULT_BIGSTRING then
  1385. failed := true;
  1386. vmtobject.destructor_params_done;
  1387. if failed then
  1388. fail
  1389. else
  1390. Writeln('Passed!');
  1391. clear_globals;
  1392. clear_values;
  1393. failed := false;
  1394. vmtobject.constructor_init;
  1395. Write('Testing mixed parameter (LOC_REFERENCE) method call w/constructor call...');
  1396. value_u8bit := RESULT_U8BIT;
  1397. value_u16bit := RESULT_U16BIT;
  1398. value_bigstring := RESULT_BIGSTRING;
  1399. value_s32bit := RESULT_S32BIT;
  1400. value_s64bit := RESULT_S64BIT;
  1401. vmtobject.method_normal_call_constructor_params_mixed(value_u8bit,
  1402. value_u16bit, value_bigstring, value_s32bit, value_s64bit);
  1403. if vmtobject.object_u8bit <> RESULT_U8BIT then
  1404. failed := true;
  1405. if vmtobject.object_u16bit <> RESULT_U16BIT then
  1406. failed := true;
  1407. if vmtobject.object_s32bit <> RESULT_S32BIT then
  1408. failed := true;
  1409. if vmtobject.object_s64bit <> RESULT_S64BIT then
  1410. failed := true;
  1411. if vmtobject.object_bigstring <> RESULT_BIGSTRING then
  1412. failed := true;
  1413. vmtobject.destructor_params_done;
  1414. if failed then
  1415. fail
  1416. else
  1417. Writeln('Passed!');
  1418. { static method call }
  1419. clear_globals;
  1420. clear_values;
  1421. failed := false;
  1422. vmtobject.constructor_init;
  1423. Write('Testing mixed parameter (LOC_CONSTANT) method call w/static call...');
  1424. vmtobject.method_normal_call_static_params_mixed(RESULT_U8BIT,
  1425. RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
  1426. if global_u8bit <> RESULT_U8BIT then
  1427. failed := true;
  1428. if global_u16bit <> RESULT_U16BIT then
  1429. failed := true;
  1430. if global_s32bit <> RESULT_S32BIT then
  1431. failed := true;
  1432. if global_s64bit <> RESULT_S64BIT then
  1433. failed := true;
  1434. if global_bigstring <> RESULT_BIGSTRING then
  1435. failed := true;
  1436. vmtobject.destructor_params_done;
  1437. if failed then
  1438. fail
  1439. else
  1440. Writeln('Passed!');
  1441. clear_globals;
  1442. clear_values;
  1443. failed := false;
  1444. vmtobject.constructor_init;
  1445. Write('Testing mixed parameter (LOC_REFERENCE) method call w/static call...');
  1446. value_u8bit := RESULT_U8BIT;
  1447. value_u16bit := RESULT_U16BIT;
  1448. value_bigstring := RESULT_BIGSTRING;
  1449. value_s32bit := RESULT_S32BIT;
  1450. value_s64bit := RESULT_S64BIT;
  1451. vmtobject.method_normal_call_static_params_mixed(value_u8bit,
  1452. value_u16bit, value_bigstring, value_s32bit, value_s64bit);
  1453. if global_u8bit <> RESULT_U8BIT then
  1454. failed := true;
  1455. if global_u16bit <> RESULT_U16BIT then
  1456. failed := true;
  1457. if global_s32bit <> RESULT_S32BIT then
  1458. failed := true;
  1459. if global_s64bit <> RESULT_S64BIT then
  1460. failed := true;
  1461. if global_bigstring <> RESULT_BIGSTRING then
  1462. failed := true;
  1463. vmtobject.destructor_params_done;
  1464. if failed then
  1465. fail
  1466. else
  1467. Writeln('Passed!');
  1468. (* calls the inherited method *)
  1469. clear_globals;
  1470. clear_values;
  1471. failed := false;
  1472. { Calls the ancestor virtual method }
  1473. vmtobject.constructor_init;
  1474. Write('Testing mixed parameter (LOC_CONSTANT) method call w/inherited call...');
  1475. vmtobject.method_normal_call_inherited_params_mixed(RESULT_U8BIT,
  1476. RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
  1477. if vmtobject.object_u8bit <> RESULT_U8BIT then
  1478. failed := true;
  1479. if vmtobject.object_u16bit <> RESULT_U16BIT then
  1480. failed := true;
  1481. if vmtobject.object_s32bit <> RESULT_S32BIT then
  1482. failed := true;
  1483. if vmtobject.object_s64bit <> RESULT_S64BIT then
  1484. failed := true;
  1485. if vmtobject.object_bigstring <> RESULT_BIGSTRING then
  1486. failed := true;
  1487. vmtobject.destructor_params_done;
  1488. if failed then
  1489. fail
  1490. else
  1491. Writeln('Passed!');
  1492. clear_globals;
  1493. clear_values;
  1494. failed := false;
  1495. vmtobject.constructor_init;
  1496. Write('Testing mixed parameter (LOC_REFERENCE) method call w/inherited call...');
  1497. value_u8bit := RESULT_U8BIT;
  1498. value_u16bit := RESULT_U16BIT;
  1499. value_bigstring := RESULT_BIGSTRING;
  1500. value_s32bit := RESULT_S32BIT;
  1501. value_s64bit := RESULT_S64BIT;
  1502. vmtobject.method_normal_call_inherited_params_mixed(value_u8bit,
  1503. value_u16bit, value_bigstring, value_s32bit, value_s64bit);
  1504. if vmtobject.object_u8bit <> RESULT_U8BIT then
  1505. failed := true;
  1506. if vmtobject.object_u16bit <> RESULT_U16BIT then
  1507. failed := true;
  1508. if vmtobject.object_s32bit <> RESULT_S32BIT then
  1509. failed := true;
  1510. if vmtobject.object_s64bit <> RESULT_S64BIT then
  1511. failed := true;
  1512. if vmtobject.object_bigstring <> RESULT_BIGSTRING then
  1513. failed := true;
  1514. vmtobject.destructor_params_done;
  1515. if failed then
  1516. fail
  1517. else
  1518. Writeln('Passed!');
  1519. { ********************************************************************
  1520. This calls virtual methods which in turn call other methods,
  1521. or a constructor or a destructor.
  1522. *********************************************************************
  1523. }
  1524. clear_globals;
  1525. clear_values;
  1526. failed := false;
  1527. { Calls the ancestor virtual method }
  1528. vmtobject.constructor_init;
  1529. Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/virtual call...');
  1530. vmtobject.method_virtual_call_virtual_params_mixed(RESULT_U8BIT,
  1531. RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
  1532. if vmtobject.object_u8bit <> RESULT_U8BIT then
  1533. failed := true;
  1534. if vmtobject.object_u16bit <> RESULT_U16BIT then
  1535. failed := true;
  1536. if vmtobject.object_s32bit <> RESULT_S32BIT then
  1537. failed := true;
  1538. if vmtobject.object_s64bit <> RESULT_S64BIT then
  1539. failed := true;
  1540. if vmtobject.object_bigstring <> RESULT_BIGSTRING then
  1541. failed := true;
  1542. vmtobject.destructor_params_done;
  1543. if failed then
  1544. fail
  1545. else
  1546. Writeln('Passed!');
  1547. clear_globals;
  1548. clear_values;
  1549. failed := false;
  1550. vmtobject.constructor_init;
  1551. Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/virtual call...');
  1552. value_u8bit := RESULT_U8BIT;
  1553. value_u16bit := RESULT_U16BIT;
  1554. value_bigstring := RESULT_BIGSTRING;
  1555. value_s32bit := RESULT_S32BIT;
  1556. value_s64bit := RESULT_S64BIT;
  1557. vmtobject.method_virtual_call_virtual_params_mixed(value_u8bit,
  1558. value_u16bit, value_bigstring, value_s32bit, value_s64bit);
  1559. if vmtobject.object_u8bit <> RESULT_U8BIT then
  1560. failed := true;
  1561. if vmtobject.object_u16bit <> RESULT_U16BIT then
  1562. failed := true;
  1563. if vmtobject.object_s32bit <> RESULT_S32BIT then
  1564. failed := true;
  1565. if vmtobject.object_s64bit <> RESULT_S64BIT then
  1566. failed := true;
  1567. if vmtobject.object_bigstring <> RESULT_BIGSTRING then
  1568. failed := true;
  1569. vmtobject.destructor_params_done;
  1570. if failed then
  1571. fail
  1572. else
  1573. Writeln('Passed!');
  1574. { The virtual method has been overriden by the object in this case }
  1575. vmtobject.constructor_init;
  1576. Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/virtual call...');
  1577. vmtobject.method_virtual_call_overriden_params_mixed(RESULT_U8BIT,
  1578. RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
  1579. if vmtobject.object_u8bit <> RESULT_U8BIT then
  1580. failed := true;
  1581. if vmtobject.object_u16bit <> RESULT_U16BIT then
  1582. failed := true;
  1583. if vmtobject.object_s32bit <> RESULT_S32BIT then
  1584. failed := true;
  1585. if vmtobject.object_s64bit <> RESULT_S64BIT then
  1586. failed := true;
  1587. if vmtobject.object_bigstring <> RESULT_BIGSTRING then
  1588. failed := true;
  1589. vmtobject.destructor_params_done;
  1590. if failed then
  1591. fail
  1592. else
  1593. Writeln('Passed!');
  1594. clear_globals;
  1595. clear_values;
  1596. failed := false;
  1597. vmtobject.constructor_init;
  1598. Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/virtual call...');
  1599. value_u8bit := RESULT_U8BIT;
  1600. value_u16bit := RESULT_U16BIT;
  1601. value_bigstring := RESULT_BIGSTRING;
  1602. value_s32bit := RESULT_S32BIT;
  1603. value_s64bit := RESULT_S64BIT;
  1604. vmtobject.method_virtual_call_overriden_params_mixed(value_u8bit,
  1605. value_u16bit, value_bigstring, value_s32bit, value_s64bit);
  1606. if vmtobject.object_u8bit <> RESULT_U8BIT then
  1607. failed := true;
  1608. if vmtobject.object_u16bit <> RESULT_U16BIT then
  1609. failed := true;
  1610. if vmtobject.object_s32bit <> RESULT_S32BIT then
  1611. failed := true;
  1612. if vmtobject.object_s64bit <> RESULT_S64BIT then
  1613. failed := true;
  1614. if vmtobject.object_bigstring <> RESULT_BIGSTRING then
  1615. failed := true;
  1616. vmtobject.destructor_params_done;
  1617. if failed then
  1618. fail
  1619. else
  1620. Writeln('Passed!');
  1621. clear_globals;
  1622. clear_values;
  1623. failed := false;
  1624. vmtobject.constructor_init;
  1625. Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/normal call...');
  1626. vmtobject.method_virtual_call_normal_params_mixed(RESULT_U8BIT,
  1627. RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
  1628. if vmtobject.object_u8bit <> RESULT_U8BIT then
  1629. failed := true;
  1630. if vmtobject.object_u16bit <> RESULT_U16BIT then
  1631. failed := true;
  1632. if vmtobject.object_s32bit <> RESULT_S32BIT then
  1633. failed := true;
  1634. if vmtobject.object_s64bit <> RESULT_S64BIT then
  1635. failed := true;
  1636. if vmtobject.object_bigstring <> RESULT_BIGSTRING then
  1637. failed := true;
  1638. vmtobject.destructor_params_done;
  1639. if failed then
  1640. fail
  1641. else
  1642. Writeln('Passed!');
  1643. clear_globals;
  1644. clear_values;
  1645. failed := false;
  1646. vmtobject.constructor_init;
  1647. Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/normal call...');
  1648. value_u8bit := RESULT_U8BIT;
  1649. value_u16bit := RESULT_U16BIT;
  1650. value_bigstring := RESULT_BIGSTRING;
  1651. value_s32bit := RESULT_S32BIT;
  1652. value_s64bit := RESULT_S64BIT;
  1653. vmtobject.method_virtual_call_normal_params_mixed(value_u8bit,
  1654. value_u16bit, value_bigstring, value_s32bit, value_s64bit);
  1655. if vmtobject.object_u8bit <> RESULT_U8BIT then
  1656. failed := true;
  1657. if vmtobject.object_u16bit <> RESULT_U16BIT then
  1658. failed := true;
  1659. if vmtobject.object_s32bit <> RESULT_S32BIT then
  1660. failed := true;
  1661. if vmtobject.object_s64bit <> RESULT_S64BIT then
  1662. failed := true;
  1663. if vmtobject.object_bigstring <> RESULT_BIGSTRING then
  1664. failed := true;
  1665. vmtobject.destructor_params_done;
  1666. if failed then
  1667. fail
  1668. else
  1669. Writeln('Passed!');
  1670. (* constructor call inside a normal method *)
  1671. clear_globals;
  1672. clear_values;
  1673. failed := false;
  1674. vmtobject.constructor_init;
  1675. Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/constructor call...');
  1676. vmtobject.method_virtual_call_constructor_params_mixed(RESULT_U8BIT,
  1677. RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
  1678. if vmtobject.object_u8bit <> RESULT_U8BIT then
  1679. failed := true;
  1680. if vmtobject.object_u16bit <> RESULT_U16BIT then
  1681. failed := true;
  1682. if vmtobject.object_s32bit <> RESULT_S32BIT then
  1683. failed := true;
  1684. if vmtobject.object_s64bit <> RESULT_S64BIT then
  1685. failed := true;
  1686. if vmtobject.object_bigstring <> RESULT_BIGSTRING then
  1687. failed := true;
  1688. vmtobject.destructor_params_done;
  1689. if failed then
  1690. fail
  1691. else
  1692. Writeln('Passed!');
  1693. clear_globals;
  1694. clear_values;
  1695. failed := false;
  1696. vmtobject.constructor_init;
  1697. Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/constructor call...');
  1698. value_u8bit := RESULT_U8BIT;
  1699. value_u16bit := RESULT_U16BIT;
  1700. value_bigstring := RESULT_BIGSTRING;
  1701. value_s32bit := RESULT_S32BIT;
  1702. value_s64bit := RESULT_S64BIT;
  1703. vmtobject.method_virtual_call_constructor_params_mixed(value_u8bit,
  1704. value_u16bit, value_bigstring, value_s32bit, value_s64bit);
  1705. if vmtobject.object_u8bit <> RESULT_U8BIT then
  1706. failed := true;
  1707. if vmtobject.object_u16bit <> RESULT_U16BIT then
  1708. failed := true;
  1709. if vmtobject.object_s32bit <> RESULT_S32BIT then
  1710. failed := true;
  1711. if vmtobject.object_s64bit <> RESULT_S64BIT then
  1712. failed := true;
  1713. if vmtobject.object_bigstring <> RESULT_BIGSTRING then
  1714. failed := true;
  1715. vmtobject.destructor_params_done;
  1716. if failed then
  1717. fail
  1718. else
  1719. Writeln('Passed!');
  1720. { static virtual call }
  1721. clear_globals;
  1722. clear_values;
  1723. failed := false;
  1724. vmtobject.constructor_init;
  1725. Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/static call...');
  1726. vmtobject.method_virtual_call_static_params_mixed(RESULT_U8BIT,
  1727. RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
  1728. if global_u8bit <> RESULT_U8BIT then
  1729. failed := true;
  1730. if global_u16bit <> RESULT_U16BIT then
  1731. failed := true;
  1732. if global_s32bit <> RESULT_S32BIT then
  1733. failed := true;
  1734. if global_s64bit <> RESULT_S64BIT then
  1735. failed := true;
  1736. if global_bigstring <> RESULT_BIGSTRING then
  1737. failed := true;
  1738. vmtobject.destructor_params_done;
  1739. if failed then
  1740. fail
  1741. else
  1742. Writeln('Passed!');
  1743. clear_globals;
  1744. clear_values;
  1745. failed := false;
  1746. vmtobject.constructor_init;
  1747. Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/static call...');
  1748. value_u8bit := RESULT_U8BIT;
  1749. value_u16bit := RESULT_U16BIT;
  1750. value_bigstring := RESULT_BIGSTRING;
  1751. value_s32bit := RESULT_S32BIT;
  1752. value_s64bit := RESULT_S64BIT;
  1753. vmtobject.method_virtual_call_static_params_mixed(value_u8bit,
  1754. value_u16bit, value_bigstring, value_s32bit, value_s64bit);
  1755. if global_u8bit <> RESULT_U8BIT then
  1756. failed := true;
  1757. if global_u16bit <> RESULT_U16BIT then
  1758. failed := true;
  1759. if global_s32bit <> RESULT_S32BIT then
  1760. failed := true;
  1761. if global_s64bit <> RESULT_S64BIT then
  1762. failed := true;
  1763. if global_bigstring <> RESULT_BIGSTRING then
  1764. failed := true;
  1765. vmtobject.destructor_params_done;
  1766. if failed then
  1767. fail
  1768. else
  1769. Writeln('Passed!');
  1770. (* calls the inherited method *)
  1771. clear_globals;
  1772. clear_values;
  1773. failed := false;
  1774. { Calls the ancestor virtual method }
  1775. vmtobject.constructor_init;
  1776. Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/inherited call...');
  1777. vmtobject.method_virtual_call_inherited_params_mixed(RESULT_U8BIT,
  1778. RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
  1779. if vmtobject.object_u8bit <> RESULT_U8BIT then
  1780. failed := true;
  1781. if vmtobject.object_u16bit <> RESULT_U16BIT then
  1782. failed := true;
  1783. if vmtobject.object_s32bit <> RESULT_S32BIT then
  1784. failed := true;
  1785. if vmtobject.object_s64bit <> RESULT_S64BIT then
  1786. failed := true;
  1787. if vmtobject.object_bigstring <> RESULT_BIGSTRING then
  1788. failed := true;
  1789. vmtobject.destructor_params_done;
  1790. if failed then
  1791. fail
  1792. else
  1793. Writeln('Passed!');
  1794. clear_globals;
  1795. clear_values;
  1796. failed := false;
  1797. vmtobject.constructor_init;
  1798. Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/inherited call...');
  1799. value_u8bit := RESULT_U8BIT;
  1800. value_u16bit := RESULT_U16BIT;
  1801. value_bigstring := RESULT_BIGSTRING;
  1802. value_s32bit := RESULT_S32BIT;
  1803. value_s64bit := RESULT_S64BIT;
  1804. vmtobject.method_virtual_call_inherited_params_mixed(value_u8bit,
  1805. value_u16bit, value_bigstring, value_s32bit, value_s64bit);
  1806. if vmtobject.object_u8bit <> RESULT_U8BIT then
  1807. failed := true;
  1808. if vmtobject.object_u16bit <> RESULT_U16BIT then
  1809. failed := true;
  1810. if vmtobject.object_s32bit <> RESULT_S32BIT then
  1811. failed := true;
  1812. if vmtobject.object_s64bit <> RESULT_S64BIT then
  1813. failed := true;
  1814. if vmtobject.object_bigstring <> RESULT_BIGSTRING then
  1815. failed := true;
  1816. vmtobject.destructor_params_done;
  1817. if failed then
  1818. fail
  1819. else
  1820. Writeln('Passed!');
  1821. end;
  1822. { same as testvmtherited, except uses with statement }
  1823. procedure testwith;
  1824. var
  1825. vmtobject : theritedvmtobject;
  1826. failed : boolean;
  1827. begin
  1828. with vmtobject do
  1829. begin
  1830. {********************** CONSTRUCTOR TESTING ************************}
  1831. {********************** DESTRUCTOR TESTING ************************}
  1832. clear_globals;
  1833. clear_values;
  1834. failed := false;
  1835. Write('Testing mixed parameter (LOC_CONSTANT) inherited constructor call...');
  1836. constructor_params_mixed_call_inherited(RESULT_U8BIT, RESULT_U16BIT, RESULT_BIGSTRING,
  1837. RESULT_S32BIT, RESULT_S64BIT);
  1838. if object_u8bit <> RESULT_U8BIT then
  1839. failed := true;
  1840. if object_u16bit <> RESULT_U16BIT then
  1841. failed := true;
  1842. if object_s32bit <> RESULT_S32BIT then
  1843. failed := true;
  1844. if object_s64bit <> RESULT_S64BIT then
  1845. failed := true;
  1846. if object_bigstring <> RESULT_BIGSTRING then
  1847. failed := true;
  1848. destructor_params_done;
  1849. if failed then
  1850. fail
  1851. else
  1852. Writeln('Passed!');
  1853. clear_globals;
  1854. clear_values;
  1855. failed := false;
  1856. Write('Testing mixed parameter (LOC_REFERENCE) inherited constructor call...');
  1857. value_u8bit := RESULT_U8BIT;
  1858. value_u16bit := RESULT_U16BIT;
  1859. value_bigstring := RESULT_BIGSTRING;
  1860. value_s32bit := RESULT_S32BIT;
  1861. value_s64bit := RESULT_S64BIT;
  1862. constructor_params_mixed_call_inherited(value_u8bit,
  1863. value_u16bit, value_bigstring, value_s32bit, value_s64bit);
  1864. if object_u8bit <> RESULT_U8BIT then
  1865. failed := true;
  1866. if object_u16bit <> RESULT_U16BIT then
  1867. failed := true;
  1868. if object_s32bit <> RESULT_S32BIT then
  1869. failed := true;
  1870. if object_s64bit <> RESULT_S64BIT then
  1871. failed := true;
  1872. if object_bigstring <> RESULT_BIGSTRING then
  1873. failed := true;
  1874. destructor_params_done;
  1875. if failed then
  1876. fail
  1877. else
  1878. Writeln('Passed!');
  1879. clear_globals;
  1880. clear_values;
  1881. failed := false;
  1882. Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/virtual call...');
  1883. constructor_params_mixed_call_virtual(RESULT_U8BIT,
  1884. RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
  1885. if object_u8bit <> RESULT_U8BIT then
  1886. failed := true;
  1887. if object_u16bit <> RESULT_U16BIT then
  1888. failed := true;
  1889. if object_s32bit <> RESULT_S32BIT then
  1890. failed := true;
  1891. if object_s64bit <> RESULT_S64BIT then
  1892. failed := true;
  1893. if object_bigstring <> RESULT_BIGSTRING then
  1894. failed := true;
  1895. destructor_params_done;
  1896. if failed then
  1897. fail
  1898. else
  1899. Writeln('Passed!');
  1900. clear_globals;
  1901. clear_values;
  1902. failed := false;
  1903. Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/virtual call...');
  1904. value_u8bit := RESULT_U8BIT;
  1905. value_u16bit := RESULT_U16BIT;
  1906. value_bigstring := RESULT_BIGSTRING;
  1907. value_s32bit := RESULT_S32BIT;
  1908. value_s64bit := RESULT_S64BIT;
  1909. constructor_params_mixed_call_virtual(value_u8bit,
  1910. value_u16bit, value_bigstring, value_s32bit, value_s64bit);
  1911. if object_u8bit <> RESULT_U8BIT then
  1912. failed := true;
  1913. if object_u16bit <> RESULT_U16BIT then
  1914. failed := true;
  1915. if object_s32bit <> RESULT_S32BIT then
  1916. failed := true;
  1917. if object_s64bit <> RESULT_S64BIT then
  1918. failed := true;
  1919. if object_bigstring <> RESULT_BIGSTRING then
  1920. failed := true;
  1921. destructor_params_done;
  1922. if failed then
  1923. fail
  1924. else
  1925. Writeln('Passed!');
  1926. clear_globals;
  1927. clear_values;
  1928. failed := false;
  1929. Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/virtual call...');
  1930. constructor_params_mixed_call_overriden(RESULT_U8BIT,
  1931. RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
  1932. if object_u8bit <> RESULT_U8BIT then
  1933. failed := true;
  1934. if object_u16bit <> RESULT_U16BIT then
  1935. failed := true;
  1936. if object_s32bit <> RESULT_S32BIT then
  1937. failed := true;
  1938. if object_s64bit <> RESULT_S64BIT then
  1939. failed := true;
  1940. if object_bigstring <> RESULT_BIGSTRING then
  1941. failed := true;
  1942. destructor_params_done;
  1943. if failed then
  1944. fail
  1945. else
  1946. Writeln('Passed!');
  1947. clear_globals;
  1948. clear_values;
  1949. failed := false;
  1950. Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/virtual call...');
  1951. value_u8bit := RESULT_U8BIT;
  1952. value_u16bit := RESULT_U16BIT;
  1953. value_bigstring := RESULT_BIGSTRING;
  1954. value_s32bit := RESULT_S32BIT;
  1955. value_s64bit := RESULT_S64BIT;
  1956. constructor_params_mixed_call_overriden(value_u8bit,
  1957. value_u16bit, value_bigstring, value_s32bit, value_s64bit);
  1958. if object_u8bit <> RESULT_U8BIT then
  1959. failed := true;
  1960. if object_u16bit <> RESULT_U16BIT then
  1961. failed := true;
  1962. if object_s32bit <> RESULT_S32BIT then
  1963. failed := true;
  1964. if object_s64bit <> RESULT_S64BIT then
  1965. failed := true;
  1966. if object_bigstring <> RESULT_BIGSTRING then
  1967. failed := true;
  1968. destructor_params_done;
  1969. if failed then
  1970. fail
  1971. else
  1972. Writeln('Passed!');
  1973. clear_globals;
  1974. clear_values;
  1975. failed := false;
  1976. Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/method call...');
  1977. constructor_params_mixed_call_normal(RESULT_U8BIT,
  1978. RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
  1979. if object_u8bit <> RESULT_U8BIT then
  1980. failed := true;
  1981. if object_u16bit <> RESULT_U16BIT then
  1982. failed := true;
  1983. if object_s32bit <> RESULT_S32BIT then
  1984. failed := true;
  1985. if object_s64bit <> RESULT_S64BIT then
  1986. failed := true;
  1987. if object_bigstring <> RESULT_BIGSTRING then
  1988. failed := true;
  1989. destructor_params_done;
  1990. if failed then
  1991. fail
  1992. else
  1993. Writeln('Passed!');
  1994. clear_globals;
  1995. clear_values;
  1996. failed := false;
  1997. Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/method call...');
  1998. value_u8bit := RESULT_U8BIT;
  1999. value_u16bit := RESULT_U16BIT;
  2000. value_bigstring := RESULT_BIGSTRING;
  2001. value_s32bit := RESULT_S32BIT;
  2002. value_s64bit := RESULT_S64BIT;
  2003. constructor_params_mixed_call_normal(value_u8bit,
  2004. value_u16bit, value_bigstring, value_s32bit, value_s64bit);
  2005. if object_u8bit <> RESULT_U8BIT then
  2006. failed := true;
  2007. if object_u16bit <> RESULT_U16BIT then
  2008. failed := true;
  2009. if object_s32bit <> RESULT_S32BIT then
  2010. failed := true;
  2011. if object_s64bit <> RESULT_S64BIT then
  2012. failed := true;
  2013. if object_bigstring <> RESULT_BIGSTRING then
  2014. failed := true;
  2015. destructor_params_done;
  2016. if failed then
  2017. fail
  2018. else
  2019. Writeln('Passed!');
  2020. clear_globals;
  2021. clear_values;
  2022. failed := false;
  2023. Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/static call...');
  2024. constructor_params_mixed_call_static(RESULT_U8BIT,
  2025. RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
  2026. if global_u8bit <> RESULT_U8BIT then
  2027. failed := true;
  2028. if global_u16bit <> RESULT_U16BIT then
  2029. failed := true;
  2030. if global_s32bit <> RESULT_S32BIT then
  2031. failed := true;
  2032. if global_s64bit <> RESULT_S64BIT then
  2033. failed := true;
  2034. if global_bigstring <> RESULT_BIGSTRING then
  2035. failed := true;
  2036. destructor_params_done;
  2037. if failed then
  2038. fail
  2039. else
  2040. Writeln('Passed!');
  2041. clear_globals;
  2042. clear_values;
  2043. failed := false;
  2044. Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/static call...');
  2045. value_u8bit := RESULT_U8BIT;
  2046. value_u16bit := RESULT_U16BIT;
  2047. value_bigstring := RESULT_BIGSTRING;
  2048. value_s32bit := RESULT_S32BIT;
  2049. value_s64bit := RESULT_S64BIT;
  2050. constructor_params_mixed_call_static(value_u8bit,
  2051. value_u16bit, value_bigstring, value_s32bit, value_s64bit);
  2052. if global_u8bit <> RESULT_U8BIT then
  2053. failed := true;
  2054. if global_u16bit <> RESULT_U16BIT then
  2055. failed := true;
  2056. if global_s32bit <> RESULT_S32BIT then
  2057. failed := true;
  2058. if global_s64bit <> RESULT_S64BIT then
  2059. failed := true;
  2060. if global_bigstring <> RESULT_BIGSTRING then
  2061. failed := true;
  2062. destructor_params_done;
  2063. if failed then
  2064. fail
  2065. else
  2066. Writeln('Passed!');
  2067. {************************* METHOD TESTING **************************}
  2068. clear_globals;
  2069. clear_values;
  2070. failed := false;
  2071. constructor_init;
  2072. Write('Testing mixed parameter (LOC_CONSTANT) virtual method call...');
  2073. method_virtual_params_mixed(RESULT_U8BIT,
  2074. RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
  2075. if object_u8bit <> RESULT_U8BIT then
  2076. failed := true;
  2077. if object_u16bit <> RESULT_U16BIT then
  2078. failed := true;
  2079. if object_s32bit <> RESULT_S32BIT then
  2080. failed := true;
  2081. if object_s64bit <> RESULT_S64BIT then
  2082. failed := true;
  2083. if object_bigstring <> RESULT_BIGSTRING then
  2084. failed := true;
  2085. destructor_params_done;
  2086. if failed then
  2087. fail
  2088. else
  2089. Writeln('Passed!');
  2090. clear_globals;
  2091. clear_values;
  2092. failed := false;
  2093. constructor_init;
  2094. Write('Testing mixed parameter (LOC_REFERENCE) virtual method call...');
  2095. value_u8bit := RESULT_U8BIT;
  2096. value_u16bit := RESULT_U16BIT;
  2097. value_bigstring := RESULT_BIGSTRING;
  2098. value_s32bit := RESULT_S32BIT;
  2099. value_s64bit := RESULT_S64BIT;
  2100. method_virtual_params_mixed(value_u8bit,
  2101. value_u16bit, value_bigstring, value_s32bit, value_s64bit);
  2102. if object_u8bit <> RESULT_U8BIT then
  2103. failed := true;
  2104. if object_u16bit <> RESULT_U16BIT then
  2105. failed := true;
  2106. if object_s32bit <> RESULT_S32BIT then
  2107. failed := true;
  2108. if object_s64bit <> RESULT_S64BIT then
  2109. failed := true;
  2110. if object_bigstring <> RESULT_BIGSTRING then
  2111. failed := true;
  2112. destructor_params_done;
  2113. if failed then
  2114. fail
  2115. else
  2116. Writeln('Passed!');
  2117. clear_globals;
  2118. clear_values;
  2119. failed := false;
  2120. constructor_init;
  2121. Write('Testing mixed parameter (LOC_CONSTANT) virtual method call...');
  2122. method_virtual_overriden_params_mixed(RESULT_U8BIT,
  2123. RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
  2124. if object_u8bit <> RESULT_U8BIT then
  2125. failed := true;
  2126. if object_u16bit <> RESULT_U16BIT then
  2127. failed := true;
  2128. if object_s32bit <> RESULT_S32BIT then
  2129. failed := true;
  2130. if object_s64bit <> RESULT_S64BIT then
  2131. failed := true;
  2132. if object_bigstring <> RESULT_BIGSTRING then
  2133. failed := true;
  2134. destructor_params_done;
  2135. if failed then
  2136. fail
  2137. else
  2138. Writeln('Passed!');
  2139. clear_globals;
  2140. clear_values;
  2141. failed := false;
  2142. constructor_init;
  2143. Write('Testing mixed parameter (LOC_REFERENCE) virtual method call...');
  2144. value_u8bit := RESULT_U8BIT;
  2145. value_u16bit := RESULT_U16BIT;
  2146. value_bigstring := RESULT_BIGSTRING;
  2147. value_s32bit := RESULT_S32BIT;
  2148. value_s64bit := RESULT_S64BIT;
  2149. method_virtual_overriden_params_mixed(value_u8bit,
  2150. value_u16bit, value_bigstring, value_s32bit, value_s64bit);
  2151. if object_u8bit <> RESULT_U8BIT then
  2152. failed := true;
  2153. if object_u16bit <> RESULT_U16BIT then
  2154. failed := true;
  2155. if object_s32bit <> RESULT_S32BIT then
  2156. failed := true;
  2157. if object_s64bit <> RESULT_S64BIT then
  2158. failed := true;
  2159. if object_bigstring <> RESULT_BIGSTRING then
  2160. failed := true;
  2161. destructor_params_done;
  2162. if failed then
  2163. fail
  2164. else
  2165. Writeln('Passed!');
  2166. clear_globals;
  2167. clear_values;
  2168. failed := false;
  2169. constructor_init;
  2170. Write('Testing mixed parameter (LOC_CONSTANT) method call...');
  2171. method_normal_params_mixed(RESULT_U8BIT,
  2172. RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
  2173. if object_u8bit <> RESULT_U8BIT then
  2174. failed := true;
  2175. if object_u16bit <> RESULT_U16BIT then
  2176. failed := true;
  2177. if object_s32bit <> RESULT_S32BIT then
  2178. failed := true;
  2179. if object_s64bit <> RESULT_S64BIT then
  2180. failed := true;
  2181. if object_bigstring <> RESULT_BIGSTRING then
  2182. failed := true;
  2183. destructor_params_done;
  2184. if failed then
  2185. fail
  2186. else
  2187. Writeln('Passed!');
  2188. clear_globals;
  2189. clear_values;
  2190. failed := false;
  2191. constructor_init;
  2192. Write('Testing mixed parameter (LOC_REFERENCE) method call...');
  2193. value_u8bit := RESULT_U8BIT;
  2194. value_u16bit := RESULT_U16BIT;
  2195. value_bigstring := RESULT_BIGSTRING;
  2196. value_s32bit := RESULT_S32BIT;
  2197. value_s64bit := RESULT_S64BIT;
  2198. method_normal_params_mixed(value_u8bit,
  2199. value_u16bit, value_bigstring, value_s32bit, value_s64bit);
  2200. if object_u8bit <> RESULT_U8BIT then
  2201. failed := true;
  2202. if object_u16bit <> RESULT_U16BIT then
  2203. failed := true;
  2204. if object_s32bit <> RESULT_S32BIT then
  2205. failed := true;
  2206. if object_s64bit <> RESULT_S64BIT then
  2207. failed := true;
  2208. if object_bigstring <> RESULT_BIGSTRING then
  2209. failed := true;
  2210. destructor_params_done;
  2211. if failed then
  2212. fail
  2213. else
  2214. Writeln('Passed!');
  2215. clear_globals;
  2216. clear_values;
  2217. failed := false;
  2218. constructor_init;
  2219. Write('Testing mixed parameter (LOC_CONSTANT) static method call...');
  2220. method_static_params_mixed(RESULT_U8BIT,
  2221. RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
  2222. if global_u8bit <> RESULT_U8BIT then
  2223. failed := true;
  2224. if global_u16bit <> RESULT_U16BIT then
  2225. failed := true;
  2226. if global_s32bit <> RESULT_S32BIT then
  2227. failed := true;
  2228. if global_s64bit <> RESULT_S64BIT then
  2229. failed := true;
  2230. if global_bigstring <> RESULT_BIGSTRING then
  2231. failed := true;
  2232. destructor_params_done;
  2233. if failed then
  2234. fail
  2235. else
  2236. Writeln('Passed!');
  2237. clear_globals;
  2238. clear_values;
  2239. failed := false;
  2240. constructor_init;
  2241. Write('Testing mixed parameter (LOC_REFERENCE) static method call...');
  2242. value_u8bit := RESULT_U8BIT;
  2243. value_u16bit := RESULT_U16BIT;
  2244. value_bigstring := RESULT_BIGSTRING;
  2245. value_s32bit := RESULT_S32BIT;
  2246. value_s64bit := RESULT_S64BIT;
  2247. method_static_params_mixed(value_u8bit,
  2248. value_u16bit, value_bigstring, value_s32bit, value_s64bit);
  2249. if global_u8bit <> RESULT_U8BIT then
  2250. failed := true;
  2251. if global_u16bit <> RESULT_U16BIT then
  2252. failed := true;
  2253. if global_s32bit <> RESULT_S32BIT then
  2254. failed := true;
  2255. if global_s64bit <> RESULT_S64BIT then
  2256. failed := true;
  2257. if global_bigstring <> RESULT_BIGSTRING then
  2258. failed := true;
  2259. destructor_params_done;
  2260. if failed then
  2261. fail
  2262. else
  2263. Writeln('Passed!');
  2264. { ********************************************************************
  2265. This calls methods which in turn call other methods, or a constructor
  2266. or a destructor.
  2267. *********************************************************************
  2268. }
  2269. clear_globals;
  2270. clear_values;
  2271. failed := false;
  2272. { Calls the ancestor virtual method }
  2273. constructor_init;
  2274. Write('Testing mixed parameter (LOC_CONSTANT) method call w/virtual call...');
  2275. method_normal_call_virtual_params_mixed(RESULT_U8BIT,
  2276. RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
  2277. if object_u8bit <> RESULT_U8BIT then
  2278. failed := true;
  2279. if object_u16bit <> RESULT_U16BIT then
  2280. failed := true;
  2281. if object_s32bit <> RESULT_S32BIT then
  2282. failed := true;
  2283. if object_s64bit <> RESULT_S64BIT then
  2284. failed := true;
  2285. if object_bigstring <> RESULT_BIGSTRING then
  2286. failed := true;
  2287. destructor_params_done;
  2288. if failed then
  2289. fail
  2290. else
  2291. Writeln('Passed!');
  2292. clear_globals;
  2293. clear_values;
  2294. failed := false;
  2295. constructor_init;
  2296. Write('Testing mixed parameter (LOC_REFERENCE) method call w/virtual call...');
  2297. value_u8bit := RESULT_U8BIT;
  2298. value_u16bit := RESULT_U16BIT;
  2299. value_bigstring := RESULT_BIGSTRING;
  2300. value_s32bit := RESULT_S32BIT;
  2301. value_s64bit := RESULT_S64BIT;
  2302. method_normal_call_virtual_params_mixed(value_u8bit,
  2303. value_u16bit, value_bigstring, value_s32bit, value_s64bit);
  2304. if object_u8bit <> RESULT_U8BIT then
  2305. failed := true;
  2306. if object_u16bit <> RESULT_U16BIT then
  2307. failed := true;
  2308. if object_s32bit <> RESULT_S32BIT then
  2309. failed := true;
  2310. if object_s64bit <> RESULT_S64BIT then
  2311. failed := true;
  2312. if object_bigstring <> RESULT_BIGSTRING then
  2313. failed := true;
  2314. destructor_params_done;
  2315. if failed then
  2316. fail
  2317. else
  2318. Writeln('Passed!');
  2319. { The virtual method has been overriden by the object in this case }
  2320. constructor_init;
  2321. Write('Testing mixed parameter (LOC_CONSTANT) method call w/virtual call...');
  2322. method_normal_call_overriden_params_mixed(RESULT_U8BIT,
  2323. RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
  2324. if object_u8bit <> RESULT_U8BIT then
  2325. failed := true;
  2326. if object_u16bit <> RESULT_U16BIT then
  2327. failed := true;
  2328. if object_s32bit <> RESULT_S32BIT then
  2329. failed := true;
  2330. if object_s64bit <> RESULT_S64BIT then
  2331. failed := true;
  2332. if object_bigstring <> RESULT_BIGSTRING then
  2333. failed := true;
  2334. destructor_params_done;
  2335. if failed then
  2336. fail
  2337. else
  2338. Writeln('Passed!');
  2339. clear_globals;
  2340. clear_values;
  2341. failed := false;
  2342. constructor_init;
  2343. Write('Testing mixed parameter (LOC_REFERENCE) method call w/virtual call...');
  2344. value_u8bit := RESULT_U8BIT;
  2345. value_u16bit := RESULT_U16BIT;
  2346. value_bigstring := RESULT_BIGSTRING;
  2347. value_s32bit := RESULT_S32BIT;
  2348. value_s64bit := RESULT_S64BIT;
  2349. method_normal_call_overriden_params_mixed(value_u8bit,
  2350. value_u16bit, value_bigstring, value_s32bit, value_s64bit);
  2351. if object_u8bit <> RESULT_U8BIT then
  2352. failed := true;
  2353. if object_u16bit <> RESULT_U16BIT then
  2354. failed := true;
  2355. if object_s32bit <> RESULT_S32BIT then
  2356. failed := true;
  2357. if object_s64bit <> RESULT_S64BIT then
  2358. failed := true;
  2359. if object_bigstring <> RESULT_BIGSTRING then
  2360. failed := true;
  2361. destructor_params_done;
  2362. if failed then
  2363. fail
  2364. else
  2365. Writeln('Passed!');
  2366. clear_globals;
  2367. clear_values;
  2368. failed := false;
  2369. constructor_init;
  2370. Write('Testing mixed parameter (LOC_CONSTANT) method call w/normal call...');
  2371. method_normal_call_normal_params_mixed(RESULT_U8BIT,
  2372. RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
  2373. if object_u8bit <> RESULT_U8BIT then
  2374. failed := true;
  2375. if object_u16bit <> RESULT_U16BIT then
  2376. failed := true;
  2377. if object_s32bit <> RESULT_S32BIT then
  2378. failed := true;
  2379. if object_s64bit <> RESULT_S64BIT then
  2380. failed := true;
  2381. if object_bigstring <> RESULT_BIGSTRING then
  2382. failed := true;
  2383. destructor_params_done;
  2384. if failed then
  2385. fail
  2386. else
  2387. Writeln('Passed!');
  2388. clear_globals;
  2389. clear_values;
  2390. failed := false;
  2391. constructor_init;
  2392. Write('Testing mixed parameter (LOC_REFERENCE) method call w/normal call...');
  2393. value_u8bit := RESULT_U8BIT;
  2394. value_u16bit := RESULT_U16BIT;
  2395. value_bigstring := RESULT_BIGSTRING;
  2396. value_s32bit := RESULT_S32BIT;
  2397. value_s64bit := RESULT_S64BIT;
  2398. method_normal_call_normal_params_mixed(value_u8bit,
  2399. value_u16bit, value_bigstring, value_s32bit, value_s64bit);
  2400. if object_u8bit <> RESULT_U8BIT then
  2401. failed := true;
  2402. if object_u16bit <> RESULT_U16BIT then
  2403. failed := true;
  2404. if object_s32bit <> RESULT_S32BIT then
  2405. failed := true;
  2406. if object_s64bit <> RESULT_S64BIT then
  2407. failed := true;
  2408. if object_bigstring <> RESULT_BIGSTRING then
  2409. failed := true;
  2410. destructor_params_done;
  2411. if failed then
  2412. fail
  2413. else
  2414. Writeln('Passed!');
  2415. (* constructor call inside a normal method *)
  2416. clear_globals;
  2417. clear_values;
  2418. failed := false;
  2419. constructor_init;
  2420. Write('Testing mixed parameter (LOC_CONSTANT) method call w/constructor call...');
  2421. method_normal_call_constructor_params_mixed(RESULT_U8BIT,
  2422. RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
  2423. if object_u8bit <> RESULT_U8BIT then
  2424. failed := true;
  2425. if object_u16bit <> RESULT_U16BIT then
  2426. failed := true;
  2427. if object_s32bit <> RESULT_S32BIT then
  2428. failed := true;
  2429. if object_s64bit <> RESULT_S64BIT then
  2430. failed := true;
  2431. if object_bigstring <> RESULT_BIGSTRING then
  2432. failed := true;
  2433. destructor_params_done;
  2434. if failed then
  2435. fail
  2436. else
  2437. Writeln('Passed!');
  2438. clear_globals;
  2439. clear_values;
  2440. failed := false;
  2441. constructor_init;
  2442. Write('Testing mixed parameter (LOC_REFERENCE) method call w/constructor call...');
  2443. value_u8bit := RESULT_U8BIT;
  2444. value_u16bit := RESULT_U16BIT;
  2445. value_bigstring := RESULT_BIGSTRING;
  2446. value_s32bit := RESULT_S32BIT;
  2447. value_s64bit := RESULT_S64BIT;
  2448. method_normal_call_constructor_params_mixed(value_u8bit,
  2449. value_u16bit, value_bigstring, value_s32bit, value_s64bit);
  2450. if object_u8bit <> RESULT_U8BIT then
  2451. failed := true;
  2452. if object_u16bit <> RESULT_U16BIT then
  2453. failed := true;
  2454. if object_s32bit <> RESULT_S32BIT then
  2455. failed := true;
  2456. if object_s64bit <> RESULT_S64BIT then
  2457. failed := true;
  2458. if object_bigstring <> RESULT_BIGSTRING then
  2459. failed := true;
  2460. destructor_params_done;
  2461. if failed then
  2462. fail
  2463. else
  2464. Writeln('Passed!');
  2465. { static method call }
  2466. clear_globals;
  2467. clear_values;
  2468. failed := false;
  2469. constructor_init;
  2470. Write('Testing mixed parameter (LOC_CONSTANT) method call w/static call...');
  2471. method_normal_call_static_params_mixed(RESULT_U8BIT,
  2472. RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
  2473. if global_u8bit <> RESULT_U8BIT then
  2474. failed := true;
  2475. if global_u16bit <> RESULT_U16BIT then
  2476. failed := true;
  2477. if global_s32bit <> RESULT_S32BIT then
  2478. failed := true;
  2479. if global_s64bit <> RESULT_S64BIT then
  2480. failed := true;
  2481. if global_bigstring <> RESULT_BIGSTRING then
  2482. failed := true;
  2483. destructor_params_done;
  2484. if failed then
  2485. fail
  2486. else
  2487. Writeln('Passed!');
  2488. clear_globals;
  2489. clear_values;
  2490. failed := false;
  2491. constructor_init;
  2492. Write('Testing mixed parameter (LOC_REFERENCE) method call w/static call...');
  2493. value_u8bit := RESULT_U8BIT;
  2494. value_u16bit := RESULT_U16BIT;
  2495. value_bigstring := RESULT_BIGSTRING;
  2496. value_s32bit := RESULT_S32BIT;
  2497. value_s64bit := RESULT_S64BIT;
  2498. method_normal_call_static_params_mixed(value_u8bit,
  2499. value_u16bit, value_bigstring, value_s32bit, value_s64bit);
  2500. if global_u8bit <> RESULT_U8BIT then
  2501. failed := true;
  2502. if global_u16bit <> RESULT_U16BIT then
  2503. failed := true;
  2504. if global_s32bit <> RESULT_S32BIT then
  2505. failed := true;
  2506. if global_s64bit <> RESULT_S64BIT then
  2507. failed := true;
  2508. if global_bigstring <> RESULT_BIGSTRING then
  2509. failed := true;
  2510. destructor_params_done;
  2511. if failed then
  2512. fail
  2513. else
  2514. Writeln('Passed!');
  2515. (* calls the inherited method *)
  2516. clear_globals;
  2517. clear_values;
  2518. failed := false;
  2519. { Calls the ancestor virtual method }
  2520. constructor_init;
  2521. Write('Testing mixed parameter (LOC_CONSTANT) method call w/inherited call...');
  2522. method_normal_call_inherited_params_mixed(RESULT_U8BIT,
  2523. RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
  2524. if object_u8bit <> RESULT_U8BIT then
  2525. failed := true;
  2526. if object_u16bit <> RESULT_U16BIT then
  2527. failed := true;
  2528. if object_s32bit <> RESULT_S32BIT then
  2529. failed := true;
  2530. if object_s64bit <> RESULT_S64BIT then
  2531. failed := true;
  2532. if object_bigstring <> RESULT_BIGSTRING then
  2533. failed := true;
  2534. destructor_params_done;
  2535. if failed then
  2536. fail
  2537. else
  2538. Writeln('Passed!');
  2539. clear_globals;
  2540. clear_values;
  2541. failed := false;
  2542. constructor_init;
  2543. Write('Testing mixed parameter (LOC_REFERENCE) method call w/inherited call...');
  2544. value_u8bit := RESULT_U8BIT;
  2545. value_u16bit := RESULT_U16BIT;
  2546. value_bigstring := RESULT_BIGSTRING;
  2547. value_s32bit := RESULT_S32BIT;
  2548. value_s64bit := RESULT_S64BIT;
  2549. method_normal_call_inherited_params_mixed(value_u8bit,
  2550. value_u16bit, value_bigstring, value_s32bit, value_s64bit);
  2551. if object_u8bit <> RESULT_U8BIT then
  2552. failed := true;
  2553. if object_u16bit <> RESULT_U16BIT then
  2554. failed := true;
  2555. if object_s32bit <> RESULT_S32BIT then
  2556. failed := true;
  2557. if object_s64bit <> RESULT_S64BIT then
  2558. failed := true;
  2559. if object_bigstring <> RESULT_BIGSTRING then
  2560. failed := true;
  2561. destructor_params_done;
  2562. if failed then
  2563. fail
  2564. else
  2565. Writeln('Passed!');
  2566. { ********************************************************************
  2567. This calls virtual methods which in turn call other methods,
  2568. or a constructor or a destructor.
  2569. *********************************************************************
  2570. }
  2571. clear_globals;
  2572. clear_values;
  2573. failed := false;
  2574. { Calls the ancestor virtual method }
  2575. constructor_init;
  2576. Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/virtual call...');
  2577. method_virtual_call_virtual_params_mixed(RESULT_U8BIT,
  2578. RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
  2579. if object_u8bit <> RESULT_U8BIT then
  2580. failed := true;
  2581. if object_u16bit <> RESULT_U16BIT then
  2582. failed := true;
  2583. if object_s32bit <> RESULT_S32BIT then
  2584. failed := true;
  2585. if object_s64bit <> RESULT_S64BIT then
  2586. failed := true;
  2587. if object_bigstring <> RESULT_BIGSTRING then
  2588. failed := true;
  2589. destructor_params_done;
  2590. if failed then
  2591. fail
  2592. else
  2593. Writeln('Passed!');
  2594. clear_globals;
  2595. clear_values;
  2596. failed := false;
  2597. constructor_init;
  2598. Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/virtual call...');
  2599. value_u8bit := RESULT_U8BIT;
  2600. value_u16bit := RESULT_U16BIT;
  2601. value_bigstring := RESULT_BIGSTRING;
  2602. value_s32bit := RESULT_S32BIT;
  2603. value_s64bit := RESULT_S64BIT;
  2604. method_virtual_call_virtual_params_mixed(value_u8bit,
  2605. value_u16bit, value_bigstring, value_s32bit, value_s64bit);
  2606. if object_u8bit <> RESULT_U8BIT then
  2607. failed := true;
  2608. if object_u16bit <> RESULT_U16BIT then
  2609. failed := true;
  2610. if object_s32bit <> RESULT_S32BIT then
  2611. failed := true;
  2612. if object_s64bit <> RESULT_S64BIT then
  2613. failed := true;
  2614. if object_bigstring <> RESULT_BIGSTRING then
  2615. failed := true;
  2616. destructor_params_done;
  2617. if failed then
  2618. fail
  2619. else
  2620. Writeln('Passed!');
  2621. { The virtual method has been overriden by the object in this case }
  2622. constructor_init;
  2623. Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/virtual call...');
  2624. method_virtual_call_overriden_params_mixed(RESULT_U8BIT,
  2625. RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
  2626. if object_u8bit <> RESULT_U8BIT then
  2627. failed := true;
  2628. if object_u16bit <> RESULT_U16BIT then
  2629. failed := true;
  2630. if object_s32bit <> RESULT_S32BIT then
  2631. failed := true;
  2632. if object_s64bit <> RESULT_S64BIT then
  2633. failed := true;
  2634. if object_bigstring <> RESULT_BIGSTRING then
  2635. failed := true;
  2636. destructor_params_done;
  2637. if failed then
  2638. fail
  2639. else
  2640. Writeln('Passed!');
  2641. clear_globals;
  2642. clear_values;
  2643. failed := false;
  2644. constructor_init;
  2645. Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/virtual call...');
  2646. value_u8bit := RESULT_U8BIT;
  2647. value_u16bit := RESULT_U16BIT;
  2648. value_bigstring := RESULT_BIGSTRING;
  2649. value_s32bit := RESULT_S32BIT;
  2650. value_s64bit := RESULT_S64BIT;
  2651. method_virtual_call_overriden_params_mixed(value_u8bit,
  2652. value_u16bit, value_bigstring, value_s32bit, value_s64bit);
  2653. if object_u8bit <> RESULT_U8BIT then
  2654. failed := true;
  2655. if object_u16bit <> RESULT_U16BIT then
  2656. failed := true;
  2657. if object_s32bit <> RESULT_S32BIT then
  2658. failed := true;
  2659. if object_s64bit <> RESULT_S64BIT then
  2660. failed := true;
  2661. if object_bigstring <> RESULT_BIGSTRING then
  2662. failed := true;
  2663. destructor_params_done;
  2664. if failed then
  2665. fail
  2666. else
  2667. Writeln('Passed!');
  2668. clear_globals;
  2669. clear_values;
  2670. failed := false;
  2671. constructor_init;
  2672. Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/normal call...');
  2673. method_virtual_call_normal_params_mixed(RESULT_U8BIT,
  2674. RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
  2675. if object_u8bit <> RESULT_U8BIT then
  2676. failed := true;
  2677. if object_u16bit <> RESULT_U16BIT then
  2678. failed := true;
  2679. if object_s32bit <> RESULT_S32BIT then
  2680. failed := true;
  2681. if object_s64bit <> RESULT_S64BIT then
  2682. failed := true;
  2683. if object_bigstring <> RESULT_BIGSTRING then
  2684. failed := true;
  2685. destructor_params_done;
  2686. if failed then
  2687. fail
  2688. else
  2689. Writeln('Passed!');
  2690. clear_globals;
  2691. clear_values;
  2692. failed := false;
  2693. constructor_init;
  2694. Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/normal call...');
  2695. value_u8bit := RESULT_U8BIT;
  2696. value_u16bit := RESULT_U16BIT;
  2697. value_bigstring := RESULT_BIGSTRING;
  2698. value_s32bit := RESULT_S32BIT;
  2699. value_s64bit := RESULT_S64BIT;
  2700. method_virtual_call_normal_params_mixed(value_u8bit,
  2701. value_u16bit, value_bigstring, value_s32bit, value_s64bit);
  2702. if object_u8bit <> RESULT_U8BIT then
  2703. failed := true;
  2704. if object_u16bit <> RESULT_U16BIT then
  2705. failed := true;
  2706. if object_s32bit <> RESULT_S32BIT then
  2707. failed := true;
  2708. if object_s64bit <> RESULT_S64BIT then
  2709. failed := true;
  2710. if object_bigstring <> RESULT_BIGSTRING then
  2711. failed := true;
  2712. destructor_params_done;
  2713. if failed then
  2714. fail
  2715. else
  2716. Writeln('Passed!');
  2717. (* constructor call inside a normal method *)
  2718. clear_globals;
  2719. clear_values;
  2720. failed := false;
  2721. constructor_init;
  2722. Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/constructor call...');
  2723. method_virtual_call_constructor_params_mixed(RESULT_U8BIT,
  2724. RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
  2725. if object_u8bit <> RESULT_U8BIT then
  2726. failed := true;
  2727. if object_u16bit <> RESULT_U16BIT then
  2728. failed := true;
  2729. if object_s32bit <> RESULT_S32BIT then
  2730. failed := true;
  2731. if object_s64bit <> RESULT_S64BIT then
  2732. failed := true;
  2733. if object_bigstring <> RESULT_BIGSTRING then
  2734. failed := true;
  2735. destructor_params_done;
  2736. if failed then
  2737. fail
  2738. else
  2739. Writeln('Passed!');
  2740. clear_globals;
  2741. clear_values;
  2742. failed := false;
  2743. constructor_init;
  2744. Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/constructor call...');
  2745. value_u8bit := RESULT_U8BIT;
  2746. value_u16bit := RESULT_U16BIT;
  2747. value_bigstring := RESULT_BIGSTRING;
  2748. value_s32bit := RESULT_S32BIT;
  2749. value_s64bit := RESULT_S64BIT;
  2750. method_virtual_call_constructor_params_mixed(value_u8bit,
  2751. value_u16bit, value_bigstring, value_s32bit, value_s64bit);
  2752. if object_u8bit <> RESULT_U8BIT then
  2753. failed := true;
  2754. if object_u16bit <> RESULT_U16BIT then
  2755. failed := true;
  2756. if object_s32bit <> RESULT_S32BIT then
  2757. failed := true;
  2758. if object_s64bit <> RESULT_S64BIT then
  2759. failed := true;
  2760. if object_bigstring <> RESULT_BIGSTRING then
  2761. failed := true;
  2762. destructor_params_done;
  2763. if failed then
  2764. fail
  2765. else
  2766. Writeln('Passed!');
  2767. { static virtual call }
  2768. clear_globals;
  2769. clear_values;
  2770. failed := false;
  2771. constructor_init;
  2772. Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/static call...');
  2773. method_virtual_call_static_params_mixed(RESULT_U8BIT,
  2774. RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
  2775. if global_u8bit <> RESULT_U8BIT then
  2776. failed := true;
  2777. if global_u16bit <> RESULT_U16BIT then
  2778. failed := true;
  2779. if global_s32bit <> RESULT_S32BIT then
  2780. failed := true;
  2781. if global_s64bit <> RESULT_S64BIT then
  2782. failed := true;
  2783. if global_bigstring <> RESULT_BIGSTRING then
  2784. failed := true;
  2785. destructor_params_done;
  2786. if failed then
  2787. fail
  2788. else
  2789. Writeln('Passed!');
  2790. clear_globals;
  2791. clear_values;
  2792. failed := false;
  2793. constructor_init;
  2794. Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/static call...');
  2795. value_u8bit := RESULT_U8BIT;
  2796. value_u16bit := RESULT_U16BIT;
  2797. value_bigstring := RESULT_BIGSTRING;
  2798. value_s32bit := RESULT_S32BIT;
  2799. value_s64bit := RESULT_S64BIT;
  2800. method_virtual_call_static_params_mixed(value_u8bit,
  2801. value_u16bit, value_bigstring, value_s32bit, value_s64bit);
  2802. if global_u8bit <> RESULT_U8BIT then
  2803. failed := true;
  2804. if global_u16bit <> RESULT_U16BIT then
  2805. failed := true;
  2806. if global_s32bit <> RESULT_S32BIT then
  2807. failed := true;
  2808. if global_s64bit <> RESULT_S64BIT then
  2809. failed := true;
  2810. if global_bigstring <> RESULT_BIGSTRING then
  2811. failed := true;
  2812. destructor_params_done;
  2813. if failed then
  2814. fail
  2815. else
  2816. Writeln('Passed!');
  2817. (* calls the inherited method *)
  2818. clear_globals;
  2819. clear_values;
  2820. failed := false;
  2821. { Calls the ancestor virtual method }
  2822. constructor_init;
  2823. Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/inherited call...');
  2824. method_virtual_call_inherited_params_mixed(RESULT_U8BIT,
  2825. RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
  2826. if object_u8bit <> RESULT_U8BIT then
  2827. failed := true;
  2828. if object_u16bit <> RESULT_U16BIT then
  2829. failed := true;
  2830. if object_s32bit <> RESULT_S32BIT then
  2831. failed := true;
  2832. if object_s64bit <> RESULT_S64BIT then
  2833. failed := true;
  2834. if object_bigstring <> RESULT_BIGSTRING then
  2835. failed := true;
  2836. destructor_params_done;
  2837. if failed then
  2838. fail
  2839. else
  2840. Writeln('Passed!');
  2841. clear_globals;
  2842. clear_values;
  2843. failed := false;
  2844. constructor_init;
  2845. Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/inherited call...');
  2846. value_u8bit := RESULT_U8BIT;
  2847. value_u16bit := RESULT_U16BIT;
  2848. value_bigstring := RESULT_BIGSTRING;
  2849. value_s32bit := RESULT_S32BIT;
  2850. value_s64bit := RESULT_S64BIT;
  2851. method_virtual_call_inherited_params_mixed(value_u8bit,
  2852. value_u16bit, value_bigstring, value_s32bit, value_s64bit);
  2853. if object_u8bit <> RESULT_U8BIT then
  2854. failed := true;
  2855. if object_u16bit <> RESULT_U16BIT then
  2856. failed := true;
  2857. if object_s32bit <> RESULT_S32BIT then
  2858. failed := true;
  2859. if object_s64bit <> RESULT_S64BIT then
  2860. failed := true;
  2861. if object_bigstring <> RESULT_BIGSTRING then
  2862. failed := true;
  2863. destructor_params_done;
  2864. if failed then
  2865. fail
  2866. else
  2867. Writeln('Passed!');
  2868. end; { end with }
  2869. end;
  2870. begin
  2871. WriteLN('*********************** NO VMT OBJECT TESTS ********************');
  2872. testnovmtobject;
  2873. WriteLN('************************ VMT OBJECT FAIL **********************');
  2874. testfailedobject;
  2875. WriteLN('************************* VMT OBJECT TESTS *********************');
  2876. testvmtobject;
  2877. testheritedvmtobject;
  2878. WriteLN('**************** VMT OBJECT TESTS USING WITH *******************');
  2879. testwith;
  2880. end.