tcalcst6.pp 22 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875
  1. {****************************************************************}
  2. { CODE GENERATOR TEST PROGRAM }
  3. { By Carl Eric Codere }
  4. {****************************************************************}
  5. { NODE TESTED : secondcallparan() }
  6. {****************************************************************}
  7. { PRE-REQUISITES: secondload() }
  8. { secondassign() }
  9. { secondtypeconv() }
  10. { secondtryexcept() }
  11. { secondcalln() }
  12. { secondadd() }
  13. {****************************************************************}
  14. { DEFINES: }
  15. { FPC = Target is FreePascal compiler }
  16. {****************************************************************}
  17. { REMARKS: This tests a subset of the secondcalln() node }
  18. { (const parameters with safecall calling convention) }
  19. {****************************************************************}
  20. program tcalcst6;
  21. {$ifdef fpc}
  22. {$mode objfpc}
  23. {$INLINE ON}
  24. {$endif}
  25. {$R+}
  26. {$ifdef VER70}
  27. {$define tp}
  28. {$endif}
  29. { REAL should map to single or double }
  30. { so it is not checked, since single }
  31. { double nodes are checked. }
  32. { assumes that enumdef is the same as orddef (same storage format) }
  33. const
  34. { should be defined depending on CPU target }
  35. {$ifdef fpc}
  36. {$ifdef cpu68k}
  37. BIG_INDEX = 8000;
  38. SMALL_INDEX = 13;
  39. {$else}
  40. BIG_INDEX = 33000;
  41. SMALL_INDEX = 13; { value should not be aligned! }
  42. {$endif}
  43. {$else}
  44. BIG_INDEX = 33000;
  45. SMALL_INDEX = 13; { value should not be aligned! }
  46. {$endif}
  47. RESULT_U8BIT = $55;
  48. RESULT_U16BIT = $500F;
  49. RESULT_S32BIT = $500F0000;
  50. RESULT_S64BIT = $500F0000;
  51. RESULT_S32REAL = 1777.12;
  52. RESULT_S64REAL = 3444.24;
  53. RESULT_BOOL8BIT = 1;
  54. RESULT_BOOL16BIT = 1;
  55. RESULT_BOOL32BIT = 1;
  56. RESULT_PCHAR = 'Hello world';
  57. RESULT_BIGSTRING = 'Hello world';
  58. RESULT_SMALLSTRING = 'H';
  59. RESULT_CHAR = 'I';
  60. RESULT_BOOLEAN = TRUE;
  61. type
  62. {$ifndef tp}
  63. tclass1 = class
  64. end;
  65. {$else}
  66. shortstring = string;
  67. {$endif}
  68. tprocedure = procedure;
  69. tsmallrecord =
  70. {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
  71. packed
  72. {$endif FPC_REQUIRES_PROPER_ALIGNMENT}
  73. record
  74. b: byte;
  75. w: word;
  76. end;
  77. tlargerecord = packed record
  78. b: array[1..BIG_INDEX] of byte;
  79. end;
  80. tsmallarray = packed array[1..SMALL_INDEX] of byte;
  81. tsmallsetenum =
  82. (A_A,A_B,A_C,A_D);
  83. tsmallset = set of tsmallsetenum;
  84. tlargeset = set of char;
  85. tsmallstring = string[2];
  86. var
  87. global_u8bit : byte;
  88. global_u16bit : word;
  89. global_s32bit : longint;
  90. global_s32real : single;
  91. global_s64real : double;
  92. global_ptr : pchar;
  93. global_proc : tprocedure;
  94. global_bigstring : shortstring;
  95. global_boolean : boolean;
  96. global_char : char;
  97. value_u8bit : byte;
  98. value_u16bit : word;
  99. value_s32bit : longint;
  100. {$ifndef tp}
  101. global_class : tclass1;
  102. global_s64bit : int64;
  103. value_s64bit : int64;
  104. value_class : tclass1;
  105. {$endif}
  106. value_s32real : single;
  107. value_s64real : double;
  108. value_proc : tprocedure;
  109. value_ptr : pchar;
  110. value_smallrec : tsmallrecord;
  111. value_largerec : tlargerecord;
  112. value_smallset : tsmallset;
  113. value_smallstring : tsmallstring;
  114. value_bigstring : shortstring;
  115. value_largeset : tlargeset;
  116. value_smallarray : tsmallarray;
  117. value_boolean : boolean;
  118. value_char : char;
  119. procedure fail;
  120. begin
  121. WriteLn('Failure.');
  122. halt(1);
  123. end;
  124. procedure clear_globals;
  125. begin
  126. global_u8bit := 0;
  127. global_u16bit := 0;
  128. global_s32bit := 0;
  129. global_s32real := 0.0;
  130. global_s64real := 0.0;
  131. global_ptr := nil;
  132. global_proc := nil;
  133. global_bigstring := '';
  134. global_boolean := false;
  135. global_char := #0;
  136. {$ifndef tp}
  137. global_s64bit := 0;
  138. global_class := nil;
  139. {$endif}
  140. end;
  141. procedure clear_values;
  142. begin
  143. value_u8bit := 0;
  144. value_u16bit := 0;
  145. value_s32bit := 0;
  146. value_s32real := 0.0;
  147. value_s64real := 0.0;
  148. value_proc := nil;
  149. value_ptr := nil;
  150. {$ifndef tp}
  151. value_s64bit := 0;
  152. value_class := nil;
  153. {$endif}
  154. fillchar(value_smallrec, sizeof(value_smallrec), #0);
  155. fillchar(value_largerec, sizeof(value_largerec), #0);
  156. value_smallset := [];
  157. value_smallstring := '';
  158. value_bigstring := '';
  159. value_largeset := [];
  160. fillchar(value_smallarray, sizeof(value_smallarray), #0);
  161. value_boolean := false;
  162. value_char:=#0;
  163. end;
  164. procedure testprocedure;
  165. begin
  166. end;
  167. function getu8bit : byte;
  168. begin
  169. getu8bit:=RESULT_U8BIT;
  170. end;
  171. function getu16bit: word;
  172. begin
  173. getu16bit:=RESULT_U16BIT;
  174. end;
  175. function gets32bit: longint;
  176. begin
  177. gets32bit:=RESULT_S32BIT;
  178. end;
  179. function gets64bit: int64;
  180. begin
  181. gets64bit:=RESULT_S64BIT;
  182. end;
  183. function gets32real: single;
  184. begin
  185. gets32real:=RESULT_S32REAL;
  186. end;
  187. function gets64real: double;
  188. begin
  189. gets64real:=RESULT_S64REAL;
  190. end;
  191. {************************************************************************}
  192. { CONST PARAMETERS }
  193. {************************************************************************}
  194. function proc_const_s32bit(const v : longint): longint; safecall;
  195. begin
  196. global_s32bit := v;
  197. proc_const_s32bit := 0;
  198. end;
  199. {$ifndef tp}
  200. function proc_const_s64bit(const v: int64): longint; safecall;
  201. begin
  202. global_s64bit:= v;
  203. proc_const_s64bit := 0;
  204. end;
  205. function proc_const_smallarray_const_1(const arr : array of const): longint; safecall;
  206. var
  207. i: integer;
  208. begin
  209. for i:=0 to high(arr) do
  210. begin
  211. case arr[i].vtype of
  212. vtInteger : global_u8bit := arr[i].vinteger and $ff;
  213. vtBoolean : global_boolean := arr[i].vboolean;
  214. vtChar : global_char := arr[i].vchar;
  215. vtExtended : global_s64real := arr[i].VExtended^;
  216. vtString : global_bigstring := arr[i].VString^;
  217. vtPointer : ;
  218. vtPChar : global_ptr := arr[i].VPchar;
  219. vtObject : ;
  220. { vtClass : global_class := (arr[i].VClass) as tclass1;}
  221. vtAnsiString : ;
  222. vtInt64 : global_s64bit := arr[i].vInt64^;
  223. else
  224. RunError(255);
  225. end;
  226. end; {endfor}
  227. proc_const_smallarray_const_1 := 0;
  228. end;
  229. function proc_const_smallarray_const_2(const arr : array of const): longint; safecall;
  230. var
  231. i: integer;
  232. begin
  233. if high(arr)<0 then
  234. global_u8bit := RESULT_U8BIT;
  235. proc_const_smallarray_const_2 := 0;
  236. end;
  237. {$endif}
  238. function proc_const_smallrecord(const smallrec : tsmallrecord): longint;safecall;
  239. begin
  240. if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then
  241. global_u8bit := RESULT_U8BIT;
  242. proc_const_smallrecord := 0;
  243. end;
  244. function proc_const_largerecord(const largerec : tlargerecord): longint;safecall;
  245. begin
  246. if (largerec.b[1] = RESULT_U8BIT) and (largerec.b[2] = RESULT_U8BIT) then
  247. global_u8bit := RESULT_U8BIT;
  248. proc_const_largerecord := 0;
  249. end;
  250. function proc_const_smallset(const smallset : tsmallset): longint;safecall;
  251. begin
  252. if A_D in smallset then
  253. global_u8bit := RESULT_U8BIT;
  254. proc_const_smallset := 0;
  255. end;
  256. function proc_const_largeset(const largeset : tlargeset): longint;safecall;
  257. begin
  258. if 'I' in largeset then
  259. global_u8bit := RESULT_U8BIT;
  260. proc_const_largeset := 0;
  261. end;
  262. function proc_const_smallstring(const s:tsmallstring): longint;safecall;
  263. begin
  264. if s = RESULT_SMALLSTRING then
  265. global_u8bit := RESULT_u8BIT;
  266. proc_const_smallstring := 0;
  267. end;
  268. function proc_const_bigstring(const s:shortstring): longint;safecall;
  269. begin
  270. if s = RESULT_BIGSTRING then
  271. global_u8bit := RESULT_u8BIT;
  272. proc_const_bigstring := 0;
  273. end;
  274. function proc_const_smallarray(const arr : tsmallarray): longint;safecall;
  275. begin
  276. if arr[SMALL_INDEX] = RESULT_U8BIT then
  277. global_u8bit := RESULT_U8BIT;
  278. proc_const_smallarray := 0;
  279. end;
  280. function proc_const_smallarray_open(const arr : array of byte): longint;safecall;
  281. begin
  282. { form 0 to N-1 indexes in open arrays }
  283. if arr[SMALL_INDEX-1] = RESULT_U8BIT then
  284. global_u8bit := RESULT_U8BIT;
  285. proc_const_smallarray_open := 0;
  286. end;
  287. function proc_const_formaldef_array(const buf): longint;safecall;
  288. var
  289. p: pchar;
  290. begin
  291. { array is indexed from 1 }
  292. p := @buf;
  293. global_u8bit := byte(p[SMALL_INDEX-1]);
  294. proc_const_formaldef_array := 0;
  295. end;
  296. {************************************************************************}
  297. { MIXED CONST PARAMETERS }
  298. {************************************************************************}
  299. function proc_const_s32bit_mixed(b1: byte; const v : longint; b2: byte): longint;safecall;
  300. begin
  301. global_s32bit := v;
  302. value_u8bit := b2;
  303. proc_const_s32bit_mixed := 0;
  304. end;
  305. {$ifndef tp}
  306. function proc_const_s64bit_mixed(b1 : byte; const v: int64; b2: byte): longint;safecall;
  307. begin
  308. global_s64bit:= v;
  309. value_u8bit := b2;
  310. proc_const_s64bit_mixed := 0;
  311. end;
  312. function proc_const_smallarray_const_1_mixed(b1 : byte; const arr : array of const; b2: byte): longint;safecall;
  313. var
  314. i: integer;
  315. begin
  316. for i:=0 to high(arr) do
  317. begin
  318. case arr[i].vtype of
  319. vtInteger : global_u8bit := arr[i].vinteger and $ff;
  320. vtBoolean : global_boolean := arr[i].vboolean;
  321. vtChar : global_char := arr[i].vchar;
  322. vtExtended : global_s64real := arr[i].VExtended^;
  323. vtString : global_bigstring := arr[i].VString^;
  324. vtPointer : ;
  325. vtPChar : global_ptr := arr[i].VPchar;
  326. vtObject : ;
  327. { vtClass : global_class := (arr[i].VClass) as tclass1;}
  328. vtAnsiString : ;
  329. vtInt64 : global_s64bit := arr[i].vInt64^;
  330. else
  331. RunError(255);
  332. end;
  333. end; {endfor}
  334. value_u8bit := b2;
  335. proc_const_smallarray_const_1_mixed := 0;
  336. end;
  337. function proc_const_smallarray_const_2_mixed(b1: byte; const arr : array of const; b2: byte): longint;safecall;
  338. var
  339. i: integer;
  340. begin
  341. if high(arr)<0 then
  342. global_u8bit := RESULT_U8BIT;
  343. value_u8bit := b2;
  344. proc_const_smallarray_const_2_mixed := 0;
  345. end;
  346. {$endif}
  347. function proc_const_smallrecord_mixed(b1 : byte; const smallrec : tsmallrecord; b2: byte): longint;safecall;
  348. begin
  349. if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then
  350. global_u8bit := RESULT_U8BIT;
  351. value_u8bit := b2;
  352. proc_const_smallrecord_mixed := 0;
  353. end;
  354. function proc_const_largerecord_mixed(b1: byte; const largerec : tlargerecord; b2: byte): longint; safecall;
  355. begin
  356. if (largerec.b[1] = RESULT_U8BIT) and (largerec.b[2] = RESULT_U8BIT) then
  357. global_u8bit := RESULT_U8BIT;
  358. value_u8bit := b2;
  359. proc_const_largerecord_mixed := 0;
  360. end;
  361. function proc_const_smallset_mixed(b1: byte; const smallset : tsmallset; b2: byte): longint; safecall;
  362. begin
  363. if A_D in smallset then
  364. global_u8bit := RESULT_U8BIT;
  365. value_u8bit := b2;
  366. proc_const_smallset_mixed := 0;
  367. end;
  368. function proc_const_largeset_mixed(b1: byte; const largeset : tlargeset; b2: byte): longint; safecall;
  369. begin
  370. if 'I' in largeset then
  371. global_u8bit := RESULT_U8BIT;
  372. value_u8bit := b2;
  373. proc_const_largeset_mixed := 0;
  374. end;
  375. function proc_const_smallstring_mixed(b1: byte; const s:tsmallstring; b2: byte): longint; safecall;
  376. begin
  377. if s = RESULT_SMALLSTRING then
  378. global_u8bit := RESULT_u8BIT;
  379. value_u8bit := b2;
  380. proc_const_smallstring_mixed := 0;
  381. end;
  382. function proc_const_bigstring_mixed(b1: byte; const s:shortstring; b2: byte): longint; safecall;
  383. begin
  384. if s = RESULT_BIGSTRING then
  385. global_u8bit := RESULT_u8BIT;
  386. value_u8bit := b2;
  387. proc_const_bigstring_mixed := 0;
  388. end;
  389. function proc_const_smallarray_mixed(b1: byte; const arr : tsmallarray; b2: byte): longint; safecall;
  390. begin
  391. if arr[SMALL_INDEX] = RESULT_U8BIT then
  392. global_u8bit := RESULT_U8BIT;
  393. value_u8bit := b2;
  394. proc_const_smallarray_mixed := 0;
  395. end;
  396. function proc_const_smallarray_open_mixed(b1: byte; const arr : array of byte; b2: byte): longint; safecall;
  397. begin
  398. { form 0 to N-1 indexes in open arrays }
  399. if arr[high(arr)] = RESULT_U8BIT then
  400. global_u8bit := RESULT_U8BIT;
  401. value_u8bit := b2;
  402. proc_const_smallarray_open_mixed := 0;
  403. end;
  404. function proc_const_formaldef_array_mixed(b1: byte; const buf; b2: byte): longint; safecall;
  405. var
  406. p: pchar;
  407. begin
  408. { array is indexed from 1 }
  409. p := @buf;
  410. global_u8bit := byte(p[SMALL_INDEX-1]);
  411. value_u8bit := b2;
  412. proc_const_formaldef_array_mixed := 0;
  413. end;
  414. var
  415. failed: boolean;
  416. pp : ^pchar;
  417. begin
  418. {***************************** NORMAL TESTS *******************************}
  419. write('Const parameter test (src : LOC_REGISTER (orddef)))...');
  420. clear_globals;
  421. clear_values;
  422. failed:=false;
  423. proc_const_s32bit(gets32bit);
  424. if global_s32bit <> RESULT_S32BIT then
  425. failed:=true;
  426. {$ifndef tp}
  427. proc_const_s64bit(gets64bit);
  428. if global_s64bit <> RESULT_S64BIT then
  429. failed:=true;
  430. {$endif}
  431. if failed then
  432. fail
  433. else
  434. WriteLn('Passed!');
  435. write('Const parameter test (src : LOC_REFERENCE (recorddef)))...');
  436. clear_globals;
  437. clear_values;
  438. failed := false;
  439. value_smallrec.b := RESULT_U8BIT;
  440. value_smallrec.w := RESULT_U16BIT;
  441. proc_const_smallrecord(value_smallrec);
  442. if global_u8bit <> RESULT_U8BIT then
  443. failed := true;
  444. clear_globals;
  445. clear_values;
  446. fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT);
  447. proc_const_largerecord(value_largerec);
  448. if global_u8bit <> RESULT_U8BIT then
  449. failed := true;
  450. if failed then
  451. fail
  452. else
  453. WriteLn('Passed!');
  454. write('const parameter test (src : LOC_REFERENCE (setdef)))...');
  455. clear_globals;
  456. clear_values;
  457. failed := false;
  458. value_smallset := [A_A,A_D];
  459. proc_const_smallset(value_smallset);
  460. if global_u8bit <> RESULT_U8BIT then
  461. failed := true;
  462. clear_globals;
  463. clear_values;
  464. value_largeset := ['I'];
  465. proc_const_largeset(value_largeset);
  466. if global_u8bit <> RESULT_U8BIT then
  467. failed := true;
  468. if failed then
  469. fail
  470. else
  471. WriteLn('Passed!');
  472. write('const parameter test (src : LOC_REFERENCE (stringdef)))...');
  473. clear_globals;
  474. clear_values;
  475. failed := false;
  476. value_smallstring := RESULT_SMALLSTRING;
  477. proc_const_smallstring(value_smallstring);
  478. if global_u8bit <> RESULT_U8BIT then
  479. failed := true;
  480. clear_globals;
  481. clear_values;
  482. value_bigstring := RESULT_BIGSTRING;
  483. proc_const_bigstring(value_bigstring);
  484. if global_u8bit <> RESULT_U8BIT then
  485. failed := true;
  486. if failed then
  487. fail
  488. else
  489. WriteLn('Passed!');
  490. write('Const parameter test (src : LOC_REFERENCE (formaldef)))...');
  491. clear_globals;
  492. clear_values;
  493. failed:=false;
  494. value_smallarray[SMALL_INDEX] := RESULT_U8BIT;
  495. proc_const_formaldef_array(value_smallarray);
  496. if global_u8bit <> RESULT_U8BIT then
  497. failed := true;
  498. if failed then
  499. fail
  500. else
  501. WriteLn('Passed!');
  502. write('Const parameter test (src : LOC_REFERENCE (arraydef)))...');
  503. clear_globals;
  504. clear_values;
  505. failed:=false;
  506. value_smallarray[SMALL_INDEX] := RESULT_U8BIT;
  507. proc_const_smallarray(value_smallarray);
  508. if global_u8bit <> RESULT_U8BIT then
  509. failed := true;
  510. clear_globals;
  511. clear_values;
  512. value_smallarray[SMALL_INDEX] := RESULT_U8BIT;
  513. proc_const_smallarray_open(value_smallarray);
  514. if global_u8bit <> RESULT_U8BIT then
  515. failed := true;
  516. {$ifndef tp}
  517. clear_globals;
  518. clear_values;
  519. value_u8bit := RESULT_U8BIT;
  520. value_ptr := RESULT_PCHAR;
  521. value_s64bit := RESULT_S64BIT;
  522. value_smallstring := RESULT_SMALLSTRING;
  523. value_class := tclass1.create;
  524. value_boolean := RESULT_BOOLEAN;
  525. value_char := RESULT_CHAR;
  526. value_s64real:=RESULT_S64REAL;
  527. proc_const_smallarray_const_1([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real,
  528. value_boolean,value_class]);
  529. if global_u8bit <> RESULT_U8BIT then
  530. failed := true;
  531. if global_char <> RESULT_CHAR then
  532. failed := true;
  533. if global_boolean <> RESULT_BOOLEAN then
  534. failed:=true;
  535. if trunc(global_s64real) <> trunc(RESULT_S64REAL) then
  536. failed := true;
  537. if global_bigstring <> RESULT_SMALLSTRING then
  538. failed := true;
  539. if global_ptr <> value_ptr then
  540. failed := true;
  541. { if value_class <> global_class then
  542. failed := true;!!!!!!!!!!!!!!!!!!!!}
  543. if global_s64bit <> RESULT_S64BIT then
  544. failed := true;
  545. if assigned(value_class) then
  546. value_class.destroy;
  547. global_u8bit := 0;
  548. proc_const_smallarray_const_2([]);
  549. if global_u8bit <> RESULT_U8BIT then
  550. failed := true;
  551. {$endif}
  552. if failed then
  553. fail
  554. else
  555. WriteLn('Passed!');
  556. {***************************** MIXED TESTS *******************************}
  557. write('Mixed const parameter test (src : LOC_REGISTER (orddef)))...');
  558. clear_globals;
  559. clear_values;
  560. failed:=false;
  561. proc_const_s32bit_mixed(RESULT_U8BIT,gets32bit,RESULT_U8BIT);
  562. if global_s32bit <> RESULT_S32BIT then
  563. failed:=true;
  564. if value_u8bit <> RESULT_U8BIT then
  565. failed := true;
  566. {$ifndef tp}
  567. proc_const_s64bit_mixed(RESULT_U8BIT,gets64bit,RESULT_U8BIT);
  568. if global_s64bit <> RESULT_S64BIT then
  569. failed:=true;
  570. if value_u8bit <> RESULT_U8BIT then
  571. failed := true;
  572. {$endif}
  573. if failed then
  574. fail
  575. else
  576. WriteLn('Passed!');
  577. write('Mixed const parameter test (src : LOC_REFERENCE (recorddef)))...');
  578. clear_globals;
  579. clear_values;
  580. failed := false;
  581. value_smallrec.b := RESULT_U8BIT;
  582. value_smallrec.w := RESULT_U16BIT;
  583. proc_const_smallrecord_mixed(RESULT_U8BIT,value_smallrec,RESULT_U8BIT);
  584. if global_u8bit <> RESULT_U8BIT then
  585. failed := true;
  586. if value_u8bit <> RESULT_U8BIT then
  587. failed := true;
  588. clear_globals;
  589. clear_values;
  590. fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT);
  591. proc_const_largerecord_mixed(RESULT_U8BIT,value_largerec,RESULT_U8BIT);
  592. if global_u8bit <> RESULT_U8BIT then
  593. failed := true;
  594. if value_u8bit <> RESULT_U8BIT then
  595. failed := true;
  596. if failed then
  597. fail
  598. else
  599. WriteLn('Passed!');
  600. write('Mixed const parameter test (src : LOC_REFERENCE (setdef)))...');
  601. clear_globals;
  602. clear_values;
  603. failed := false;
  604. value_smallset := [A_A,A_D];
  605. proc_const_smallset_mixed(RESULT_U8BIT,value_smallset,RESULT_U8BIT);
  606. if global_u8bit <> RESULT_U8BIT then
  607. failed := true;
  608. if value_u8bit <> RESULT_U8BIT then
  609. failed := true;
  610. clear_globals;
  611. clear_values;
  612. value_largeset := ['I'];
  613. proc_const_largeset_mixed(RESULT_U8BIT,value_largeset,RESULT_U8BIT);
  614. if global_u8bit <> RESULT_U8BIT then
  615. failed := true;
  616. if value_u8bit <> RESULT_U8BIT then
  617. failed := true;
  618. if failed then
  619. fail
  620. else
  621. WriteLn('Passed!');
  622. write('Mixed const parameter test (src : LOC_REFERENCE (stringdef)))...');
  623. clear_globals;
  624. clear_values;
  625. failed := false;
  626. value_smallstring := RESULT_SMALLSTRING;
  627. proc_const_smallstring_mixed(RESULT_U8BIT,value_smallstring,RESULT_U8BIT);
  628. if global_u8bit <> RESULT_U8BIT then
  629. failed := true;
  630. if value_u8bit <> RESULT_U8BIT then
  631. failed := true;
  632. clear_globals;
  633. clear_values;
  634. value_bigstring := RESULT_BIGSTRING;
  635. proc_const_bigstring_mixed(RESULT_U8BIT,value_bigstring,RESULT_U8BIT);
  636. if global_u8bit <> RESULT_U8BIT then
  637. failed := true;
  638. if value_u8bit <> RESULT_U8BIT then
  639. failed := true;
  640. if failed then
  641. fail
  642. else
  643. WriteLn('Passed!');
  644. write('Mixed const parameter test (src : LOC_REFERENCE (formaldef)))...');
  645. clear_globals;
  646. clear_values;
  647. failed:=false;
  648. value_smallarray[SMALL_INDEX] := RESULT_U8BIT;
  649. proc_const_formaldef_array_mixed(RESULT_U8BIT,value_smallarray,RESULT_U8BIT);
  650. if global_u8bit <> RESULT_U8BIT then
  651. failed := true;
  652. if value_u8bit <> RESULT_U8BIT then
  653. failed := true;
  654. if failed then
  655. fail
  656. else
  657. WriteLn('Passed!');
  658. write('Mixed const parameter test (src : LOC_REFERENCE (arraydef)))...');
  659. clear_globals;
  660. clear_values;
  661. failed:=false;
  662. value_smallarray[SMALL_INDEX] := RESULT_U8BIT;
  663. proc_const_smallarray_mixed(RESULT_U8BIt,value_smallarray,RESULT_U8BIT);
  664. if global_u8bit <> RESULT_U8BIT then
  665. failed := true;
  666. if value_u8bit <> RESULT_U8BIT then
  667. failed := true;
  668. clear_globals;
  669. clear_values;
  670. value_smallarray[SMALL_INDEX] := RESULT_U8BIT;
  671. proc_const_smallarray_open_mixed(RESULT_U8BIT,value_smallarray,RESULT_U8BIT);
  672. if global_u8bit <> RESULT_U8BIT then
  673. failed := true;
  674. if value_u8bit <> RESULT_U8BIT then
  675. failed := true;
  676. {$ifndef tp}
  677. clear_globals;
  678. clear_values;
  679. value_u8bit := RESULT_U8BIT;
  680. value_ptr := RESULT_PCHAR;
  681. value_s64bit := RESULT_S64BIT;
  682. value_smallstring := RESULT_SMALLSTRING;
  683. value_class := tclass1.create;
  684. value_boolean := RESULT_BOOLEAN;
  685. value_char := RESULT_CHAR;
  686. value_s64real:=RESULT_S64REAL;
  687. proc_const_smallarray_const_1_mixed(RESULT_U8BIT, [value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,
  688. value_s64real,value_boolean,value_class],RESULT_U8BIT);
  689. if global_u8bit <> RESULT_U8BIT then
  690. failed := true;
  691. if global_char <> RESULT_CHAR then
  692. failed := true;
  693. if global_boolean <> RESULT_BOOLEAN then
  694. failed:=true;
  695. if trunc(global_s64real) <> trunc(RESULT_S64REAL) then
  696. failed := true;
  697. if global_bigstring <> RESULT_SMALLSTRING then
  698. failed := true;
  699. if global_ptr <> value_ptr then
  700. failed := true;
  701. { if value_class <> global_class then
  702. failed := true;!!!!!!!!!!!!!!!!!!!!}
  703. if global_s64bit <> RESULT_S64BIT then
  704. failed := true;
  705. if assigned(value_class) then
  706. value_class.destroy;
  707. if value_u8bit <> RESULT_U8BIT then
  708. failed := true;
  709. global_u8bit := 0;
  710. proc_const_smallarray_const_2_mixed(RESULT_U8BIT,[],RESULT_U8BIT);
  711. if global_u8bit <> RESULT_U8BIT then
  712. failed := true;
  713. if value_u8bit <> RESULT_U8BIT then
  714. failed := true;
  715. {$endif}
  716. if failed then
  717. fail
  718. else
  719. WriteLn('Passed!');
  720. end.