tcalext5.pp 14 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636
  1. { Tests passing of different records by value to C methods.
  2. One type of these records has one field which is a simple array of bytes,
  3. the other consists of a few fields of atomic size.
  4. Note that it does not only test a single field of these records, but all
  5. by comparing the sum of the field values with the sum returned by the
  6. C function.
  7. }
  8. program calext3;
  9. {$MODE DELPHI}
  10. {$ifdef UNDER_CE}
  11. {$define NO_FLOAT}
  12. {$endif}
  13. type
  14. int8_t = shortint;
  15. pint8_t = ^int8_t;
  16. int16_t = smallint;
  17. int32_t = longint;
  18. int64_t = int64;
  19. var
  20. success : boolean;
  21. {$packrecords c}
  22. type
  23. struct_arr1 = record
  24. v : array[0..0] of int8_t;
  25. end;
  26. struct_arr2 = record
  27. v : array[0..1] of int8_t;
  28. end;
  29. struct_arr3 = record
  30. v : array[0..2] of int8_t;
  31. end;
  32. struct_arr4 = record
  33. v : array[0..3] of int8_t;
  34. end;
  35. struct_arr5 = record
  36. v : array[0..4] of int8_t;
  37. end;
  38. struct_arr6 = record
  39. v : array[0..5] of int8_t;
  40. end;
  41. struct_arr7 = record
  42. v : array[0..6] of int8_t;
  43. end;
  44. struct_arr8 = record
  45. v : array[0..7] of int8_t;
  46. end;
  47. struct_arr9 = record
  48. v : array[0..8] of int8_t;
  49. end;
  50. struct_arr10 = record
  51. v : array[0..9] of int8_t;
  52. end;
  53. struct_arr11 = record
  54. v : array[0..10] of int8_t;
  55. end;
  56. struct_arr15 = record
  57. v : array[0..14] of int8_t;
  58. end;
  59. struct_arr16 = record
  60. v : array[0..15] of int8_t;
  61. end;
  62. struct_arr17 = record
  63. v : array[0..16] of int8_t;
  64. end;
  65. struct_arr27 = record
  66. v : array[0..26] of int8_t;
  67. end;
  68. struct_arr31 = record
  69. v : array[0..30] of int8_t;
  70. end;
  71. struct_arr32 = record
  72. v : array[0..31] of int8_t;
  73. end;
  74. struct_arr33 = record
  75. v : array[0..32] of int8_t;
  76. end;
  77. struct1 = record
  78. v : int8_t;
  79. end;
  80. struct2 = record
  81. v : int16_t;
  82. end;
  83. struct3 = record
  84. v1 : int16_t;
  85. v2 : int8_t;
  86. end;
  87. struct4 = record
  88. v : int32_t;
  89. end;
  90. struct5 = record
  91. v1 : int32_t;
  92. v2 : int8_t;
  93. end;
  94. struct6 = record
  95. v1 : int32_t;
  96. v2 : int16_t;
  97. end;
  98. struct7 = record
  99. v1 : int32_t;
  100. v2 : int16_t;
  101. v3 : int8_t;
  102. end;
  103. struct8 = record
  104. v : int64_t
  105. end;
  106. struct9 = record
  107. v1 : int64_t;
  108. v2 : int8_t;
  109. end;
  110. struct10 = record
  111. v1 : int64_t;
  112. v2 : int16_t;
  113. end;
  114. struct11 = record
  115. v1 : int64_t;
  116. v2 : int16_t;
  117. v3 : int8_t;
  118. end;
  119. struct12 = record
  120. v1 : int64_t;
  121. v2 : int32_t;
  122. end;
  123. struct13 = record
  124. v1 : int64_t;
  125. v2 : int32_t;
  126. v3 : int8_t;
  127. end;
  128. struct14 = record
  129. v1 : int64_t;
  130. v2 : int32_t;
  131. v3 : int16_t;
  132. end;
  133. struct15 = record
  134. v1 : int64_t;
  135. v2 : int32_t;
  136. v3 : int16_t;
  137. v4 : int8_t;
  138. end;
  139. struct16 = record
  140. v1 : int64_t;
  141. v2 : int64_t;
  142. end;
  143. struct31 = record
  144. v1 : int64_t;
  145. v2 : int64_t;
  146. v3 : int64_t;
  147. v4 : int32_t;
  148. v5 : int16_t;
  149. v6 : int8_t;
  150. end;
  151. procedure fill(var mem; size : integer);
  152. var
  153. i : Integer;
  154. p : pint8_t;
  155. begin
  156. p := @mem;
  157. for i := 0 to size-1 do begin
  158. p^ := random(255)+1;
  159. inc(p);
  160. end;
  161. end;
  162. procedure verify(val1, val2 : int64_t; nr : Integer);
  163. begin
  164. success := success and (val1 = val2);
  165. Write('Testing test ', nr , ', was ', val1, ', should be ', val2, '...');
  166. if (val1 = val2) then
  167. WriteLn('Success.')
  168. else
  169. WriteLn('Failed');
  170. end;
  171. function check1(s : struct1) : int64_t;
  172. begin
  173. result := s.v;
  174. end;
  175. function check2(s : struct2) : int64_t;
  176. begin
  177. result := s.v;
  178. end;
  179. function check3(s : struct3) : int64_t;
  180. begin
  181. result := s.v1 + s.v2;
  182. end;
  183. function check4(s : struct4) : int64_t;
  184. begin
  185. result := s.v;
  186. end;
  187. function check5(s : struct5) : int64_t;
  188. begin
  189. result := s.v1 + s.v2;
  190. end;
  191. function check6(s : struct6) : int64_t;
  192. begin
  193. result := s.v1 + s.v2;
  194. end;
  195. function check7(s : struct7) : int64_t;
  196. begin
  197. result := s.v1 + s.v2 + s.v3;
  198. end;
  199. function check8(s : struct8) : int64_t;
  200. begin
  201. result := s.v;
  202. end;
  203. function check9(s : struct9) : int64_t;
  204. begin
  205. result := s.v1 + s.v2;
  206. end;
  207. function check10(s : struct10) : int64_t;
  208. begin
  209. result := s.v1 + s.v2;
  210. end;
  211. function check11(s : struct11) : int64_t;
  212. begin
  213. result := s.v1 + s.v2 + s.v3;
  214. end;
  215. function check12(s : struct12) : int64_t;
  216. begin
  217. result := s.v1 + s.v2;
  218. end;
  219. function check13(s : struct13) : int64_t;
  220. begin
  221. result := s.v1 + s.v2 + s.v3;
  222. end;
  223. function check14(s : struct14) : int64_t;
  224. begin
  225. result := s.v1 + s.v2 + s.v3;
  226. end;
  227. function check15(s : struct15) : int64_t;
  228. begin
  229. result := s.v1 + s.v2 + s.v3 + s.v4;
  230. end;
  231. function check16(s : struct16) : int64_t;
  232. begin
  233. result := s.v1 + s.v2;
  234. end;
  235. function check31(s : struct31) : int64_t;
  236. begin
  237. result := s.v1 + s.v2 + s.v3 + s.v4 + s.v5 + s.v6;
  238. end;
  239. function check_arr1(s : struct_arr1) : int64_t;
  240. var
  241. i : int32_t;
  242. begin
  243. result := 0;
  244. for i := low(s.v) to high(s.v) do
  245. inc(result, s.v[i]);
  246. end;
  247. function check_arr2(s : struct_arr2) : int64_t;
  248. var
  249. i : int32_t;
  250. begin
  251. result := 0;
  252. for i := low(s.v) to high(s.v) do
  253. inc(result, s.v[i]);
  254. end;
  255. function check_arr3(s : struct_arr3) : int64_t;
  256. var
  257. i : int32_t;
  258. begin
  259. result := 0;
  260. for i := low(s.v) to high(s.v) do
  261. inc(result, s.v[i]);
  262. end;
  263. function check_arr4(s : struct_arr4) : int64_t;
  264. var
  265. i : int32_t;
  266. begin
  267. result := 0;
  268. for i := low(s.v) to high(s.v) do
  269. inc(result, s.v[i]);
  270. end;
  271. function check_arr5(s : struct_arr5) : int64_t;
  272. var
  273. i : int32_t;
  274. begin
  275. result := 0;
  276. for i := low(s.v) to high(s.v) do
  277. inc(result, s.v[i]);
  278. end;
  279. function check_arr6(s : struct_arr6) : int64_t;
  280. var
  281. i : int32_t;
  282. begin
  283. result := 0;
  284. for i := low(s.v) to high(s.v) do
  285. inc(result, s.v[i]);
  286. end;
  287. function check_arr7(s : struct_arr7) : int64_t;
  288. var
  289. i : int32_t;
  290. begin
  291. result := 0;
  292. for i := low(s.v) to high(s.v) do
  293. inc(result, s.v[i]);
  294. end;
  295. function check_arr8(s : struct_arr8) : int64_t;
  296. var
  297. i : int32_t;
  298. begin
  299. result := 0;
  300. for i := low(s.v) to high(s.v) do
  301. inc(result, s.v[i]);
  302. end;
  303. function check_arr9(s : struct_arr9) : int64_t;
  304. var
  305. i : int32_t;
  306. begin
  307. result := 0;
  308. for i := low(s.v) to high(s.v) do
  309. inc(result, s.v[i]);
  310. end;
  311. function check_arr10(s : struct_arr10) : int64_t;
  312. var
  313. i : int32_t;
  314. begin
  315. result := 0;
  316. for i := low(s.v) to high(s.v) do
  317. inc(result, s.v[i]);
  318. end;
  319. function check_arr11(s : struct_arr11) : int64_t;
  320. var
  321. i : int32_t;
  322. begin
  323. result := 0;
  324. for i := low(s.v) to high(s.v) do
  325. inc(result, s.v[i]);
  326. end;
  327. function check_arr15(s : struct_arr15) : int64_t;
  328. var
  329. i : int32_t;
  330. begin
  331. result := 0;
  332. for i := low(s.v) to high(s.v) do
  333. inc(result, s.v[i]);
  334. end;
  335. function check_arr16(s : struct_arr16) : int64_t;
  336. var
  337. i : int32_t;
  338. begin
  339. result := 0;
  340. for i := low(s.v) to high(s.v) do
  341. inc(result, s.v[i]);
  342. end;
  343. function check_arr17(s : struct_arr17) : int64_t;
  344. var
  345. i : int32_t;
  346. begin
  347. result := 0;
  348. for i := low(s.v) to high(s.v) do
  349. inc(result, s.v[i]);
  350. end;
  351. function check_arr27(s : struct_arr27) : int64_t;
  352. var
  353. i : int32_t;
  354. begin
  355. result := 0;
  356. for i := low(s.v) to high(s.v) do
  357. inc(result, s.v[i]);
  358. end;
  359. function check_arr31(s : struct_arr31) : int64_t;
  360. var
  361. i : int32_t;
  362. begin
  363. result := 0;
  364. for i := low(s.v) to high(s.v) do
  365. inc(result, s.v[i]);
  366. end;
  367. function check_arr32(s : struct_arr32) : int64_t;
  368. var
  369. i : int32_t;
  370. begin
  371. result := 0;
  372. for i := low(s.v) to high(s.v) do
  373. inc(result, s.v[i]);
  374. end;
  375. function check_arr33(s : struct_arr33) : int64_t;
  376. var
  377. i : int32_t;
  378. begin
  379. result := 0;
  380. for i := low(s.v) to high(s.v) do
  381. inc(result, s.v[i]);
  382. end;
  383. {$L tcext5.o}
  384. function pass1(s : struct1; b: byte) : int64_t; cdecl; external;
  385. function pass2(s : struct2; b: byte) : int64_t; cdecl; external;
  386. function pass3(s : struct3; b: byte) : int64_t; cdecl; external;
  387. function pass4(s : struct4; b: byte) : int64_t; cdecl; external;
  388. function pass5(s : struct5; b: byte) : int64_t; cdecl; external;
  389. function pass6(s : struct6; b: byte) : int64_t; cdecl; external;
  390. function pass7(s : struct7; b: byte) : int64_t; cdecl; external;
  391. function pass8(s : struct8; b: byte) : int64_t; cdecl; external;
  392. function pass9(s : struct9; b: byte) : int64_t; cdecl; external;
  393. function pass10(s : struct10; b: byte) : int64_t; cdecl; external;
  394. function pass11(s : struct11; b: byte) : int64_t; cdecl; external;
  395. function pass12(s : struct12; b: byte) : int64_t; cdecl; external;
  396. function pass13(s : struct13; b: byte) : int64_t; cdecl; external;
  397. function pass14(s : struct14; b: byte) : int64_t; cdecl; external;
  398. function pass15(s : struct15; b: byte) : int64_t; cdecl; external;
  399. function pass31(s : struct31; b: byte) : int64_t; cdecl; external;
  400. function pass311(s : struct31; s1: struct1; b: byte) : int64_t; cdecl; external;
  401. function pass312(s : struct31; s2: struct2; b: byte) : int64_t; cdecl; external;
  402. function pass313(s : struct31; s3: struct3; b: byte) : int64_t; cdecl; external;
  403. function pass11db10db(s11: struct11; d1: double; b1: byte; s10: struct10; s2: double; b2: byte): int64_t; cdecl; external;
  404. function pass_arr1(s : struct_arr1; b: byte) : int64_t; cdecl; external;
  405. function pass_arr2(s : struct_arr2; b: byte) : int64_t; cdecl; external;
  406. function pass_arr3(s : struct_arr3; b: byte) : int64_t; cdecl; external;
  407. function pass_arr4(s : struct_arr4; b: byte) : int64_t; cdecl; external;
  408. function pass_arr5(s : struct_arr5; b: byte) : int64_t; cdecl; external;
  409. function pass_arr6(s : struct_arr6; b: byte) : int64_t; cdecl; external;
  410. function pass_arr7(s : struct_arr7; b: byte) : int64_t; cdecl; external;
  411. function pass_arr8(s : struct_arr8; b: byte) : int64_t; cdecl; external;
  412. function pass_arr9(s : struct_arr9; b: byte) : int64_t; cdecl; external;
  413. function pass_arr10(s : struct_arr10; b: byte) : int64_t; cdecl; external;
  414. function pass_arr11(s : struct_arr11; b: byte) : int64_t; cdecl; external;
  415. function pass_arr15(s : struct_arr15; b: byte) : int64_t; cdecl; external;
  416. function pass_arr16(s : struct_arr16; b: byte) : int64_t; cdecl; external;
  417. function pass_arr17(s : struct_arr17; b: byte) : int64_t; cdecl; external;
  418. function pass_arr27(s : struct_arr27; b: byte) : int64_t; cdecl; external;
  419. function pass_arr31(s : struct_arr31; b: byte) : int64_t; cdecl; external;
  420. function pass_arr32(s : struct_arr32; b: byte) : int64_t; cdecl; external;
  421. function pass_arr33(s : struct_arr33; b: byte) : int64_t; cdecl; external;
  422. procedure dotest;
  423. var
  424. sa1 : struct_arr1;
  425. sa2 : struct_arr2;
  426. sa3 : struct_arr3;
  427. sa4 : struct_arr4;
  428. sa5 : struct_arr5;
  429. sa6 : struct_arr6;
  430. sa7 : struct_arr7;
  431. sa8 : struct_arr8;
  432. sa9 : struct_arr9;
  433. sa10 : struct_arr10;
  434. sa11 : struct_arr11;
  435. sa15 : struct_arr15;
  436. sa16 : struct_arr16;
  437. sa17 : struct_arr17;
  438. sa27 : struct_arr27;
  439. sa31 : struct_arr31;
  440. sa32 : struct_arr32;
  441. sa33 : struct_arr33;
  442. s1 : struct1;
  443. s2 : struct2;
  444. s3 : struct3;
  445. s4 : struct4;
  446. s5 : struct5;
  447. s6 : struct6;
  448. s7 : struct7;
  449. s8 : struct8;
  450. s9 : struct9;
  451. s10 : struct10;
  452. s11 : struct11;
  453. s12 : struct12;
  454. s13 : struct13;
  455. s14 : struct14;
  456. s15 : struct15;
  457. s31 : struct31;
  458. begin
  459. randseed := 30;
  460. success := true;
  461. fill(s1, sizeof(s1));
  462. fill(s2, sizeof(s2));
  463. fill(s3, sizeof(s3));
  464. fill(s4, sizeof(s4));
  465. fill(s5, sizeof(s5));
  466. fill(s6, sizeof(s6));
  467. fill(s7, sizeof(s7));
  468. fill(s8, sizeof(s8));
  469. fill(s9, sizeof(s9));
  470. fill(s10, sizeof(s10));
  471. fill(s11, sizeof(s11));
  472. fill(s12, sizeof(s12));
  473. fill(s13, sizeof(s13));
  474. fill(s14, sizeof(s14));
  475. fill(s15, sizeof(s15));
  476. fill(s31, sizeof(s31));
  477. fill(sa1, sizeof(sa1));
  478. fill(sa2, sizeof(sa2));
  479. fill(sa3, sizeof(sa3));
  480. fill(sa4, sizeof(sa4));
  481. fill(sa5, sizeof(sa5));
  482. fill(sa6, sizeof(sa6));
  483. fill(sa7, sizeof(sa7));
  484. fill(sa8, sizeof(sa8));
  485. fill(sa9, sizeof(sa9));
  486. fill(sa10, sizeof(sa10));
  487. fill(sa11, sizeof(sa11));
  488. fill(sa15, sizeof(sa15));
  489. fill(sa16, sizeof(sa16));
  490. fill(sa17, sizeof(sa17));
  491. fill(sa27, sizeof(sa27));
  492. fill(sa31, sizeof(sa31));
  493. fill(sa32, sizeof(sa32));
  494. fill(sa33, sizeof(sa33));
  495. verify(pass1(s1,1), check1(s1), 1);
  496. verify(pass2(s2,2), check2(s2), 2);
  497. verify(pass3(s3,3), check3(s3), 3);
  498. verify(pass4(s4,4), check4(s4), 4);
  499. verify(pass5(s5,5), check5(s5), 5);
  500. verify(pass6(s6,6), check6(s6), 6);
  501. verify(pass7(s7,7), check7(s7), 7);
  502. verify(pass8(s8,8), check8(s8), 8);
  503. verify(pass9(s9,9), check9(s9), 9);
  504. verify(pass10(s10,10), check10(s10), 10);
  505. verify(pass11(s11,11), check11(s11), 11);
  506. verify(pass12(s12,12), check12(s12), 12);
  507. verify(pass13(s13,13), check13(s13), 13);
  508. verify(pass14(s14,14), check14(s14), 14);
  509. verify(pass15(s15,15), check15(s15), 15);
  510. verify(pass31(s31,31), check31(s31), 31);
  511. { special cases for ppc/aix abi }
  512. verify(pass311(s31,s1,32), check1(s1), 32);
  513. verify(pass312(s31,s2,33), check2(s2), 33);
  514. verify(pass313(s31,s3,34), check3(s3), 34);
  515. {$ifndef NO_FLOAT}
  516. verify(pass11db10db(s11,12345.678,35,s10,98745.453,36), check10(s10), 35);
  517. {$endif}
  518. verify(pass_arr1(sa1,101), check_arr1(sa1), 101);
  519. verify(pass_arr2(sa2,102), check_arr2(sa2), 102);
  520. verify(pass_arr3(sa3,103), check_arr3(sa3), 103);
  521. verify(pass_arr4(sa4,104), check_arr4(sa4), 104);
  522. verify(pass_arr5(sa5,105), check_arr5(sa5), 105);
  523. verify(pass_arr6(sa6,106), check_arr6(sa6), 106);
  524. verify(pass_arr7(sa7,107), check_arr7(sa7), 107);
  525. verify(pass_arr8(sa8,108), check_arr8(sa8), 108);
  526. verify(pass_arr9(sa9,109), check_arr9(sa9), 109);
  527. verify(pass_arr10(sa10,110), check_arr10(sa10), 110);
  528. verify(pass_arr11(sa11,111), check_arr11(sa11), 111);
  529. verify(pass_arr15(sa15,115), check_arr15(sa15), 115);
  530. verify(pass_arr16(sa16,116), check_arr16(sa16), 116);
  531. verify(pass_arr17(sa17,117), check_arr17(sa17), 117);
  532. verify(pass_arr27(sa27,127), check_arr27(sa27), 127);
  533. verify(pass_arr31(sa31,131), check_arr31(sa31), 131);
  534. verify(pass_arr32(sa32,132), check_arr32(sa32), 132);
  535. verify(pass_arr33(sa33,133), check_arr33(sa33), 133);
  536. if (not success) then
  537. halt(1);
  538. end;
  539. begin
  540. dotest;
  541. end.