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{ (value parameters with cdecl calling convention) } 19{****************************************************************} 20program tcalval4; 21 22{$ifdef fpc} 23{$mode objfpc} 24{$INLINE ON} 25{$endif} 26{$R+} 27{$P-} 28 29{$ifdef VER70} 30 {$define tp} 31{$endif} 32 33 34{$ifdef cpu68k} 35 {$define cpusmall} 36{$endif} 37{$ifdef cpui8086} 38 {$define cpusmall} 39{$endif} 40 41 { REAL should map to single or double } 42 { so it is not checked, since single } 43 { double nodes are checked. } 44 45 { assumes that enumdef is the same as orddef (same storage format) } 46 47 const 48{ should be defined depending on CPU target } 49{$ifdef fpc} 50 {$ifdef cpusmall} 51 BIG_INDEX = 8000; 52 SMALL_INDEX = 13; 53 {$else} 54 BIG_INDEX = 33000; 55 SMALL_INDEX = 13; { value should not be aligned! } 56 {$endif} 57{$else} 58 BIG_INDEX = 33000; 59 SMALL_INDEX = 13; { value should not be aligned! } 60{$endif} 61 RESULT_U8BIT = $55; 62 RESULT_U16BIT = $500F; 63 RESULT_S32BIT = $500F0000; 64 RESULT_S64BIT = $500F0000; 65 RESULT_S32REAL = 1777.12; 66 RESULT_S64REAL = 3444.24; 67 RESULT_BOOL8BIT = 1; 68 RESULT_BOOL16BIT = 1; 69 RESULT_BOOL32BIT = 1; 70 RESULT_PCHAR = 'Hello world'; 71 RESULT_BIGSTRING = 'Hello world'; 72 RESULT_SMALLSTRING = 'H'; 73 RESULT_CHAR = 'I'; 74 RESULT_BOOLEAN = TRUE; 75 76type 77{$ifndef tp} 78 tclass1 = class 79 end; 80{$else} 81 shortstring = string; 82{$endif} 83 84 tprocedure = procedure; 85 86 tsmallrecord = 87{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT} 88 packed 89{$endif FPC_REQUIRES_PROPER_ALIGNMENT} 90 record 91 b: byte; 92 w: word; 93 end; 94 95 tlargerecord = packed record 96 b: array[1..BIG_INDEX] of byte; 97 end; 98 99 tsmallarray = packed array[1..SMALL_INDEX] of byte; 100 101 tsmallsetenum = 102 (A_A,A_B,A_C,A_D); 103 104 tsmallset = set of tsmallsetenum; 105 tlargeset = set of char; 106 107 tsmallstring = string[2]; 108 109 110 111 112 113var 114 global_u8bit : byte; 115 global_u16bit : word; 116 global_s32bit : longint; 117 global_s32real : single; 118 global_s64real : double; 119 global_ptr : pchar; 120 global_proc : tprocedure; 121 global_bigstring : shortstring; 122 global_boolean : boolean; 123 global_char : char; 124{$ifndef tp} 125 global_class : tclass1; 126 global_s64bit : int64; 127 value_s64bit : int64; 128 value_class : tclass1; 129{$endif} 130 value_u8bit : byte; 131 value_u16bit : word; 132 value_s32bit : longint; 133 value_s32real : single; 134 value_s64real : double; 135 value_proc : tprocedure; 136 value_ptr : pchar; 137 value_smallrec : tsmallrecord; 138 value_largerec : tlargerecord; 139 value_smallset : tsmallset; 140 value_smallstring : tsmallstring; 141 value_bigstring : shortstring; 142 value_largeset : tlargeset; 143 value_smallarray : tsmallarray; 144 value_boolean : boolean; 145 value_char : char; 146 147 procedure fail; 148 begin 149 WriteLn('Failure.'); 150 halt(1); 151 end; 152 153 154 procedure clear_globals; 155 begin 156 global_u8bit := 0; 157 global_u16bit := 0; 158 global_s32bit := 0; 159 global_s32real := 0.0; 160 global_s64real := 0.0; 161 global_ptr := nil; 162 global_proc := nil; 163 global_bigstring := ''; 164 global_boolean := false; 165 global_char := #0; 166{$ifndef tp} 167 global_s64bit := 0; 168 global_class := nil; 169{$endif} 170 end; 171 172 173 procedure clear_values; 174 begin 175 value_u8bit := 0; 176 value_u16bit := 0; 177 value_s32bit := 0; 178 value_s32real := 0.0; 179 value_s64real := 0.0; 180 value_proc := nil; 181 value_ptr := nil; 182 fillchar(value_smallrec, sizeof(value_smallrec), #0); 183 fillchar(value_largerec, sizeof(value_largerec), #0); 184 value_smallset := []; 185 value_smallstring := ''; 186 value_bigstring := ''; 187 value_largeset := []; 188 fillchar(value_smallarray, sizeof(value_smallarray), #0); 189 value_boolean := false; 190 value_char:=#0; 191{$ifndef tp} 192 value_s64bit := 0; 193 value_class := nil; 194{$endif} 195 end; 196 197 198 procedure testprocedure; 199 begin 200 end; 201 202 function getu8bit : byte; 203 begin 204 getu8bit:=RESULT_U8BIT; 205 end; 206 207 function getu16bit: word; 208 begin 209 getu16bit:=RESULT_U16BIT; 210 end; 211 212 function gets32bit: longint; 213 begin 214 gets32bit:=RESULT_S32BIT; 215 end; 216 217 function gets64bit: int64; 218 begin 219 gets64bit:=RESULT_S64BIT; 220 end; 221 222 223 function gets32real: single; 224 begin 225 gets32real:=RESULT_S32REAL; 226 end; 227 228 function gets64real: double; 229 begin 230 gets64real:=RESULT_S64REAL; 231 end; 232 233{ ***************************************************************** } 234{ VALUE PARAMETERS } 235{ ***************************************************************** } 236 237 procedure proc_value_u8bit(v: byte);cdecl; 238 begin 239 global_u8bit := v; 240 end; 241 242 243 procedure proc_value_u16bit(v: word);cdecl; 244 begin 245 global_u16bit := v; 246 end; 247 248 249 procedure proc_value_s32bit(v : longint);cdecl; 250 begin 251 global_s32bit := v; 252 end; 253 254 255 256 257 procedure proc_value_bool8bit(v: boolean);cdecl; 258 begin 259 { boolean should be 8-bit always! } 260 if sizeof(boolean) <> 1 then RunError(255); 261 global_u8bit := byte(v); 262 end; 263 264 265 procedure proc_value_bool16bit(v: wordbool);cdecl; 266 begin 267 global_u16bit := word(v); 268 end; 269 270 271 procedure proc_value_bool32bit(v : longbool);cdecl; 272 begin 273 global_s32bit := longint(v); 274 end; 275 276 277 procedure proc_value_s32real(v : single);cdecl; 278 begin 279 global_s32real := v; 280 end; 281 282 procedure proc_value_s64real(v: double);cdecl; 283 begin 284 global_s64real:= v; 285 end; 286 287 288 procedure proc_value_pointerdef(p : pchar);cdecl; 289 begin 290 global_ptr:=p; 291 end; 292 293 294 procedure proc_value_procvardef(p : tprocedure);cdecl; 295 begin 296 global_proc:=p; 297 end; 298 299 300 301 302 procedure proc_value_smallrecord(smallrec : tsmallrecord);cdecl; 303 begin 304 if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then 305 global_u8bit := RESULT_U8BIT; 306 end; 307 308 309 procedure proc_value_largerecord(largerec : tlargerecord);cdecl; 310 begin 311 if (largerec.b[1] = RESULT_U8BIT) and (largerec.b[2] = RESULT_U8BIT) then 312 global_u8bit := RESULT_U8BIT; 313 end; 314 315 procedure proc_value_smallset(smallset : tsmallset);cdecl; 316 begin 317 if A_D in smallset then 318 global_u8bit := RESULT_U8BIT; 319 end; 320 321 322 procedure proc_value_largeset(largeset : tlargeset);cdecl; 323 begin 324 if 'I' in largeset then 325 global_u8bit := RESULT_U8BIT; 326 end; 327 328 procedure proc_value_smallstring(s:tsmallstring);cdecl; 329 begin 330 if s = RESULT_SMALLSTRING then 331 global_u8bit := RESULT_u8BIT; 332 end; 333 334 335 procedure proc_value_bigstring(s:shortstring);cdecl; 336 begin 337 if s = RESULT_BIGSTRING then 338 global_u8bit := RESULT_u8BIT; 339 end; 340 341 342 procedure proc_value_smallarray(arr : tsmallarray);cdecl; 343 begin 344 if arr[SMALL_INDEX] = RESULT_U8BIT then 345 global_u8bit := RESULT_U8BIT; 346 end; 347 348 procedure proc_value_smallarray_open(arr : array of byte);cdecl; 349 begin 350 { form 0 to N-1 indexes in open arrays } 351 if arr[SMALL_INDEX-1] = RESULT_U8BIT then 352 global_u8bit := RESULT_U8BIT; 353 end; 354 355{$ifndef tp} 356 procedure proc_value_classrefdef(obj : tclass1);cdecl; 357 begin 358 global_class:=obj; 359 end; 360 361 362 procedure proc_value_s64bit(v: int64);cdecl; 363 begin 364 global_s64bit:= v; 365 end; 366{$endif} 367 368 {********************************* MIXED PARAMETERS *************************} 369 370 procedure proc_value_u8bit_mixed(b1 : byte; v: byte; b2: byte);cdecl; 371 begin 372 global_u8bit := v; 373 value_u8bit := b2; 374 end; 375 376 377 procedure proc_value_u16bit_mixed(b1: byte; v: word; b2: byte);cdecl; 378 begin 379 global_u16bit := v; 380 value_u8bit := b2; 381 end; 382 383 384 procedure proc_value_s32bit_mixed(b1 : byte; v : longint; b2: byte);cdecl; 385 begin 386 global_s32bit := v; 387 value_u8bit := b2; 388 end; 389 390 391 392 393 procedure proc_value_bool8bit_mixed(b1: byte; v: boolean; b2: byte);cdecl; 394 begin 395 { boolean should be 8-bit always! } 396 if sizeof(boolean) <> 1 then RunError(255); 397 global_u8bit := byte(v); 398 value_u8bit := b2; 399 end; 400 401 402 procedure proc_value_bool16bit_mixed(b1 : byte; v: wordbool; b2: byte);cdecl; 403 begin 404 global_u16bit := word(v); 405 value_u8bit := b2; 406 end; 407 408 409 procedure proc_value_bool32bit_mixed(b1 : byte; v : longbool; b2: byte);cdecl; 410 begin 411 global_s32bit := longint(v); 412 value_u8bit := b2; 413 end; 414 415 416 procedure proc_value_s32real_mixed(b1: byte; v : single; b2: byte);cdecl; 417 begin 418 global_s32real := v; 419 value_u8bit := b2; 420 end; 421 422 procedure proc_value_s64real_mixed(b1: byte; v: double; b2: byte);cdecl; 423 begin 424 global_s64real:= v; 425 value_u8bit := b2; 426 end; 427 428 429 procedure proc_value_pointerdef_mixed(b1: byte; p : pchar; b2: byte);cdecl; 430 begin 431 global_ptr:=p; 432 value_u8bit := b2; 433 end; 434 435 436 procedure proc_value_procvardef_mixed(b1: byte; p : tprocedure; b2: byte);cdecl; 437 begin 438 global_proc:=p; 439 value_u8bit := b2; 440 end; 441 442 443 444 445 procedure proc_value_smallrecord_mixed(b1: byte; smallrec : tsmallrecord; b2: byte);cdecl; 446 begin 447 if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then 448 global_u8bit := RESULT_U8BIT; 449 value_u8bit := b2; 450 end; 451 452 453 procedure proc_value_largerecord_mixed(b1: byte; largerec : tlargerecord; b2: byte);cdecl; 454 begin 455 if (largerec.b[1] = RESULT_U8BIT) and (largerec.b[2] = RESULT_U8BIT) then 456 global_u8bit := RESULT_U8BIT; 457 value_u8bit := b2; 458 end; 459 460 procedure proc_value_smallset_mixed(b1: byte; smallset : tsmallset; b2: byte);cdecl; 461 begin 462 if A_D in smallset then 463 global_u8bit := RESULT_U8BIT; 464 value_u8bit := b2; 465 end; 466 467 468 procedure proc_value_largeset_mixed(b1: byte; largeset : tlargeset; b2: byte);cdecl; 469 begin 470 if 'I' in largeset then 471 global_u8bit := RESULT_U8BIT; 472 value_u8bit := b2; 473 end; 474 475 procedure proc_value_smallstring_mixed(b1: byte; s:tsmallstring; b2: byte);cdecl; 476 begin 477 if s = RESULT_SMALLSTRING then 478 global_u8bit := RESULT_u8BIT; 479 value_u8bit := b2; 480 end; 481 482 483 procedure proc_value_bigstring_mixed(b1: byte; s:shortstring; b2: byte);cdecl; 484 begin 485 if s = RESULT_BIGSTRING then 486 global_u8bit := RESULT_u8BIT; 487 value_u8bit := b2; 488 end; 489 490 491 procedure proc_value_smallarray_mixed(b1: byte; arr : tsmallarray; b2: byte);cdecl; 492 begin 493 if arr[SMALL_INDEX] = RESULT_U8BIT then 494 global_u8bit := RESULT_U8BIT; 495 value_u8bit := b2; 496 end; 497 498 procedure proc_value_smallarray_open_mixed(b1: byte; arr : array of byte; b2: byte);cdecl; 499 begin 500 { form 0 to N-1 indexes in open arrays } 501 if arr[SMALL_INDEX-1] = RESULT_U8BIT then 502 global_u8bit := RESULT_U8BIT; 503 value_u8bit := b2; 504 end; 505 506{$ifndef tp} 507 procedure proc_value_classrefdef_mixed(b1: byte; obj : tclass1; b2: byte);cdecl; 508 begin 509 global_class:=obj; 510 value_u8bit := b2; 511 end; 512 513 514 procedure proc_value_s64bit_mixed(b1 : byte; v: int64; b2: byte);cdecl; 515 begin 516 global_s64bit:= v; 517 value_u8bit := b2; 518 end; 519 520 521{$endif} 522 523 524 525var 526 failed: boolean; 527Begin 528 {***************************** NORMAL TESTS *******************************} 529 clear_globals; 530 clear_values; 531 532 failed:=false; 533 534 { LOC_REGISTER } 535 write('Value parameter test (src : LOC_REGISTER)...'); 536 proc_value_u8bit(getu8bit); 537 if global_u8bit <> RESULT_U8BIT then 538 failed:=true; 539 proc_value_u16bit(getu16bit); 540 if global_u16bit <> RESULT_U16BIT then 541 failed:=true; 542 proc_value_s32bit(gets32bit); 543 if global_s32bit <> RESULT_S32BIT then 544 failed:=true; 545{$ifndef tp} 546 proc_value_s64bit(gets64bit); 547 if global_s64bit <> RESULT_S64BIT then 548 failed:=true; 549{$endif} 550 if failed then 551 fail 552 else 553 WriteLn('Passed!'); 554 555 556 { LOC_FPUREGISTER } 557 clear_globals; 558 clear_values; 559 failed:=false; 560 write('Value parameter test (src : LOC_FPUREGISTER)...'); 561 proc_value_s32real(gets32real); 562 if trunc(global_s32real) <> trunc(RESULT_S32REAL) then 563 failed:=true; 564 proc_value_s64real(gets64real); 565 if trunc(global_s64real) <> trunc(RESULT_S64REAL) then 566 failed:=true; 567 if failed then 568 fail 569 else 570 WriteLn('Passed!'); 571 572 573 { LOC_MEM, LOC_REFERENCE orddef } 574 clear_globals; 575 clear_values; 576 value_u8bit := RESULT_U8BIT; 577 value_u16bit := RESULT_U16BIT; 578 value_s32bit := RESULT_S32BIT; 579{$ifndef tp} 580 value_s64bit := RESULT_S64BIT; 581{$endif} 582 value_s32real := RESULT_S32REAL; 583 value_s64real := RESULT_S64REAL; 584 585 failed:=false; 586 587 { LOC_REFERENCE } 588 write('Value parameter test (src : LOC_REFERENCE (orddef/enumdef)))...'); 589 proc_value_u8bit(value_u8bit); 590 if global_u8bit <> RESULT_U8BIT then 591 failed:=true; 592 proc_value_u16bit(value_u16bit); 593 if global_u16bit <> RESULT_U16BIT then 594 failed:=true; 595 proc_value_s32bit(value_s32bit); 596 if global_s32bit <> RESULT_S32BIT then 597 failed:=true; 598{$ifndef tp} 599 proc_value_s64bit(value_s64bit); 600 if global_s64bit <> RESULT_S64BIT then 601 failed:=true; 602{$endif} 603 if failed then 604 fail 605 else 606 WriteLn('Passed!'); 607 608 609 { LOC_REFERENCE } 610 clear_globals; 611 failed:=false; 612 write('Value parameter test (src : LOC_REFERENCE (floatdef))...'); 613 proc_value_s32real(value_s32real); 614 if trunc(global_s32real) <> trunc(RESULT_S32REAL) then 615 failed:=true; 616 proc_value_s64real(value_s64real); 617 if trunc(global_s64real) <> trunc(RESULT_S64REAL) then 618 failed:=true; 619 if failed then 620 fail 621 else 622 WriteLn('Passed!'); 623 624 625 626 write('Value parameter test (src : LOC_REFERENCE (pointer))...'); 627 clear_globals; 628 clear_values; 629 failed:=false; 630 value_ptr := RESULT_PCHAR; 631 proc_value_pointerdef(value_ptr); 632 if global_ptr <> value_ptr then 633 failed := true; 634 635 636 value_proc := {$ifndef tp}@{$endif}testprocedure; 637 proc_value_procvardef(value_proc); 638 if {$ifndef fpc}@{$endif}value_proc <> {$ifndef fpc}@{$endif}global_proc then 639 failed := true; 640 641{$ifndef tp} 642 value_class := tclass1.create; 643 proc_value_classrefdef(value_class); 644 if value_class <> global_class then 645 failed := true; 646 value_class.destroy; 647{$endif} 648 if failed then 649 fail 650 else 651 WriteLn('Passed!'); 652 653 654 655 656 { LOC_REFERENCE } 657 clear_globals; 658 clear_values; 659 failed:=false; 660 value_u8bit := 0; 661 write('Value parameter test (src : LOC_FLAGS (orddef)))...'); 662 proc_value_bool8bit(value_u8bit = 0); 663 if global_u8bit <> RESULT_BOOL8BIT then 664 failed:=true; 665{* IMPOSSIBLE TO GENERATE LOC_FLAGS WITH SIZE <> S_B ON VERSION 1.0.x 666 proc_value_bool16bit(value_s64bit < 0); 667 if global_u16bit <> RESULT_BOOL16BIT then 668 failed:=true; 669 proc_value_bool32bit(bool1 and bool2); 670 if global_s32bit <> RESULT_BOOL32BIT then 671 failed:=true;*} 672 if failed then 673 fail 674 else 675 WriteLn('Passed!'); 676 677 678 679{$ifndef tp} 680 clear_globals; 681 clear_values; 682 failed:=false; 683 write('Value parameter test (src : LOC_JUMP (orddef)))...'); 684 proc_value_bool8bit(value_s64bit = 0); 685 if global_u8bit <> RESULT_BOOL8BIT then 686 failed:=true; 687{* IMPOSSIBLE TO GENERATE LOC_JUMP WITH SIZE <> S_B ON VERSION 1.0.x 688 proc_value_bool16bit(value_s64bit < 0); 689 if global_u16bit <> RESULT_BOOL16BIT then 690 failed:=true; 691 proc_value_bool32bit(bool1 and bool2); 692 if global_s32bit <> RESULT_BOOL32BIT then 693 failed:=true;*} 694 if failed then 695 fail 696 else 697 WriteLn('Passed!'); 698{$endif} 699 700 { arraydef, 701 recorddef, 702 objectdef, 703 stringdef, 704 setdef : all considered the same by code generator. 705 } 706 write('Value parameter test (src : LOC_REFERENCE (recorddef)))...'); 707 clear_globals; 708 clear_values; 709 failed := false; 710 711 value_smallrec.b := RESULT_U8BIT; 712 value_smallrec.w := RESULT_U16BIT; 713 proc_value_smallrecord(value_smallrec); 714 if global_u8bit <> RESULT_U8BIT then 715 failed := true; 716 717 clear_globals; 718 clear_values; 719 fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT); 720 proc_value_largerecord(value_largerec); 721 if global_u8bit <> RESULT_U8BIT then 722 failed := true; 723 724 if failed then 725 fail 726 else 727 WriteLn('Passed!'); 728 729 730 731 write('Value parameter test (src : LOC_REFERENCE (setdef)))...'); 732 clear_globals; 733 clear_values; 734 failed := false; 735 736 value_smallset := [A_A,A_D]; 737 proc_value_smallset(value_smallset); 738 if global_u8bit <> RESULT_U8BIT then 739 failed := true; 740 741 clear_globals; 742 clear_values; 743 value_largeset := ['I']; 744 proc_value_largeset(value_largeset); 745 if global_u8bit <> RESULT_U8BIT then 746 failed := true; 747 748 if failed then 749 fail 750 else 751 WriteLn('Passed!'); 752 753 754 755 756 757 write('Value parameter test (src : LOC_REFERENCE (stringdef)))...'); 758 clear_globals; 759 clear_values; 760 failed := false; 761 value_smallstring := RESULT_SMALLSTRING; 762 763 proc_value_smallstring(value_smallstring); 764 if global_u8bit <> RESULT_U8BIT then 765 failed := true; 766 767 clear_globals; 768 clear_values; 769 value_bigstring := RESULT_BIGSTRING; 770 proc_value_bigstring(value_bigstring); 771 if global_u8bit <> RESULT_U8BIT then 772 failed := true; 773 774 if failed then 775 fail 776 else 777 WriteLn('Passed!'); 778 779 780 781 { open array by value with cdecl modifier!!!!!!!!!!!!!!!!!!!!!!!!!!!} 782 { DON'T KNOW WHY/HOW TO TEST!!!!! } 783 784 785 write('Value parameter test (src : LOC_REFERENCE (arraydef)))...'); 786 787 clear_globals; 788 clear_values; 789 failed:=false; 790 791 fillchar(value_smallarray,sizeof(value_smallarray),#0); 792 value_smallarray[SMALL_INDEX] := RESULT_U8BIT; 793 proc_value_smallarray(value_smallarray); 794 if global_u8bit <> RESULT_U8BIT then 795 failed := true; 796 797 clear_globals; 798 clear_values; 799 800 fillchar(value_smallarray,sizeof(value_smallarray),#0); 801 value_smallarray[SMALL_INDEX] := RESULT_U8BIT; 802 proc_value_smallarray_open(value_smallarray); 803 if global_u8bit <> RESULT_U8BIT then 804 failed := true; 805 806 807 if failed then 808 fail 809 else 810 WriteLn('Passed!'); 811 812 {***************************** MIXED TESTS *******************************} 813 clear_globals; 814 clear_values; 815 816 failed:=false; 817 818 { LOC_REGISTER } 819 write('Mixed value parameter test (src : LOC_REGISTER)...'); 820 proc_value_u8bit_mixed(byte(NOT RESULT_U8BIT),getu8bit,RESULT_U8BIT); 821 if global_u8bit <> RESULT_U8BIT then 822 failed:=true; 823 if value_u8bit <> RESULT_U8BIT then 824 failed := true; 825 proc_value_u16bit_mixed(byte(NOT RESULT_U8BIT),getu16bit,RESULT_U8BIT); 826 if global_u16bit <> RESULT_U16BIT then 827 failed:=true; 828 if value_u8bit <> RESULT_U8BIT then 829 failed := true; 830 proc_value_s32bit_mixed(byte(NOT RESULT_U8BIT),gets32bit, RESULT_U8BIT); 831 if global_s32bit <> RESULT_S32BIT then 832 failed:=true; 833 if value_u8bit <> RESULT_U8BIT then 834 failed := true; 835{$ifndef tp} 836 proc_value_s64bit_mixed(byte(NOT RESULT_U8BIT),gets64bit,RESULT_U8BIT); 837 if global_s64bit <> RESULT_S64BIT then 838 failed:=true; 839{$endif} 840 if value_u8bit <> RESULT_U8BIT then 841 failed := true; 842 843 if failed then 844 fail 845 else 846 WriteLn('Passed!'); 847 848 849 { LOC_FPUREGISTER } 850 clear_globals; 851 clear_values; 852 failed:=false; 853 write('Mixed value parameter test (src : LOC_FPUREGISTER)...'); 854 proc_value_s32real_mixed(byte(NOT RESULT_U8BIT), gets32real, RESULT_U8BIT); 855 if value_u8bit <> RESULT_U8BIT then 856 failed := true; 857 if trunc(global_s32real) <> trunc(RESULT_S32REAL) then 858 failed:=true; 859 proc_value_s64real_mixed(byte(NOT RESULT_U8BIT),gets64real,RESULT_U8BIT); 860 if value_u8bit <> RESULT_U8BIT then 861 failed := true; 862 if trunc(global_s64real) <> trunc(RESULT_S64REAL) then 863 failed:=true; 864 if failed then 865 fail 866 else 867 WriteLn('Passed!'); 868 869 870 { LOC_MEM, LOC_REFERENCE orddef } 871 clear_globals; 872 clear_values; 873 value_u8bit := RESULT_U8BIT; 874 value_u16bit := RESULT_U16BIT; 875 value_s32bit := RESULT_S32BIT; 876{$ifndef tp} 877 value_s64bit := RESULT_S64BIT; 878{$endif} 879 value_s32real := RESULT_S32REAL; 880 value_s64real := RESULT_S64REAL; 881 882 failed:=false; 883 884 { LOC_REFERENCE } 885 write('Mixed value parameter test (src : LOC_REFERENCE (orddef/enumdef)))...'); 886 proc_value_u8bit_mixed(byte(NOT RESULT_U8BIT),value_u8bit, RESULT_U8BIT); 887 if global_u8bit <> RESULT_U8BIT then 888 failed:=true; 889 if value_u8bit <> RESULT_U8BIT then 890 failed := true; 891 proc_value_u16bit_mixed(byte(NOT RESULT_U8BIT),value_u16bit, RESULT_U8BIT); 892 if global_u16bit <> RESULT_U16BIT then 893 failed:=true; 894 if value_u8bit <> RESULT_U8BIT then 895 failed := true; 896 proc_value_s32bit_mixed(byte(NOT RESULT_U8BIT),value_s32bit, RESULT_U8BIT); 897 if global_s32bit <> RESULT_S32BIT then 898 failed:=true; 899 if value_u8bit <> RESULT_U8BIT then 900 failed := true; 901{$ifndef tp} 902 proc_value_s64bit_mixed(byte(NOT RESULT_U8BIT), value_s64bit, RESULT_U8BIT); 903 if global_s64bit <> RESULT_S64BIT then 904 failed:=true; 905{$endif} 906 if value_u8bit <> RESULT_U8BIT then 907 failed := true; 908 909 if failed then 910 fail 911 else 912 WriteLn('Passed!'); 913 914 915 { LOC_REFERENCE } 916 clear_globals; 917 failed:=false; 918 write('Mixed value parameter test (src : LOC_REFERENCE (floatdef))...'); 919 proc_value_s32real_mixed(byte(NOT RESULT_U8BIT), value_s32real, RESULT_U8BIT); 920 if trunc(global_s32real) <> trunc(RESULT_S32REAL) then 921 failed:=true; 922 if value_u8bit <> RESULT_U8BIT then 923 failed := true; 924 proc_value_s64real_mixed(byte(NOT RESULT_U8BIT), value_s64real, RESULT_U8BIT); 925 if trunc(global_s64real) <> trunc(RESULT_S64REAL) then 926 failed:=true; 927 if value_u8bit <> RESULT_U8BIT then 928 failed := true; 929 930 if failed then 931 fail 932 else 933 WriteLn('Passed!'); 934 935 936 937 write('Mixed value parameter test (src : LOC_REFERENCE (pointer))...'); 938 clear_globals; 939 clear_values; 940 failed:=false; 941 value_ptr := RESULT_PCHAR; 942 proc_value_pointerdef_mixed(byte(NOT RESULT_U8BIT), value_ptr, RESULT_U8BIT); 943 if global_ptr <> value_ptr then 944 failed := true; 945 if value_u8bit <> RESULT_U8BIT then 946 failed := true; 947 948 949 value_proc := {$ifndef tp}@{$endif}testprocedure; 950 proc_value_procvardef_mixed(byte(NOT RESULT_U8BIT), value_proc, RESULT_U8BIT); 951 if {$ifndef fpc}@{$endif}value_proc <> {$ifndef fpc}@{$endif}global_proc then 952 failed := true; 953 954{$ifndef tp} 955 value_class := tclass1.create; 956 proc_value_classrefdef_mixed(byte(NOT RESULT_U8BIT), value_class, RESULT_U8BIT); 957 if value_class <> global_class then 958 failed := true; 959 if value_u8bit <> RESULT_U8BIT then 960 failed := true; 961 value_class.destroy; 962{$endif} 963 if failed then 964 fail 965 else 966 WriteLn('Passed!'); 967 968 969 970 971 { LOC_REFERENCE } 972 clear_globals; 973 clear_values; 974 failed:=false; 975 value_u8bit := 0; 976 write('Mixed value parameter test (src : LOC_FLAGS (orddef)))...'); 977 proc_value_bool8bit_mixed(byte(NOT RESULT_U8BIT), value_u8bit = 0, RESULT_U8BIT); 978 if global_u8bit <> RESULT_BOOL8BIT then 979 failed:=true; 980 if value_u8bit <> RESULT_U8BIT then 981 failed := true; 982{* IMPOSSIBLE TO GENERATE LOC_FLAGS WITH SIZE <> S_B ON VERSION 1.0.x 983 proc_value_bool16bit(value_s64bit < 0); 984 if global_u16bit <> RESULT_BOOL16BIT then 985 failed:=true; 986 proc_value_bool32bit(bool1 and bool2); 987 if global_s32bit <> RESULT_BOOL32BIT then 988 failed:=true;*} 989 if failed then 990 fail 991 else 992 WriteLn('Passed!'); 993 994 995 996{$ifndef tp} 997 clear_globals; 998 clear_values; 999 failed:=false; 1000 write('Mixed value parameter test (src : LOC_JUMP (orddef)))...'); 1001 proc_value_bool8bit_mixed(byte(NOT RESULT_U8BIT), value_s64bit = 0, RESULT_U8BIT); 1002 if global_u8bit <> RESULT_BOOL8BIT then 1003 failed:=true; 1004 if value_u8bit <> RESULT_U8BIT then 1005 failed := true; 1006{* IMPOSSIBLE TO GENERATE LOC_JUMP WITH SIZE <> S_B ON VERSION 1.0.x 1007 proc_value_bool16bit(value_s64bit < 0); 1008 if global_u16bit <> RESULT_BOOL16BIT then 1009 failed:=true; 1010 proc_value_bool32bit(bool1 and bool2); 1011 if global_s32bit <> RESULT_BOOL32BIT then 1012 failed:=true;*} 1013 if failed then 1014 fail 1015 else 1016 WriteLn('Passed!'); 1017{$endif} 1018 1019 { arraydef, 1020 recorddef, 1021 objectdef, 1022 stringdef, 1023 setdef : all considered the same by code generator. 1024 } 1025 write('Mixed value parameter test (src : LOC_REFERENCE (recorddef)))...'); 1026 clear_globals; 1027 clear_values; 1028 failed := false; 1029 1030 value_smallrec.b := RESULT_U8BIT; 1031 value_smallrec.w := RESULT_U16BIT; 1032 proc_value_smallrecord_mixed(byte(NOT RESULT_U8BIT), value_smallrec, RESULT_U8BIT); 1033 if global_u8bit <> RESULT_U8BIT then 1034 failed := true; 1035 if value_u8bit <> RESULT_U8BIT then 1036 failed := true; 1037 1038 clear_globals; 1039 clear_values; 1040 fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT); 1041 proc_value_largerecord_mixed(byte(NOT RESULT_U8BIT), value_largerec, RESULT_U8BIT); 1042 if global_u8bit <> RESULT_U8BIT then 1043 failed := true; 1044 if value_u8bit <> RESULT_U8BIT then 1045 failed := true; 1046 1047 if failed then 1048 fail 1049 else 1050 WriteLn('Passed!'); 1051 1052 1053 1054 write('Mixed value parameter test (src : LOC_REFERENCE (setdef)))...'); 1055 clear_globals; 1056 clear_values; 1057 failed := false; 1058 1059 value_smallset := [A_A,A_D]; 1060 proc_value_smallset_mixed(byte(NOT RESULT_U8BIT), value_smallset, RESULT_U8BIT); 1061 if global_u8bit <> RESULT_U8BIT then 1062 failed := true; 1063 if value_u8bit <> RESULT_U8BIT then 1064 failed := true; 1065 1066 clear_globals; 1067 clear_values; 1068 value_largeset := ['I']; 1069 proc_value_largeset_mixed(byte(NOT RESULT_U8BIT), value_largeset, RESULT_U8BIT); 1070 if global_u8bit <> RESULT_U8BIT then 1071 failed := true; 1072 if value_u8bit <> RESULT_U8BIT then 1073 failed := true; 1074 1075 if failed then 1076 fail 1077 else 1078 WriteLn('Passed!'); 1079 1080 1081 1082 1083 1084 write('Mixed value parameter test (src : LOC_REFERENCE (stringdef)))...'); 1085 clear_globals; 1086 clear_values; 1087 failed := false; 1088 value_smallstring := RESULT_SMALLSTRING; 1089 1090 proc_value_smallstring_mixed(byte(NOT RESULT_U8BIT), value_smallstring, RESULT_U8BIT); 1091 if global_u8bit <> RESULT_U8BIT then 1092 failed := true; 1093 if value_u8bit <> RESULT_U8BIT then 1094 failed := true; 1095 1096 clear_globals; 1097 clear_values; 1098 value_bigstring := RESULT_BIGSTRING; 1099 proc_value_bigstring_mixed(byte(NOT RESULT_U8BIT), value_bigstring, RESULT_U8BIT); 1100 if global_u8bit <> RESULT_U8BIT then 1101 failed := true; 1102 if value_u8bit <> RESULT_U8BIT then 1103 failed := true; 1104 1105 if failed then 1106 fail 1107 else 1108 WriteLn('Passed!'); 1109 1110 1111 1112 { open array by value with cdecl modifier!!!!!!!!!!!!!!!!!!!!!!!!!!!} 1113 { DON'T KNOW WHY/HOW TO TEST!!!!! } 1114 1115 1116 write('Mixed value parameter test (src : LOC_REFERENCE (arraydef)))...'); 1117 1118 clear_globals; 1119 clear_values; 1120 failed:=false; 1121 1122 fillchar(value_smallarray,sizeof(value_smallarray),#0); 1123 value_smallarray[SMALL_INDEX] := RESULT_U8BIT; 1124 proc_value_smallarray_mixed(byte(NOT RESULT_U8BIT), value_smallarray, RESULT_U8BIT); 1125 if global_u8bit <> RESULT_U8BIT then 1126 failed := true; 1127 if value_u8bit <> RESULT_U8BIT then 1128 failed := true; 1129 1130 clear_globals; 1131 clear_values; 1132 1133 fillchar(value_smallarray,sizeof(value_smallarray),#0); 1134 value_smallarray[SMALL_INDEX] := RESULT_U8BIT; 1135 proc_value_smallarray_open_mixed(byte(NOT RESULT_U8BIT), value_smallarray, RESULT_U8BIT); 1136 if global_u8bit <> RESULT_U8BIT then 1137 failed := true; 1138 if value_u8bit <> RESULT_U8BIT then 1139 failed := true; 1140 1141 1142 if failed then 1143 fail 1144 else 1145 WriteLn('Passed!'); 1146 1147end. 1148