tcalcst9.pp 22 KB

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