2
0

tcalobj1.pp 64 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128
  1. {****************************************************************}
  2. { CODE GENERATOR TEST PROGRAM }
  3. { Copyright (c) 2002 Carl Eric Codere }
  4. {****************************************************************}
  5. { NODE TESTED : secondcalln() }
  6. {****************************************************************}
  7. { PRE-REQUISITES: secondload() }
  8. { secondassign() }
  9. { secondtypeconv() }
  10. { secondtryexcept() }
  11. {****************************************************************}
  12. { DEFINES: }
  13. { FPC = Target is FreePascal compiler }
  14. {****************************************************************}
  15. { REMARKS: This tests secondcalln(), genentrycode() and }
  16. { genexitcode(). }
  17. { }
  18. { }
  19. {****************************************************************}
  20. program tcalobj1;
  21. {$STATIC ON}
  22. {$R+}
  23. const
  24. { should be defined depending on CPU target }
  25. {$ifdef cpu68k}
  26. BIG_INDEX = 8000;
  27. SMALL_INDEX = 13;
  28. {$endif}
  29. {$ifdef cpu86}
  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;
  145. procedure method_public_static_none; static;
  146. procedure method_call_private_none;
  147. procedure method_call_private_static_none; static;
  148. { simple value parameter testing }
  149. procedure method_public_u8(x : byte);
  150. procedure method_public_static_u8(x: byte); static;
  151. procedure method_call_private_u8(x: byte);
  152. procedure method_call_private_static_u8(x: byte); static;
  153. function func_array_mixed_nested(b: byte): tsmallarray;
  154. private
  155. procedure method_private_none;
  156. procedure method_private_static_none; static;
  157. function func_getu16bit : word;
  158. { simple value parameter testing }
  159. procedure method_private_u8(x: byte);
  160. procedure method_private_static_u8(x: byte); static;
  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);
  177. procedure method_virtual_params_mixed(u8 :byte; u16: word;
  178. bigstring: shortstring; s32: longint; s64: int64);virtual;
  179. procedure method_virtual_overriden_params_mixed(u8 :byte; u16: word;
  180. bigstring: shortstring; s32: longint; s64: int64);virtual;
  181. procedure method_static_params_mixed(u8 :byte; u16: word;
  182. bigstring: shortstring; s32: longint; s64: int64);static;
  183. procedure method_normal_call_inherited_params_mixed(
  184. u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
  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;
  188. procedure method_virtual_call_virtual_params_mixed(
  189. u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;
  190. procedure method_virtual_call_overriden_params_mixed(
  191. u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;
  192. procedure method_virtual_call_normal_params_mixed(
  193. u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;
  194. procedure method_virtual_call_constructor_params_mixed(
  195. u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;
  196. procedure method_virtual_call_inherited_params_mixed(
  197. u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;
  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;
  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);
  216. procedure method_normal_call_virtual_params_mixed(
  217. u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
  218. procedure method_normal_call_overriden_params_mixed(
  219. u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
  220. procedure method_normal_call_normal_params_mixed(
  221. u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
  222. procedure method_normal_call_constructor_params_mixed(
  223. u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
  224. procedure method_normal_call_inherited_params_mixed(
  225. u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
  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;
  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;
  240. begin
  241. global_u8bit := RESULT_U8BIT;
  242. end;
  243. procedure tnovmtobject.method_public_static_none;
  244. begin
  245. global_u8bit := RESULT_U8BIT;
  246. end;
  247. procedure tnovmtobject.method_call_private_none;
  248. begin
  249. method_private_none;
  250. method_private_static_none;
  251. end;
  252. procedure tnovmtobject.method_call_private_static_none;
  253. begin
  254. method_private_static_none;
  255. end;
  256. procedure tnovmtobject.method_private_none;
  257. begin
  258. Inc(global_u16bit, RESULT_U8BIT);
  259. end;
  260. procedure tnovmtobject.method_private_static_none;
  261. begin
  262. Inc(global_u16bit, RESULT_U8BIT);
  263. end;
  264. {******************** PARAMETERS ******************}
  265. procedure tnovmtobject.method_public_u8(x : byte);
  266. begin
  267. global_u8bit := x;
  268. end;
  269. procedure tnovmtobject.method_public_static_u8(x: byte);
  270. begin
  271. global_u8bit := x;
  272. end;
  273. procedure tnovmtobject.method_call_private_u8(x: byte);
  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);
  279. begin
  280. method_private_static_u8(x);
  281. end;
  282. procedure tnovmtobject.method_private_u8(x: byte);
  283. begin
  284. Inc(global_u16bit,x);
  285. end;
  286. procedure tnovmtobject.method_private_static_u8(x: byte);
  287. begin
  288. Inc(global_u16bit,x);
  289. end;
  290. function tnovmtobject.func_getu16bit : word;
  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;
  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; bigstring: shortstring; s32: longint; s64: int64);
  350. begin
  351. object_u8bit := u8;
  352. object_u16bit := u16;
  353. object_bigstring := bigstring;
  354. object_s32bit := s32;
  355. object_s64bit := s64;
  356. end;
  357. constructor tvmtobject.constructor_init;
  358. begin
  359. object_u8bit := 0;
  360. object_u16bit := 0;
  361. object_bigstring := '';
  362. object_s32bit := 0;
  363. object_s64bit := 0;
  364. end;
  365. destructor tvmtobject.destructor_params_done;
  366. begin
  367. object_u8bit := 0;
  368. object_u16bit := 0;
  369. object_bigstring := '';
  370. object_s32bit := 0;
  371. object_s64bit := 0;
  372. end;
  373. procedure tvmtobject.method_normal_params_mixed(
  374. u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
  375. begin
  376. object_u8bit := u8;
  377. object_u16bit := u16;
  378. object_bigstring := bigstring;
  379. object_s32bit := s32;
  380. object_s64bit := s64;
  381. end;
  382. procedure tvmtobject.method_virtual_params_mixed(
  383. u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
  384. begin
  385. object_u8bit := u8;
  386. object_u16bit := u16;
  387. object_bigstring := bigstring;
  388. object_s32bit := s32;
  389. object_s64bit := s64;
  390. end;
  391. { this one should be overriden }
  392. procedure tvmtobject.method_virtual_overriden_params_mixed(
  393. u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
  394. begin
  395. RunError(211);
  396. end;
  397. { can't access field of instances in static methods }
  398. procedure tvmtobject.method_static_params_mixed(
  399. u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
  400. begin
  401. global_u8bit := u8;
  402. global_u16bit := u16;
  403. global_bigstring := bigstring;
  404. global_s32bit := s32;
  405. global_s64bit := s64;
  406. end;
  407. procedure tvmtobject.method_normal_call_inherited_params_mixed(
  408. u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
  409. begin
  410. object_u8bit := u8;
  411. object_u16bit := u16;
  412. object_bigstring := bigstring;
  413. object_s32bit := s32;
  414. object_s64bit := s64;
  415. end;
  416. procedure tvmtobject.method_virtual_call_static_params_mixed(
  417. u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
  418. begin
  419. method_static_params_mixed(u8, u16, bigstring, s32, s64);
  420. end;
  421. procedure tvmtobject.method_virtual_call_virtual_params_mixed(
  422. u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
  423. begin
  424. method_virtual_params_mixed(u8, u16, bigstring, s32, s64);
  425. end;
  426. procedure tvmtobject.method_virtual_call_overriden_params_mixed(
  427. u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
  428. begin
  429. method_virtual_overriden_params_mixed(u8, u16, bigstring, s32, s64);
  430. end;
  431. procedure tvmtobject.method_virtual_call_normal_params_mixed(
  432. u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
  433. begin
  434. method_normal_params_mixed(u8, u16, bigstring, s32, s64);
  435. end;
  436. procedure tvmtobject.method_virtual_call_constructor_params_mixed(
  437. u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
  438. begin
  439. constructor_params_mixed(u8, u16, bigstring, s32, s64);
  440. end;
  441. procedure tvmtobject.method_virtual_call_inherited_params_mixed(
  442. u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
  443. begin
  444. object_u8bit := u8;
  445. object_u16bit := u16;
  446. object_bigstring := bigstring;
  447. object_s32bit := s32;
  448. object_s64bit := s64;
  449. end;
  450. {**************************************************************************}
  451. { INHERITED VMT OBJECT }
  452. {**************************************************************************}
  453. constructor theritedvmtobject.constructor_params_mixed_call_virtual(
  454. u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
  455. begin
  456. object_u8bit := 0;
  457. object_u16bit := 0;
  458. object_bigstring := '';
  459. object_s32bit := 0;
  460. object_s64bit := 0;
  461. method_virtual_params_mixed(u8, u16, bigstring, s32, s64);
  462. end;
  463. constructor theritedvmtobject.constructor_params_mixed_call_overriden(
  464. u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
  465. begin
  466. object_u8bit := 0;
  467. object_u16bit := 0;
  468. object_bigstring := '';
  469. object_s32bit := 0;
  470. object_s64bit := 0;
  471. method_virtual_overriden_params_mixed(u8, u16, bigstring, s32, s64);
  472. end;
  473. constructor theritedvmtobject.constructor_params_mixed_call_static(
  474. u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
  475. begin
  476. object_u8bit := 0;
  477. object_u16bit := 0;
  478. object_bigstring := '';
  479. object_s32bit := 0;
  480. object_s64bit := 0;
  481. method_static_params_mixed(u8, u16, bigstring, s32, s64);
  482. end;
  483. constructor theritedvmtobject.constructor_params_mixed_call_normal(
  484. u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
  485. begin
  486. object_u8bit := 0;
  487. object_u16bit := 0;
  488. object_bigstring := '';
  489. object_s32bit := 0;
  490. object_s64bit := 0;
  491. method_normal_params_mixed(u8, u16, bigstring, s32, s64);
  492. end;
  493. constructor theritedvmtobject.constructor_params_mixed_call_inherited
  494. (u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
  495. begin
  496. object_u8bit := 0;
  497. object_u16bit := 0;
  498. object_bigstring := '';
  499. object_s32bit := 0;
  500. object_s64bit := 0;
  501. inherited constructor_params_mixed(u8, u16, bigstring, s32, s64);
  502. end;
  503. { this one should be overriden }
  504. procedure theritedvmtobject.method_virtual_overriden_params_mixed(
  505. u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
  506. begin
  507. object_u8bit := u8;
  508. object_u16bit := u16;
  509. object_bigstring := bigstring;
  510. object_s32bit := s32;
  511. object_s64bit := s64;
  512. end;
  513. procedure theritedvmtobject.method_normal_call_static_params_mixed(
  514. u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
  515. begin
  516. method_static_params_mixed(u8, u16, bigstring, s32, s64);
  517. end;
  518. procedure theritedvmtobject.method_normal_call_virtual_params_mixed(
  519. u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
  520. begin
  521. method_virtual_params_mixed(u8, u16, bigstring, s32, s64);
  522. end;
  523. procedure theritedvmtobject.method_normal_call_overriden_params_mixed(
  524. u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
  525. begin
  526. method_virtual_overriden_params_mixed(u8, u16, bigstring, s32, s64);
  527. end;
  528. procedure theritedvmtobject.method_normal_call_normal_params_mixed(
  529. u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
  530. begin
  531. method_normal_params_mixed(u8, u16, bigstring, s32, s64);
  532. end;
  533. procedure theritedvmtobject.method_normal_call_constructor_params_mixed(
  534. u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
  535. begin
  536. constructor_params_mixed(u8, u16, bigstring, s32, s64);
  537. end;
  538. procedure theritedvmtobject.method_normal_call_inherited_params_mixed(
  539. u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
  540. begin
  541. Inherited method_normal_call_inherited_params_mixed(u8, u16, bigstring,
  542. s32, s64);
  543. end;
  544. procedure theritedvmtobject.method_virtual_call_inherited_params_mixed(
  545. u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
  546. begin
  547. Inherited method_virtual_call_inherited_params_mixed(u8, u16, bigstring,
  548. s32, s64);
  549. end;
  550. procedure testnovmtobject;
  551. var
  552. novmtobject : tnovmtobject;
  553. failed : boolean;
  554. begin
  555. {******************** STATIC / METHOD SIMPLE CALL **********************}
  556. Write('No parameter / method call testing...');
  557. failed := false;
  558. clear_globals;
  559. clear_values;
  560. tnovmtobject.method_public_static_none;
  561. if global_u8bit <> RESULT_U8BIT then
  562. failed := true;
  563. clear_globals;
  564. clear_values;
  565. novmtobject.method_public_static_none;
  566. if global_u8bit <> RESULT_U8BIT then
  567. failed := true;
  568. clear_globals;
  569. clear_values;
  570. tnovmtobject.method_call_private_static_none;
  571. if global_u16bit <> RESULT_U8BIT then
  572. failed := true;
  573. clear_globals;
  574. clear_values;
  575. novmtobject.method_call_private_static_none;
  576. if global_u16bit <> RESULT_U8BIT then
  577. failed := true;
  578. clear_globals;
  579. clear_values;
  580. novmtobject.method_public_none;
  581. if global_u8bit <> RESULT_U8BIT then
  582. failed := true;
  583. clear_globals;
  584. clear_values;
  585. novmtobject.method_call_private_none;
  586. if global_u16bit <> (RESULT_U16BIT) then
  587. failed := true;
  588. if failed then
  589. fail
  590. else
  591. WriteLn('Passed!');
  592. Write('Simple parameter (LOC_CONSTANT) / method call testing...');
  593. failed := false;
  594. clear_globals;
  595. clear_values;
  596. { parameter is LOC_CONSTANT }
  597. novmtobject.method_public_u8(RESULT_U8BIT);
  598. if global_u8bit <> RESULT_U8BIT then
  599. failed := true;
  600. clear_globals;
  601. clear_values;
  602. tnovmtobject.method_public_static_u8(RESULT_U8BIT);
  603. if global_u8bit <> RESULT_U8BIT then
  604. failed := true;
  605. clear_globals;
  606. clear_values;
  607. novmtobject.method_public_static_u8(RESULT_U8BIT);
  608. if global_u8bit <> RESULT_U8BIT then
  609. failed := true;
  610. clear_globals;
  611. clear_values;
  612. novmtobject.method_call_private_u8(RESULT_U8BIT);
  613. if global_u16bit <> (RESULT_U16BIT) then
  614. failed := true;
  615. clear_globals;
  616. clear_values;
  617. novmtobject.method_call_private_static_u8(RESULT_U8BIT);
  618. if global_u16bit <> (RESULT_U8BIT) then
  619. failed := true;
  620. if failed then
  621. fail
  622. else
  623. WriteLn('Passed!');
  624. Write('Simple parameter (LOC_REFERENCE) / method call testing...');
  625. failed := false;
  626. clear_globals;
  627. clear_values;
  628. value_u8bit := RESULT_U8BIT;
  629. novmtobject.method_public_u8(value_u8bit);
  630. if global_u8bit <> RESULT_U8BIT then
  631. failed := true;
  632. clear_globals;
  633. clear_values;
  634. value_u8bit := RESULT_U8BIT;
  635. tnovmtobject.method_public_static_u8(value_u8bit);
  636. if global_u8bit <> RESULT_U8BIT then
  637. failed := true;
  638. clear_globals;
  639. clear_values;
  640. value_u8bit := RESULT_U8BIT;
  641. novmtobject.method_public_static_u8(value_u8bit);
  642. if global_u8bit <> RESULT_U8BIT then
  643. failed := true;
  644. clear_globals;
  645. clear_values;
  646. value_u8bit := RESULT_U8BIT;
  647. novmtobject.method_call_private_u8(value_u8bit);
  648. if global_u16bit <> (RESULT_U16BIT) then
  649. failed := true;
  650. clear_globals;
  651. clear_values;
  652. value_u8bit := RESULT_U8BIT;
  653. novmtobject.method_call_private_static_u8(value_u8bit);
  654. if global_u16bit <> (RESULT_U8BIT) then
  655. failed := true;
  656. if failed then
  657. fail
  658. else
  659. WriteLn('Passed!');
  660. Write('Simple parameter (LOC_REGISTER) / method call testing...');
  661. failed := false;
  662. clear_globals;
  663. clear_values;
  664. novmtobject.method_public_u8(getu8);
  665. if global_u8bit <> RESULT_U8BIT then
  666. failed := true;
  667. clear_globals;
  668. clear_values;
  669. tnovmtobject.method_public_static_u8(getu8);
  670. if global_u8bit <> RESULT_U8BIT then
  671. failed := true;
  672. clear_globals;
  673. clear_values;
  674. novmtobject.method_public_static_u8(getu8);
  675. if global_u8bit <> RESULT_U8BIT then
  676. failed := true;
  677. clear_globals;
  678. clear_values;
  679. novmtobject.method_call_private_u8(getu8);
  680. if global_u16bit <> (RESULT_U16BIT) then
  681. failed := true;
  682. clear_globals;
  683. clear_values;
  684. novmtobject.method_call_private_static_u8(getu8);
  685. if global_u16bit <> (RESULT_U8BIT) then
  686. failed := true;
  687. if failed then
  688. fail
  689. else
  690. WriteLn('Passed!');
  691. Write('Simple parameter / complex return / nested method access testing...');
  692. clear_globals;
  693. clear_values;
  694. failed := false;
  695. novmtobject.object_bigstring := RESULT_BIGSTRING;
  696. novmtobject.object_u16bit := RESULT_U16BIT;
  697. value_smallarray := novmtobject.func_array_mixed_nested(RESULT_U8BIT);
  698. if (value_smallarray[1] <> RESULT_U8BIT) or (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) then
  699. failed := true;
  700. if global_u8bit <> RESULT_U8BIT then
  701. failed := true;
  702. if global_bigstring <> RESULT_BIGSTRING then
  703. failed := true;
  704. if global_u16bit <> RESULT_U16BIT then
  705. failed := true;
  706. if global_s32bit <> RESULT_S32BIT then
  707. failed := true;
  708. if global_s64bit <> RESULT_U8BIT then
  709. failed := true;
  710. if failed then
  711. fail
  712. else
  713. WriteLn('Passed!');
  714. end;
  715. procedure testfailedobject;
  716. var
  717. failedobject : tfailvmtobject;
  718. begin
  719. Write('Testing constructor return value...');
  720. if failedobject.constructor_public_none then
  721. fail
  722. else
  723. Writeln('Passed!');
  724. end;
  725. procedure testvmtobject;
  726. var
  727. vmtobject : tvmtobject;
  728. failed : boolean;
  729. begin
  730. clear_globals;
  731. clear_values;
  732. failed := false;
  733. Write('Testing mixed parameter (LOC_CONSTANT) constructor call...');
  734. vmtobject.constructor_params_mixed(RESULT_U8BIT, RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
  735. if vmtobject.object_u8bit <> RESULT_U8BIT then
  736. failed := true;
  737. if vmtobject.object_u16bit <> RESULT_U16BIT then
  738. failed := true;
  739. if vmtobject.object_s32bit <> RESULT_S32BIT then
  740. failed := true;
  741. if vmtobject.object_s64bit <> RESULT_S64BIT then
  742. failed := true;
  743. if vmtobject.object_bigstring <> RESULT_BIGSTRING then
  744. failed := true;
  745. vmtobject.destructor_params_done;
  746. if failed then
  747. fail
  748. else
  749. Writeln('Passed!');
  750. clear_globals;
  751. clear_values;
  752. failed := false;
  753. Write('Testing mixed parameter (LOC_REFERENCE) constructor call...');
  754. value_u8bit := RESULT_U8BIT;
  755. value_u16bit := RESULT_U16BIT;
  756. value_bigstring := RESULT_BIGSTRING;
  757. value_s32bit := RESULT_S32BIT;
  758. value_s64bit := RESULT_S64BIT;
  759. vmtobject.constructor_params_mixed(value_u8bit, value_u16bit, value_bigstring,
  760. value_s32bit, value_s64bit);
  761. if vmtobject.object_u8bit <> RESULT_U8BIT then
  762. failed := true;
  763. if vmtobject.object_u16bit <> RESULT_U16BIT then
  764. failed := true;
  765. if vmtobject.object_s32bit <> RESULT_S32BIT then
  766. failed := true;
  767. if vmtobject.object_s64bit <> RESULT_S64BIT then
  768. failed := true;
  769. if vmtobject.object_bigstring <> RESULT_BIGSTRING then
  770. failed := true;
  771. vmtobject.destructor_params_done;
  772. if failed then
  773. fail
  774. else
  775. Writeln('Passed!');
  776. end;
  777. procedure testheritedvmtobject;
  778. var
  779. vmtobject : theritedvmtobject;
  780. failed : boolean;
  781. begin
  782. {********************** CONSTRUCTOR TESTING ************************}
  783. {********************** DESTRUCTOR TESTING ************************}
  784. clear_globals;
  785. clear_values;
  786. failed := false;
  787. Write('Testing mixed parameter (LOC_CONSTANT) inherited constructor call...');
  788. vmtobject.constructor_params_mixed_call_inherited(RESULT_U8BIT, RESULT_U16BIT, RESULT_BIGSTRING,
  789. RESULT_S32BIT, RESULT_S64BIT);
  790. if vmtobject.object_u8bit <> RESULT_U8BIT then
  791. failed := true;
  792. if vmtobject.object_u16bit <> RESULT_U16BIT then
  793. failed := true;
  794. if vmtobject.object_s32bit <> RESULT_S32BIT then
  795. failed := true;
  796. if vmtobject.object_s64bit <> RESULT_S64BIT then
  797. failed := true;
  798. if vmtobject.object_bigstring <> RESULT_BIGSTRING then
  799. failed := true;
  800. vmtobject.destructor_params_done;
  801. if failed then
  802. fail
  803. else
  804. Writeln('Passed!');
  805. clear_globals;
  806. clear_values;
  807. failed := false;
  808. Write('Testing mixed parameter (LOC_REFERENCE) inherited constructor call...');
  809. value_u8bit := RESULT_U8BIT;
  810. value_u16bit := RESULT_U16BIT;
  811. value_bigstring := RESULT_BIGSTRING;
  812. value_s32bit := RESULT_S32BIT;
  813. value_s64bit := RESULT_S64BIT;
  814. vmtobject.constructor_params_mixed_call_inherited(value_u8bit,
  815. value_u16bit, value_bigstring, value_s32bit, value_s64bit);
  816. if vmtobject.object_u8bit <> RESULT_U8BIT then
  817. failed := true;
  818. if vmtobject.object_u16bit <> RESULT_U16BIT then
  819. failed := true;
  820. if vmtobject.object_s32bit <> RESULT_S32BIT then
  821. failed := true;
  822. if vmtobject.object_s64bit <> RESULT_S64BIT then
  823. failed := true;
  824. if vmtobject.object_bigstring <> RESULT_BIGSTRING then
  825. failed := true;
  826. vmtobject.destructor_params_done;
  827. if failed then
  828. fail
  829. else
  830. Writeln('Passed!');
  831. clear_globals;
  832. clear_values;
  833. failed := false;
  834. Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/virtual call...');
  835. vmtobject.constructor_params_mixed_call_virtual(RESULT_U8BIT,
  836. RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
  837. if vmtobject.object_u8bit <> RESULT_U8BIT then
  838. failed := true;
  839. if vmtobject.object_u16bit <> RESULT_U16BIT then
  840. failed := true;
  841. if vmtobject.object_s32bit <> RESULT_S32BIT then
  842. failed := true;
  843. if vmtobject.object_s64bit <> RESULT_S64BIT then
  844. failed := true;
  845. if vmtobject.object_bigstring <> RESULT_BIGSTRING then
  846. failed := true;
  847. vmtobject.destructor_params_done;
  848. if failed then
  849. fail
  850. else
  851. Writeln('Passed!');
  852. clear_globals;
  853. clear_values;
  854. failed := false;
  855. Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/virtual call...');
  856. value_u8bit := RESULT_U8BIT;
  857. value_u16bit := RESULT_U16BIT;
  858. value_bigstring := RESULT_BIGSTRING;
  859. value_s32bit := RESULT_S32BIT;
  860. value_s64bit := RESULT_S64BIT;
  861. vmtobject.constructor_params_mixed_call_virtual(value_u8bit,
  862. value_u16bit, value_bigstring, value_s32bit, value_s64bit);
  863. if vmtobject.object_u8bit <> RESULT_U8BIT then
  864. failed := true;
  865. if vmtobject.object_u16bit <> RESULT_U16BIT then
  866. failed := true;
  867. if vmtobject.object_s32bit <> RESULT_S32BIT then
  868. failed := true;
  869. if vmtobject.object_s64bit <> RESULT_S64BIT then
  870. failed := true;
  871. if vmtobject.object_bigstring <> RESULT_BIGSTRING then
  872. failed := true;
  873. vmtobject.destructor_params_done;
  874. if failed then
  875. fail
  876. else
  877. Writeln('Passed!');
  878. clear_globals;
  879. clear_values;
  880. failed := false;
  881. Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/virtual call...');
  882. vmtobject.constructor_params_mixed_call_overriden(RESULT_U8BIT,
  883. RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
  884. if vmtobject.object_u8bit <> RESULT_U8BIT then
  885. failed := true;
  886. if vmtobject.object_u16bit <> RESULT_U16BIT then
  887. failed := true;
  888. if vmtobject.object_s32bit <> RESULT_S32BIT then
  889. failed := true;
  890. if vmtobject.object_s64bit <> RESULT_S64BIT then
  891. failed := true;
  892. if vmtobject.object_bigstring <> RESULT_BIGSTRING then
  893. failed := true;
  894. vmtobject.destructor_params_done;
  895. if failed then
  896. fail
  897. else
  898. Writeln('Passed!');
  899. clear_globals;
  900. clear_values;
  901. failed := false;
  902. Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/virtual call...');
  903. value_u8bit := RESULT_U8BIT;
  904. value_u16bit := RESULT_U16BIT;
  905. value_bigstring := RESULT_BIGSTRING;
  906. value_s32bit := RESULT_S32BIT;
  907. value_s64bit := RESULT_S64BIT;
  908. vmtobject.constructor_params_mixed_call_overriden(value_u8bit,
  909. value_u16bit, value_bigstring, value_s32bit, value_s64bit);
  910. if vmtobject.object_u8bit <> RESULT_U8BIT then
  911. failed := true;
  912. if vmtobject.object_u16bit <> RESULT_U16BIT then
  913. failed := true;
  914. if vmtobject.object_s32bit <> RESULT_S32BIT then
  915. failed := true;
  916. if vmtobject.object_s64bit <> RESULT_S64BIT then
  917. failed := true;
  918. if vmtobject.object_bigstring <> RESULT_BIGSTRING then
  919. failed := true;
  920. vmtobject.destructor_params_done;
  921. if failed then
  922. fail
  923. else
  924. Writeln('Passed!');
  925. clear_globals;
  926. clear_values;
  927. failed := false;
  928. Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/method call...');
  929. vmtobject.constructor_params_mixed_call_normal(RESULT_U8BIT,
  930. RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
  931. if vmtobject.object_u8bit <> RESULT_U8BIT then
  932. failed := true;
  933. if vmtobject.object_u16bit <> RESULT_U16BIT then
  934. failed := true;
  935. if vmtobject.object_s32bit <> RESULT_S32BIT then
  936. failed := true;
  937. if vmtobject.object_s64bit <> RESULT_S64BIT then
  938. failed := true;
  939. if vmtobject.object_bigstring <> RESULT_BIGSTRING then
  940. failed := true;
  941. vmtobject.destructor_params_done;
  942. if failed then
  943. fail
  944. else
  945. Writeln('Passed!');
  946. clear_globals;
  947. clear_values;
  948. failed := false;
  949. Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/method call...');
  950. value_u8bit := RESULT_U8BIT;
  951. value_u16bit := RESULT_U16BIT;
  952. value_bigstring := RESULT_BIGSTRING;
  953. value_s32bit := RESULT_S32BIT;
  954. value_s64bit := RESULT_S64BIT;
  955. vmtobject.constructor_params_mixed_call_normal(value_u8bit,
  956. value_u16bit, value_bigstring, value_s32bit, value_s64bit);
  957. if vmtobject.object_u8bit <> RESULT_U8BIT then
  958. failed := true;
  959. if vmtobject.object_u16bit <> RESULT_U16BIT then
  960. failed := true;
  961. if vmtobject.object_s32bit <> RESULT_S32BIT then
  962. failed := true;
  963. if vmtobject.object_s64bit <> RESULT_S64BIT then
  964. failed := true;
  965. if vmtobject.object_bigstring <> RESULT_BIGSTRING then
  966. failed := true;
  967. vmtobject.destructor_params_done;
  968. if failed then
  969. fail
  970. else
  971. Writeln('Passed!');
  972. clear_globals;
  973. clear_values;
  974. failed := false;
  975. Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/static call...');
  976. vmtobject.constructor_params_mixed_call_static(RESULT_U8BIT,
  977. RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
  978. if global_u8bit <> RESULT_U8BIT then
  979. failed := true;
  980. if global_u16bit <> RESULT_U16BIT then
  981. failed := true;
  982. if global_s32bit <> RESULT_S32BIT then
  983. failed := true;
  984. if global_s64bit <> RESULT_S64BIT then
  985. failed := true;
  986. if global_bigstring <> RESULT_BIGSTRING then
  987. failed := true;
  988. vmtobject.destructor_params_done;
  989. if failed then
  990. fail
  991. else
  992. Writeln('Passed!');
  993. clear_globals;
  994. clear_values;
  995. failed := false;
  996. Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/static call...');
  997. value_u8bit := RESULT_U8BIT;
  998. value_u16bit := RESULT_U16BIT;
  999. value_bigstring := RESULT_BIGSTRING;
  1000. value_s32bit := RESULT_S32BIT;
  1001. value_s64bit := RESULT_S64BIT;
  1002. vmtobject.constructor_params_mixed_call_static(value_u8bit,
  1003. value_u16bit, value_bigstring, value_s32bit, value_s64bit);
  1004. if global_u8bit <> RESULT_U8BIT then
  1005. failed := true;
  1006. if global_u16bit <> RESULT_U16BIT then
  1007. failed := true;
  1008. if global_s32bit <> RESULT_S32BIT then
  1009. failed := true;
  1010. if global_s64bit <> RESULT_S64BIT then
  1011. failed := true;
  1012. if global_bigstring <> RESULT_BIGSTRING then
  1013. failed := true;
  1014. vmtobject.destructor_params_done;
  1015. if failed then
  1016. fail
  1017. else
  1018. Writeln('Passed!');
  1019. {************************* METHOD TESTING **************************}
  1020. clear_globals;
  1021. clear_values;
  1022. failed := false;
  1023. vmtobject.constructor_init;
  1024. Write('Testing mixed parameter (LOC_CONSTANT) virtual method call...');
  1025. vmtobject.method_virtual_params_mixed(RESULT_U8BIT,
  1026. RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
  1027. if vmtobject.object_u8bit <> RESULT_U8BIT then
  1028. failed := true;
  1029. if vmtobject.object_u16bit <> RESULT_U16BIT then
  1030. failed := true;
  1031. if vmtobject.object_s32bit <> RESULT_S32BIT then
  1032. failed := true;
  1033. if vmtobject.object_s64bit <> RESULT_S64BIT then
  1034. failed := true;
  1035. if vmtobject.object_bigstring <> RESULT_BIGSTRING then
  1036. failed := true;
  1037. vmtobject.destructor_params_done;
  1038. if failed then
  1039. fail
  1040. else
  1041. Writeln('Passed!');
  1042. clear_globals;
  1043. clear_values;
  1044. failed := false;
  1045. vmtobject.constructor_init;
  1046. Write('Testing mixed parameter (LOC_REFERENCE) virtual method call...');
  1047. value_u8bit := RESULT_U8BIT;
  1048. value_u16bit := RESULT_U16BIT;
  1049. value_bigstring := RESULT_BIGSTRING;
  1050. value_s32bit := RESULT_S32BIT;
  1051. value_s64bit := RESULT_S64BIT;
  1052. vmtobject.method_virtual_params_mixed(value_u8bit,
  1053. value_u16bit, value_bigstring, value_s32bit, value_s64bit);
  1054. if vmtobject.object_u8bit <> RESULT_U8BIT then
  1055. failed := true;
  1056. if vmtobject.object_u16bit <> RESULT_U16BIT then
  1057. failed := true;
  1058. if vmtobject.object_s32bit <> RESULT_S32BIT then
  1059. failed := true;
  1060. if vmtobject.object_s64bit <> RESULT_S64BIT then
  1061. failed := true;
  1062. if vmtobject.object_bigstring <> RESULT_BIGSTRING then
  1063. failed := true;
  1064. vmtobject.destructor_params_done;
  1065. if failed then
  1066. fail
  1067. else
  1068. Writeln('Passed!');
  1069. clear_globals;
  1070. clear_values;
  1071. failed := false;
  1072. vmtobject.constructor_init;
  1073. Write('Testing mixed parameter (LOC_CONSTANT) virtual method call...');
  1074. vmtobject.method_virtual_overriden_params_mixed(RESULT_U8BIT,
  1075. RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
  1076. if vmtobject.object_u8bit <> RESULT_U8BIT then
  1077. failed := true;
  1078. if vmtobject.object_u16bit <> RESULT_U16BIT then
  1079. failed := true;
  1080. if vmtobject.object_s32bit <> RESULT_S32BIT then
  1081. failed := true;
  1082. if vmtobject.object_s64bit <> RESULT_S64BIT then
  1083. failed := true;
  1084. if vmtobject.object_bigstring <> RESULT_BIGSTRING then
  1085. failed := true;
  1086. vmtobject.destructor_params_done;
  1087. if failed then
  1088. fail
  1089. else
  1090. Writeln('Passed!');
  1091. clear_globals;
  1092. clear_values;
  1093. failed := false;
  1094. vmtobject.constructor_init;
  1095. Write('Testing mixed parameter (LOC_REFERENCE) virtual method call...');
  1096. value_u8bit := RESULT_U8BIT;
  1097. value_u16bit := RESULT_U16BIT;
  1098. value_bigstring := RESULT_BIGSTRING;
  1099. value_s32bit := RESULT_S32BIT;
  1100. value_s64bit := RESULT_S64BIT;
  1101. vmtobject.method_virtual_overriden_params_mixed(value_u8bit,
  1102. value_u16bit, value_bigstring, value_s32bit, value_s64bit);
  1103. if vmtobject.object_u8bit <> RESULT_U8BIT then
  1104. failed := true;
  1105. if vmtobject.object_u16bit <> RESULT_U16BIT then
  1106. failed := true;
  1107. if vmtobject.object_s32bit <> RESULT_S32BIT then
  1108. failed := true;
  1109. if vmtobject.object_s64bit <> RESULT_S64BIT then
  1110. failed := true;
  1111. if vmtobject.object_bigstring <> RESULT_BIGSTRING then
  1112. failed := true;
  1113. vmtobject.destructor_params_done;
  1114. if failed then
  1115. fail
  1116. else
  1117. Writeln('Passed!');
  1118. clear_globals;
  1119. clear_values;
  1120. failed := false;
  1121. vmtobject.constructor_init;
  1122. Write('Testing mixed parameter (LOC_CONSTANT) method call...');
  1123. vmtobject.method_normal_params_mixed(RESULT_U8BIT,
  1124. RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
  1125. if vmtobject.object_u8bit <> RESULT_U8BIT then
  1126. failed := true;
  1127. if vmtobject.object_u16bit <> RESULT_U16BIT then
  1128. failed := true;
  1129. if vmtobject.object_s32bit <> RESULT_S32BIT then
  1130. failed := true;
  1131. if vmtobject.object_s64bit <> RESULT_S64BIT then
  1132. failed := true;
  1133. if vmtobject.object_bigstring <> RESULT_BIGSTRING then
  1134. failed := true;
  1135. vmtobject.destructor_params_done;
  1136. if failed then
  1137. fail
  1138. else
  1139. Writeln('Passed!');
  1140. clear_globals;
  1141. clear_values;
  1142. failed := false;
  1143. vmtobject.constructor_init;
  1144. Write('Testing mixed parameter (LOC_REFERENCE) method call...');
  1145. value_u8bit := RESULT_U8BIT;
  1146. value_u16bit := RESULT_U16BIT;
  1147. value_bigstring := RESULT_BIGSTRING;
  1148. value_s32bit := RESULT_S32BIT;
  1149. value_s64bit := RESULT_S64BIT;
  1150. vmtobject.method_normal_params_mixed(value_u8bit,
  1151. value_u16bit, value_bigstring, value_s32bit, value_s64bit);
  1152. if vmtobject.object_u8bit <> RESULT_U8BIT then
  1153. failed := true;
  1154. if vmtobject.object_u16bit <> RESULT_U16BIT then
  1155. failed := true;
  1156. if vmtobject.object_s32bit <> RESULT_S32BIT then
  1157. failed := true;
  1158. if vmtobject.object_s64bit <> RESULT_S64BIT then
  1159. failed := true;
  1160. if vmtobject.object_bigstring <> RESULT_BIGSTRING then
  1161. failed := true;
  1162. vmtobject.destructor_params_done;
  1163. if failed then
  1164. fail
  1165. else
  1166. Writeln('Passed!');
  1167. clear_globals;
  1168. clear_values;
  1169. failed := false;
  1170. vmtobject.constructor_init;
  1171. Write('Testing mixed parameter (LOC_CONSTANT) static method call...');
  1172. vmtobject.method_static_params_mixed(RESULT_U8BIT,
  1173. RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
  1174. if global_u8bit <> RESULT_U8BIT then
  1175. failed := true;
  1176. if global_u16bit <> RESULT_U16BIT then
  1177. failed := true;
  1178. if global_s32bit <> RESULT_S32BIT then
  1179. failed := true;
  1180. if global_s64bit <> RESULT_S64BIT then
  1181. failed := true;
  1182. if global_bigstring <> RESULT_BIGSTRING then
  1183. failed := true;
  1184. vmtobject.destructor_params_done;
  1185. if failed then
  1186. fail
  1187. else
  1188. Writeln('Passed!');
  1189. clear_globals;
  1190. clear_values;
  1191. failed := false;
  1192. vmtobject.constructor_init;
  1193. Write('Testing mixed parameter (LOC_REFERENCE) static method call...');
  1194. value_u8bit := RESULT_U8BIT;
  1195. value_u16bit := RESULT_U16BIT;
  1196. value_bigstring := RESULT_BIGSTRING;
  1197. value_s32bit := RESULT_S32BIT;
  1198. value_s64bit := RESULT_S64BIT;
  1199. vmtobject.method_static_params_mixed(value_u8bit,
  1200. value_u16bit, value_bigstring, value_s32bit, value_s64bit);
  1201. if global_u8bit <> RESULT_U8BIT then
  1202. failed := true;
  1203. if global_u16bit <> RESULT_U16BIT then
  1204. failed := true;
  1205. if global_s32bit <> RESULT_S32BIT then
  1206. failed := true;
  1207. if global_s64bit <> RESULT_S64BIT then
  1208. failed := true;
  1209. if global_bigstring <> RESULT_BIGSTRING then
  1210. failed := true;
  1211. vmtobject.destructor_params_done;
  1212. if failed then
  1213. fail
  1214. else
  1215. Writeln('Passed!');
  1216. { ********************************************************************
  1217. This calls methods which in turn call other methods, or a constructor
  1218. or a destructor.
  1219. *********************************************************************
  1220. }
  1221. clear_globals;
  1222. clear_values;
  1223. failed := false;
  1224. { Calls the ancestor virtual method }
  1225. vmtobject.constructor_init;
  1226. Write('Testing mixed parameter (LOC_CONSTANT) method call w/virtual call...');
  1227. vmtobject.method_normal_call_virtual_params_mixed(RESULT_U8BIT,
  1228. RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
  1229. if vmtobject.object_u8bit <> RESULT_U8BIT then
  1230. failed := true;
  1231. if vmtobject.object_u16bit <> RESULT_U16BIT then
  1232. failed := true;
  1233. if vmtobject.object_s32bit <> RESULT_S32BIT then
  1234. failed := true;
  1235. if vmtobject.object_s64bit <> RESULT_S64BIT then
  1236. failed := true;
  1237. if vmtobject.object_bigstring <> RESULT_BIGSTRING then
  1238. failed := true;
  1239. vmtobject.destructor_params_done;
  1240. if failed then
  1241. fail
  1242. else
  1243. Writeln('Passed!');
  1244. clear_globals;
  1245. clear_values;
  1246. failed := false;
  1247. vmtobject.constructor_init;
  1248. Write('Testing mixed parameter (LOC_REFERENCE) method call w/virtual call...');
  1249. value_u8bit := RESULT_U8BIT;
  1250. value_u16bit := RESULT_U16BIT;
  1251. value_bigstring := RESULT_BIGSTRING;
  1252. value_s32bit := RESULT_S32BIT;
  1253. value_s64bit := RESULT_S64BIT;
  1254. vmtobject.method_normal_call_virtual_params_mixed(value_u8bit,
  1255. value_u16bit, value_bigstring, value_s32bit, value_s64bit);
  1256. if vmtobject.object_u8bit <> RESULT_U8BIT then
  1257. failed := true;
  1258. if vmtobject.object_u16bit <> RESULT_U16BIT then
  1259. failed := true;
  1260. if vmtobject.object_s32bit <> RESULT_S32BIT then
  1261. failed := true;
  1262. if vmtobject.object_s64bit <> RESULT_S64BIT then
  1263. failed := true;
  1264. if vmtobject.object_bigstring <> RESULT_BIGSTRING then
  1265. failed := true;
  1266. vmtobject.destructor_params_done;
  1267. if failed then
  1268. fail
  1269. else
  1270. Writeln('Passed!');
  1271. { The virtual method has been overriden by the object in this case }
  1272. vmtobject.constructor_init;
  1273. Write('Testing mixed parameter (LOC_CONSTANT) method call w/virtual call...');
  1274. vmtobject.method_normal_call_overriden_params_mixed(RESULT_U8BIT,
  1275. RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
  1276. if vmtobject.object_u8bit <> RESULT_U8BIT then
  1277. failed := true;
  1278. if vmtobject.object_u16bit <> RESULT_U16BIT then
  1279. failed := true;
  1280. if vmtobject.object_s32bit <> RESULT_S32BIT then
  1281. failed := true;
  1282. if vmtobject.object_s64bit <> RESULT_S64BIT then
  1283. failed := true;
  1284. if vmtobject.object_bigstring <> RESULT_BIGSTRING then
  1285. failed := true;
  1286. vmtobject.destructor_params_done;
  1287. if failed then
  1288. fail
  1289. else
  1290. Writeln('Passed!');
  1291. clear_globals;
  1292. clear_values;
  1293. failed := false;
  1294. vmtobject.constructor_init;
  1295. Write('Testing mixed parameter (LOC_REFERENCE) method call w/virtual call...');
  1296. value_u8bit := RESULT_U8BIT;
  1297. value_u16bit := RESULT_U16BIT;
  1298. value_bigstring := RESULT_BIGSTRING;
  1299. value_s32bit := RESULT_S32BIT;
  1300. value_s64bit := RESULT_S64BIT;
  1301. vmtobject.method_normal_call_overriden_params_mixed(value_u8bit,
  1302. value_u16bit, value_bigstring, value_s32bit, value_s64bit);
  1303. if vmtobject.object_u8bit <> RESULT_U8BIT then
  1304. failed := true;
  1305. if vmtobject.object_u16bit <> RESULT_U16BIT then
  1306. failed := true;
  1307. if vmtobject.object_s32bit <> RESULT_S32BIT then
  1308. failed := true;
  1309. if vmtobject.object_s64bit <> RESULT_S64BIT then
  1310. failed := true;
  1311. if vmtobject.object_bigstring <> RESULT_BIGSTRING then
  1312. failed := true;
  1313. vmtobject.destructor_params_done;
  1314. if failed then
  1315. fail
  1316. else
  1317. Writeln('Passed!');
  1318. clear_globals;
  1319. clear_values;
  1320. failed := false;
  1321. vmtobject.constructor_init;
  1322. Write('Testing mixed parameter (LOC_CONSTANT) method call w/normal call...');
  1323. vmtobject.method_normal_call_normal_params_mixed(RESULT_U8BIT,
  1324. RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
  1325. if vmtobject.object_u8bit <> RESULT_U8BIT then
  1326. failed := true;
  1327. if vmtobject.object_u16bit <> RESULT_U16BIT then
  1328. failed := true;
  1329. if vmtobject.object_s32bit <> RESULT_S32BIT then
  1330. failed := true;
  1331. if vmtobject.object_s64bit <> RESULT_S64BIT then
  1332. failed := true;
  1333. if vmtobject.object_bigstring <> RESULT_BIGSTRING then
  1334. failed := true;
  1335. vmtobject.destructor_params_done;
  1336. if failed then
  1337. fail
  1338. else
  1339. Writeln('Passed!');
  1340. clear_globals;
  1341. clear_values;
  1342. failed := false;
  1343. vmtobject.constructor_init;
  1344. Write('Testing mixed parameter (LOC_REFERENCE) method call w/normal call...');
  1345. value_u8bit := RESULT_U8BIT;
  1346. value_u16bit := RESULT_U16BIT;
  1347. value_bigstring := RESULT_BIGSTRING;
  1348. value_s32bit := RESULT_S32BIT;
  1349. value_s64bit := RESULT_S64BIT;
  1350. vmtobject.method_normal_call_normal_params_mixed(value_u8bit,
  1351. value_u16bit, value_bigstring, value_s32bit, value_s64bit);
  1352. if vmtobject.object_u8bit <> RESULT_U8BIT then
  1353. failed := true;
  1354. if vmtobject.object_u16bit <> RESULT_U16BIT then
  1355. failed := true;
  1356. if vmtobject.object_s32bit <> RESULT_S32BIT then
  1357. failed := true;
  1358. if vmtobject.object_s64bit <> RESULT_S64BIT then
  1359. failed := true;
  1360. if vmtobject.object_bigstring <> RESULT_BIGSTRING then
  1361. failed := true;
  1362. vmtobject.destructor_params_done;
  1363. if failed then
  1364. fail
  1365. else
  1366. Writeln('Passed!');
  1367. (* constructor call inside a normal method *)
  1368. clear_globals;
  1369. clear_values;
  1370. failed := false;
  1371. vmtobject.constructor_init;
  1372. Write('Testing mixed parameter (LOC_CONSTANT) method call w/constructor call...');
  1373. vmtobject.method_normal_call_constructor_params_mixed(RESULT_U8BIT,
  1374. RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
  1375. if vmtobject.object_u8bit <> RESULT_U8BIT then
  1376. failed := true;
  1377. if vmtobject.object_u16bit <> RESULT_U16BIT then
  1378. failed := true;
  1379. if vmtobject.object_s32bit <> RESULT_S32BIT then
  1380. failed := true;
  1381. if vmtobject.object_s64bit <> RESULT_S64BIT then
  1382. failed := true;
  1383. if vmtobject.object_bigstring <> RESULT_BIGSTRING then
  1384. failed := true;
  1385. vmtobject.destructor_params_done;
  1386. if failed then
  1387. fail
  1388. else
  1389. Writeln('Passed!');
  1390. clear_globals;
  1391. clear_values;
  1392. failed := false;
  1393. vmtobject.constructor_init;
  1394. Write('Testing mixed parameter (LOC_REFERENCE) method call w/constructor call...');
  1395. value_u8bit := RESULT_U8BIT;
  1396. value_u16bit := RESULT_U16BIT;
  1397. value_bigstring := RESULT_BIGSTRING;
  1398. value_s32bit := RESULT_S32BIT;
  1399. value_s64bit := RESULT_S64BIT;
  1400. vmtobject.method_normal_call_constructor_params_mixed(value_u8bit,
  1401. value_u16bit, value_bigstring, value_s32bit, value_s64bit);
  1402. if vmtobject.object_u8bit <> RESULT_U8BIT then
  1403. failed := true;
  1404. if vmtobject.object_u16bit <> RESULT_U16BIT then
  1405. failed := true;
  1406. if vmtobject.object_s32bit <> RESULT_S32BIT then
  1407. failed := true;
  1408. if vmtobject.object_s64bit <> RESULT_S64BIT then
  1409. failed := true;
  1410. if vmtobject.object_bigstring <> RESULT_BIGSTRING then
  1411. failed := true;
  1412. vmtobject.destructor_params_done;
  1413. if failed then
  1414. fail
  1415. else
  1416. Writeln('Passed!');
  1417. { static method call }
  1418. clear_globals;
  1419. clear_values;
  1420. failed := false;
  1421. vmtobject.constructor_init;
  1422. Write('Testing mixed parameter (LOC_CONSTANT) method call w/static call...');
  1423. vmtobject.method_normal_call_static_params_mixed(RESULT_U8BIT,
  1424. RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
  1425. if global_u8bit <> RESULT_U8BIT then
  1426. failed := true;
  1427. if global_u16bit <> RESULT_U16BIT then
  1428. failed := true;
  1429. if global_s32bit <> RESULT_S32BIT then
  1430. failed := true;
  1431. if global_s64bit <> RESULT_S64BIT then
  1432. failed := true;
  1433. if global_bigstring <> RESULT_BIGSTRING then
  1434. failed := true;
  1435. vmtobject.destructor_params_done;
  1436. if failed then
  1437. fail
  1438. else
  1439. Writeln('Passed!');
  1440. clear_globals;
  1441. clear_values;
  1442. failed := false;
  1443. vmtobject.constructor_init;
  1444. Write('Testing mixed parameter (LOC_REFERENCE) method call w/static call...');
  1445. value_u8bit := RESULT_U8BIT;
  1446. value_u16bit := RESULT_U16BIT;
  1447. value_bigstring := RESULT_BIGSTRING;
  1448. value_s32bit := RESULT_S32BIT;
  1449. value_s64bit := RESULT_S64BIT;
  1450. vmtobject.method_normal_call_static_params_mixed(value_u8bit,
  1451. value_u16bit, value_bigstring, value_s32bit, value_s64bit);
  1452. if global_u8bit <> RESULT_U8BIT then
  1453. failed := true;
  1454. if global_u16bit <> RESULT_U16BIT then
  1455. failed := true;
  1456. if global_s32bit <> RESULT_S32BIT then
  1457. failed := true;
  1458. if global_s64bit <> RESULT_S64BIT then
  1459. failed := true;
  1460. if global_bigstring <> RESULT_BIGSTRING then
  1461. failed := true;
  1462. vmtobject.destructor_params_done;
  1463. if failed then
  1464. fail
  1465. else
  1466. Writeln('Passed!');
  1467. (* calls the inherited method *)
  1468. clear_globals;
  1469. clear_values;
  1470. failed := false;
  1471. { Calls the ancestor virtual method }
  1472. vmtobject.constructor_init;
  1473. Write('Testing mixed parameter (LOC_CONSTANT) method call w/inherited call...');
  1474. vmtobject.method_normal_call_inherited_params_mixed(RESULT_U8BIT,
  1475. RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
  1476. if vmtobject.object_u8bit <> RESULT_U8BIT then
  1477. failed := true;
  1478. if vmtobject.object_u16bit <> RESULT_U16BIT then
  1479. failed := true;
  1480. if vmtobject.object_s32bit <> RESULT_S32BIT then
  1481. failed := true;
  1482. if vmtobject.object_s64bit <> RESULT_S64BIT then
  1483. failed := true;
  1484. if vmtobject.object_bigstring <> RESULT_BIGSTRING then
  1485. failed := true;
  1486. vmtobject.destructor_params_done;
  1487. if failed then
  1488. fail
  1489. else
  1490. Writeln('Passed!');
  1491. clear_globals;
  1492. clear_values;
  1493. failed := false;
  1494. vmtobject.constructor_init;
  1495. Write('Testing mixed parameter (LOC_REFERENCE) method call w/inherited call...');
  1496. value_u8bit := RESULT_U8BIT;
  1497. value_u16bit := RESULT_U16BIT;
  1498. value_bigstring := RESULT_BIGSTRING;
  1499. value_s32bit := RESULT_S32BIT;
  1500. value_s64bit := RESULT_S64BIT;
  1501. vmtobject.method_normal_call_inherited_params_mixed(value_u8bit,
  1502. value_u16bit, value_bigstring, value_s32bit, value_s64bit);
  1503. if vmtobject.object_u8bit <> RESULT_U8BIT then
  1504. failed := true;
  1505. if vmtobject.object_u16bit <> RESULT_U16BIT then
  1506. failed := true;
  1507. if vmtobject.object_s32bit <> RESULT_S32BIT then
  1508. failed := true;
  1509. if vmtobject.object_s64bit <> RESULT_S64BIT then
  1510. failed := true;
  1511. if vmtobject.object_bigstring <> RESULT_BIGSTRING then
  1512. failed := true;
  1513. vmtobject.destructor_params_done;
  1514. if failed then
  1515. fail
  1516. else
  1517. Writeln('Passed!');
  1518. { ********************************************************************
  1519. This calls virtual methods which in turn call other methods,
  1520. or a constructor or a destructor.
  1521. *********************************************************************
  1522. }
  1523. clear_globals;
  1524. clear_values;
  1525. failed := false;
  1526. { Calls the ancestor virtual method }
  1527. vmtobject.constructor_init;
  1528. Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/virtual call...');
  1529. vmtobject.method_virtual_call_virtual_params_mixed(RESULT_U8BIT,
  1530. RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
  1531. if vmtobject.object_u8bit <> RESULT_U8BIT then
  1532. failed := true;
  1533. if vmtobject.object_u16bit <> RESULT_U16BIT then
  1534. failed := true;
  1535. if vmtobject.object_s32bit <> RESULT_S32BIT then
  1536. failed := true;
  1537. if vmtobject.object_s64bit <> RESULT_S64BIT then
  1538. failed := true;
  1539. if vmtobject.object_bigstring <> RESULT_BIGSTRING then
  1540. failed := true;
  1541. vmtobject.destructor_params_done;
  1542. if failed then
  1543. fail
  1544. else
  1545. Writeln('Passed!');
  1546. clear_globals;
  1547. clear_values;
  1548. failed := false;
  1549. vmtobject.constructor_init;
  1550. Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/virtual call...');
  1551. value_u8bit := RESULT_U8BIT;
  1552. value_u16bit := RESULT_U16BIT;
  1553. value_bigstring := RESULT_BIGSTRING;
  1554. value_s32bit := RESULT_S32BIT;
  1555. value_s64bit := RESULT_S64BIT;
  1556. vmtobject.method_virtual_call_virtual_params_mixed(value_u8bit,
  1557. value_u16bit, value_bigstring, value_s32bit, value_s64bit);
  1558. if vmtobject.object_u8bit <> RESULT_U8BIT then
  1559. failed := true;
  1560. if vmtobject.object_u16bit <> RESULT_U16BIT then
  1561. failed := true;
  1562. if vmtobject.object_s32bit <> RESULT_S32BIT then
  1563. failed := true;
  1564. if vmtobject.object_s64bit <> RESULT_S64BIT then
  1565. failed := true;
  1566. if vmtobject.object_bigstring <> RESULT_BIGSTRING then
  1567. failed := true;
  1568. vmtobject.destructor_params_done;
  1569. if failed then
  1570. fail
  1571. else
  1572. Writeln('Passed!');
  1573. { The virtual method has been overriden by the object in this case }
  1574. vmtobject.constructor_init;
  1575. Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/virtual call...');
  1576. vmtobject.method_virtual_call_overriden_params_mixed(RESULT_U8BIT,
  1577. RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
  1578. if vmtobject.object_u8bit <> RESULT_U8BIT then
  1579. failed := true;
  1580. if vmtobject.object_u16bit <> RESULT_U16BIT then
  1581. failed := true;
  1582. if vmtobject.object_s32bit <> RESULT_S32BIT then
  1583. failed := true;
  1584. if vmtobject.object_s64bit <> RESULT_S64BIT then
  1585. failed := true;
  1586. if vmtobject.object_bigstring <> RESULT_BIGSTRING then
  1587. failed := true;
  1588. vmtobject.destructor_params_done;
  1589. if failed then
  1590. fail
  1591. else
  1592. Writeln('Passed!');
  1593. clear_globals;
  1594. clear_values;
  1595. failed := false;
  1596. vmtobject.constructor_init;
  1597. Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/virtual call...');
  1598. value_u8bit := RESULT_U8BIT;
  1599. value_u16bit := RESULT_U16BIT;
  1600. value_bigstring := RESULT_BIGSTRING;
  1601. value_s32bit := RESULT_S32BIT;
  1602. value_s64bit := RESULT_S64BIT;
  1603. vmtobject.method_virtual_call_overriden_params_mixed(value_u8bit,
  1604. value_u16bit, value_bigstring, value_s32bit, value_s64bit);
  1605. if vmtobject.object_u8bit <> RESULT_U8BIT then
  1606. failed := true;
  1607. if vmtobject.object_u16bit <> RESULT_U16BIT then
  1608. failed := true;
  1609. if vmtobject.object_s32bit <> RESULT_S32BIT then
  1610. failed := true;
  1611. if vmtobject.object_s64bit <> RESULT_S64BIT then
  1612. failed := true;
  1613. if vmtobject.object_bigstring <> RESULT_BIGSTRING then
  1614. failed := true;
  1615. vmtobject.destructor_params_done;
  1616. if failed then
  1617. fail
  1618. else
  1619. Writeln('Passed!');
  1620. clear_globals;
  1621. clear_values;
  1622. failed := false;
  1623. vmtobject.constructor_init;
  1624. Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/normal call...');
  1625. vmtobject.method_virtual_call_normal_params_mixed(RESULT_U8BIT,
  1626. RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
  1627. if vmtobject.object_u8bit <> RESULT_U8BIT then
  1628. failed := true;
  1629. if vmtobject.object_u16bit <> RESULT_U16BIT then
  1630. failed := true;
  1631. if vmtobject.object_s32bit <> RESULT_S32BIT then
  1632. failed := true;
  1633. if vmtobject.object_s64bit <> RESULT_S64BIT then
  1634. failed := true;
  1635. if vmtobject.object_bigstring <> RESULT_BIGSTRING then
  1636. failed := true;
  1637. vmtobject.destructor_params_done;
  1638. if failed then
  1639. fail
  1640. else
  1641. Writeln('Passed!');
  1642. clear_globals;
  1643. clear_values;
  1644. failed := false;
  1645. vmtobject.constructor_init;
  1646. Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/normal call...');
  1647. value_u8bit := RESULT_U8BIT;
  1648. value_u16bit := RESULT_U16BIT;
  1649. value_bigstring := RESULT_BIGSTRING;
  1650. value_s32bit := RESULT_S32BIT;
  1651. value_s64bit := RESULT_S64BIT;
  1652. vmtobject.method_virtual_call_normal_params_mixed(value_u8bit,
  1653. value_u16bit, value_bigstring, value_s32bit, value_s64bit);
  1654. if vmtobject.object_u8bit <> RESULT_U8BIT then
  1655. failed := true;
  1656. if vmtobject.object_u16bit <> RESULT_U16BIT then
  1657. failed := true;
  1658. if vmtobject.object_s32bit <> RESULT_S32BIT then
  1659. failed := true;
  1660. if vmtobject.object_s64bit <> RESULT_S64BIT then
  1661. failed := true;
  1662. if vmtobject.object_bigstring <> RESULT_BIGSTRING then
  1663. failed := true;
  1664. vmtobject.destructor_params_done;
  1665. if failed then
  1666. fail
  1667. else
  1668. Writeln('Passed!');
  1669. (* constructor call inside a normal method *)
  1670. clear_globals;
  1671. clear_values;
  1672. failed := false;
  1673. vmtobject.constructor_init;
  1674. Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/constructor call...');
  1675. vmtobject.method_virtual_call_constructor_params_mixed(RESULT_U8BIT,
  1676. RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
  1677. if vmtobject.object_u8bit <> RESULT_U8BIT then
  1678. failed := true;
  1679. if vmtobject.object_u16bit <> RESULT_U16BIT then
  1680. failed := true;
  1681. if vmtobject.object_s32bit <> RESULT_S32BIT then
  1682. failed := true;
  1683. if vmtobject.object_s64bit <> RESULT_S64BIT then
  1684. failed := true;
  1685. if vmtobject.object_bigstring <> RESULT_BIGSTRING then
  1686. failed := true;
  1687. vmtobject.destructor_params_done;
  1688. if failed then
  1689. fail
  1690. else
  1691. Writeln('Passed!');
  1692. clear_globals;
  1693. clear_values;
  1694. failed := false;
  1695. vmtobject.constructor_init;
  1696. Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/constructor call...');
  1697. value_u8bit := RESULT_U8BIT;
  1698. value_u16bit := RESULT_U16BIT;
  1699. value_bigstring := RESULT_BIGSTRING;
  1700. value_s32bit := RESULT_S32BIT;
  1701. value_s64bit := RESULT_S64BIT;
  1702. vmtobject.method_virtual_call_constructor_params_mixed(value_u8bit,
  1703. value_u16bit, value_bigstring, value_s32bit, value_s64bit);
  1704. if vmtobject.object_u8bit <> RESULT_U8BIT then
  1705. failed := true;
  1706. if vmtobject.object_u16bit <> RESULT_U16BIT then
  1707. failed := true;
  1708. if vmtobject.object_s32bit <> RESULT_S32BIT then
  1709. failed := true;
  1710. if vmtobject.object_s64bit <> RESULT_S64BIT then
  1711. failed := true;
  1712. if vmtobject.object_bigstring <> RESULT_BIGSTRING then
  1713. failed := true;
  1714. vmtobject.destructor_params_done;
  1715. if failed then
  1716. fail
  1717. else
  1718. Writeln('Passed!');
  1719. { static virtual call }
  1720. clear_globals;
  1721. clear_values;
  1722. failed := false;
  1723. vmtobject.constructor_init;
  1724. Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/static call...');
  1725. vmtobject.method_virtual_call_static_params_mixed(RESULT_U8BIT,
  1726. RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
  1727. if global_u8bit <> RESULT_U8BIT then
  1728. failed := true;
  1729. if global_u16bit <> RESULT_U16BIT then
  1730. failed := true;
  1731. if global_s32bit <> RESULT_S32BIT then
  1732. failed := true;
  1733. if global_s64bit <> RESULT_S64BIT then
  1734. failed := true;
  1735. if global_bigstring <> RESULT_BIGSTRING then
  1736. failed := true;
  1737. vmtobject.destructor_params_done;
  1738. if failed then
  1739. fail
  1740. else
  1741. Writeln('Passed!');
  1742. clear_globals;
  1743. clear_values;
  1744. failed := false;
  1745. vmtobject.constructor_init;
  1746. Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/static call...');
  1747. value_u8bit := RESULT_U8BIT;
  1748. value_u16bit := RESULT_U16BIT;
  1749. value_bigstring := RESULT_BIGSTRING;
  1750. value_s32bit := RESULT_S32BIT;
  1751. value_s64bit := RESULT_S64BIT;
  1752. vmtobject.method_virtual_call_static_params_mixed(value_u8bit,
  1753. value_u16bit, value_bigstring, value_s32bit, value_s64bit);
  1754. if global_u8bit <> RESULT_U8BIT then
  1755. failed := true;
  1756. if global_u16bit <> RESULT_U16BIT then
  1757. failed := true;
  1758. if global_s32bit <> RESULT_S32BIT then
  1759. failed := true;
  1760. if global_s64bit <> RESULT_S64BIT then
  1761. failed := true;
  1762. if global_bigstring <> RESULT_BIGSTRING then
  1763. failed := true;
  1764. vmtobject.destructor_params_done;
  1765. if failed then
  1766. fail
  1767. else
  1768. Writeln('Passed!');
  1769. (* calls the inherited method *)
  1770. clear_globals;
  1771. clear_values;
  1772. failed := false;
  1773. { Calls the ancestor virtual method }
  1774. vmtobject.constructor_init;
  1775. Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/inherited call...');
  1776. vmtobject.method_virtual_call_inherited_params_mixed(RESULT_U8BIT,
  1777. RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
  1778. if vmtobject.object_u8bit <> RESULT_U8BIT then
  1779. failed := true;
  1780. if vmtobject.object_u16bit <> RESULT_U16BIT then
  1781. failed := true;
  1782. if vmtobject.object_s32bit <> RESULT_S32BIT then
  1783. failed := true;
  1784. if vmtobject.object_s64bit <> RESULT_S64BIT then
  1785. failed := true;
  1786. if vmtobject.object_bigstring <> RESULT_BIGSTRING then
  1787. failed := true;
  1788. vmtobject.destructor_params_done;
  1789. if failed then
  1790. fail
  1791. else
  1792. Writeln('Passed!');
  1793. clear_globals;
  1794. clear_values;
  1795. failed := false;
  1796. vmtobject.constructor_init;
  1797. Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/inherited call...');
  1798. value_u8bit := RESULT_U8BIT;
  1799. value_u16bit := RESULT_U16BIT;
  1800. value_bigstring := RESULT_BIGSTRING;
  1801. value_s32bit := RESULT_S32BIT;
  1802. value_s64bit := RESULT_S64BIT;
  1803. vmtobject.method_virtual_call_inherited_params_mixed(value_u8bit,
  1804. value_u16bit, value_bigstring, value_s32bit, value_s64bit);
  1805. if vmtobject.object_u8bit <> RESULT_U8BIT then
  1806. failed := true;
  1807. if vmtobject.object_u16bit <> RESULT_U16BIT then
  1808. failed := true;
  1809. if vmtobject.object_s32bit <> RESULT_S32BIT then
  1810. failed := true;
  1811. if vmtobject.object_s64bit <> RESULT_S64BIT then
  1812. failed := true;
  1813. if vmtobject.object_bigstring <> RESULT_BIGSTRING then
  1814. failed := true;
  1815. vmtobject.destructor_params_done;
  1816. if failed then
  1817. fail
  1818. else
  1819. Writeln('Passed!');
  1820. end;
  1821. begin
  1822. WriteLN('*********************** NO VMT OBJECT TESTS ********************');
  1823. testnovmtobject;
  1824. WriteLN('************************ VMT OBJECT FAIL **********************');
  1825. testfailedobject;
  1826. WriteLN('************************* VMT OBJECT TESTS *********************');
  1827. testvmtobject;
  1828. testheritedvmtobject;
  1829. end.
  1830. {
  1831. $Log$
  1832. Revision 1.1 2002-05-05 13:58:50 carl
  1833. + finished procedural variable testsuit
  1834. + finished method testsuit
  1835. }