tcalcst6.pp 22 KB

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