1 2(********************************************************************) 3(* *) 4(* chkexc.sd7 Checks exceptions *) 5(* Copyright (C) 1994, 2005, 2010 Thomas Mertes *) 6(* *) 7(* This program is free software; you can redistribute it and/or *) 8(* modify it under the terms of the GNU General Public License as *) 9(* published by the Free Software Foundation; either version 2 of *) 10(* the License, or (at your option) any later version. *) 11(* *) 12(* This program is distributed in the hope that it will be useful, *) 13(* but WITHOUT ANY WARRANTY; without even the implied warranty of *) 14(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) 15(* GNU General Public License for more details. *) 16(* *) 17(* You should have received a copy of the GNU General Public *) 18(* License along with this program; if not, write to the *) 19(* Free Software Foundation, Inc., 51 Franklin Street, *) 20(* Fifth Floor, Boston, MA 02110-1301, USA. *) 21(* *) 22(********************************************************************) 23 24 25$ include "seed7_05.s7i"; 26 include "stdio.s7i"; 27 include "bigint.s7i"; 28 include "float.s7i"; 29 include "math.s7i"; 30 include "utf8.s7i"; 31 include "shell.s7i"; 32 include "bigfile.s7i"; 33 include "osfiles.s7i"; 34 35 36const proc: f1 (in integer: number) is func 37 begin 38 ignore(1 div 0); 39 end func; 40 41 42const proc: f2 (in integer: number) is func 43 begin 44 f1(number); 45 end func; 46 47 48const proc: f3 is func 49 begin 50 f2(5); 51 end func; 52 53 54const proc: f4 (in integer: number) is func 55 begin 56 f3; 57 end func; 58 59 60const func integer: test_func (in integer: number) is 61 return number; 62 63 64const func integer: intExpr (in integer: number) is 65 return number + length(str(rand(1, 9))[2 ..]); 66 67 68const proc: check_integer_exponentiation (inout boolean: okay) is func 69 local 70 var integer: number is 0; 71 var integer: i_num is 0; 72 begin 73 block 74 i_num := 0 ** 0; 75 if i_num = 1 then 76 incr(number); 77 else 78 writeln(" ***** 0 ** 0 did not deliver 1"); 79 okay := FALSE; 80 end if; 81 exception 82 catch NUMERIC_ERROR: 83 writeln(" ***** 0 ** 0 did raise NUMERIC_ERROR"); 84 okay := FALSE; 85 end block; 86 87 block 88 i_num := 0 ** (-2); 89 writeln(" ***** 0 ** (-2) did not raise NUMERIC_ERROR"); 90 okay := FALSE; 91 exception 92 catch NUMERIC_ERROR: 93 incr(number); 94 end block; 95 96 block 97 i_num := 0 ** intExpr(0); 98 if i_num = 1 then 99 incr(number); 100 else 101 writeln(" ***** 0 ** intExpr(0) did not deliver 1"); 102 okay := FALSE; 103 end if; 104 exception 105 catch NUMERIC_ERROR: 106 writeln(" ***** 0 ** intExpr(0) did raise NUMERIC_ERROR"); 107 okay := FALSE; 108 end block; 109 110 block 111 i_num := 0 ** intExpr(-2); 112 writeln(" ***** 0 ** intExpr(-2) did not raise NUMERIC_ERROR"); 113 okay := FALSE; 114 exception 115 catch NUMERIC_ERROR: 116 incr(number); 117 end block; 118 119 block 120 i_num := intExpr(0) ** 0; 121 if i_num = 1 then 122 incr(number); 123 else 124 writeln(" ***** intExpr(0) ** 0 did not deliver 1"); 125 okay := FALSE; 126 end if; 127 exception 128 catch NUMERIC_ERROR: 129 writeln(" ***** intExpr(0) ** 0 did raise NUMERIC_ERROR"); 130 okay := FALSE; 131 end block; 132 133 block 134 i_num := intExpr(0) ** (-2); 135 writeln(" ***** intExpr(0) ** (-2) did not raise NUMERIC_ERROR"); 136 okay := FALSE; 137 exception 138 catch NUMERIC_ERROR: 139 incr(number); 140 end block; 141 142 block 143 i_num := intExpr(0) ** intExpr(0); 144 if i_num = 1 then 145 incr(number); 146 else 147 writeln(" ***** intExpr(0) ** intExpr(0) did not deliver 1"); 148 okay := FALSE; 149 end if; 150 exception 151 catch NUMERIC_ERROR: 152 writeln(" ***** intExpr(0) ** intExpr(0) did raise NUMERIC_ERROR"); 153 okay := FALSE; 154 end block; 155 156 block 157 i_num := intExpr(0) ** intExpr(-2); 158 writeln(" ***** intExpr(0) ** intExpr(-2) did not raise NUMERIC_ERROR"); 159 okay := FALSE; 160 exception 161 catch NUMERIC_ERROR: 162 incr(number); 163 end block; 164 165 block 166 i_num := 1 ** (-2); 167 writeln(" ***** 1 ** (-2) did not raise NUMERIC_ERROR"); 168 okay := FALSE; 169 exception 170 catch NUMERIC_ERROR: 171 incr(number); 172 end block; 173 174 block 175 i_num := 1 ** intExpr(-2); 176 writeln(" ***** 1 ** intExpr(-2) did not raise NUMERIC_ERROR"); 177 okay := FALSE; 178 exception 179 catch NUMERIC_ERROR: 180 incr(number); 181 end block; 182 183 block 184 i_num := intExpr(1) ** (-2); 185 writeln(" ***** intExpr(1) ** (-2) did not raise NUMERIC_ERROR"); 186 okay := FALSE; 187 exception 188 catch NUMERIC_ERROR: 189 incr(number); 190 end block; 191 192 block 193 i_num := intExpr(1) ** intExpr(-2); 194 writeln(" ***** intExpr(1) ** intExpr(-2) did not raise NUMERIC_ERROR"); 195 okay := FALSE; 196 exception 197 catch NUMERIC_ERROR: 198 incr(number); 199 end block; 200 201 block 202 i_num := 2 ** (-2); 203 writeln(" ***** 2 ** (-2) did not raise NUMERIC_ERROR"); 204 okay := FALSE; 205 exception 206 catch NUMERIC_ERROR: 207 incr(number); 208 end block; 209 210 block 211 i_num := 2 ** intExpr(-2); 212 writeln(" ***** 2 ** intExpr(-2) did not raise NUMERIC_ERROR"); 213 okay := FALSE; 214 exception 215 catch NUMERIC_ERROR: 216 incr(number); 217 end block; 218 219 block 220 i_num := intExpr(2) ** (-2); 221 writeln(" ***** intExpr(2) ** (-2) did not raise NUMERIC_ERROR"); 222 okay := FALSE; 223 exception 224 catch NUMERIC_ERROR: 225 incr(number); 226 end block; 227 228 block 229 i_num := intExpr(2) ** intExpr(-2); 230 writeln(" ***** intExpr(2) ** intExpr(-2) did not raise NUMERIC_ERROR"); 231 okay := FALSE; 232 exception 233 catch NUMERIC_ERROR: 234 incr(number); 235 end block; 236 237 block 238 i_num := 3 ** (-2); 239 writeln(" ***** 3 ** (-2) did not raise NUMERIC_ERROR"); 240 okay := FALSE; 241 exception 242 catch NUMERIC_ERROR: 243 incr(number); 244 end block; 245 246 block 247 i_num := 3 ** intExpr(-2); 248 writeln(" ***** 3 ** intExpr(-2) did not raise NUMERIC_ERROR"); 249 okay := FALSE; 250 exception 251 catch NUMERIC_ERROR: 252 incr(number); 253 end block; 254 255 block 256 i_num := intExpr(3) ** (-2); 257 writeln(" ***** intExpr(3) ** (-2) did not raise NUMERIC_ERROR"); 258 okay := FALSE; 259 exception 260 catch NUMERIC_ERROR: 261 incr(number); 262 end block; 263 264 block 265 i_num := intExpr(3) ** intExpr(-2); 266 writeln(" ***** 3 ** intExpr(-2) did not raise NUMERIC_ERROR"); 267 okay := FALSE; 268 exception 269 catch NUMERIC_ERROR: 270 incr(number); 271 end block; 272 273 block 274 i_num := 4 ** (-2); 275 writeln(" ***** 4 ** (-2) did not raise NUMERIC_ERROR"); 276 okay := FALSE; 277 exception 278 catch NUMERIC_ERROR: 279 incr(number); 280 end block; 281 282 block 283 i_num := 4 ** intExpr(-2); 284 writeln(" ***** 4 ** intExpr(-2) did not raise NUMERIC_ERROR"); 285 okay := FALSE; 286 exception 287 catch NUMERIC_ERROR: 288 incr(number); 289 end block; 290 291 block 292 i_num := intExpr(4) ** (-2); 293 writeln(" ***** intExpr(4) ** (-2) did not raise NUMERIC_ERROR"); 294 okay := FALSE; 295 exception 296 catch NUMERIC_ERROR: 297 incr(number); 298 end block; 299 300 block 301 i_num := intExpr(4) ** intExpr(-2); 302 writeln(" ***** intExpr(4) ** intExpr(-2) did not raise NUMERIC_ERROR"); 303 okay := FALSE; 304 exception 305 catch NUMERIC_ERROR: 306 incr(number); 307 end block; 308 309 block 310 i_num := (-1) ** (-2); 311 writeln(" ***** (-1) ** (-2) did not raise NUMERIC_ERROR"); 312 okay := FALSE; 313 exception 314 catch NUMERIC_ERROR: 315 incr(number); 316 end block; 317 318 block 319 i_num := (-1) ** (-3); 320 writeln(" ***** (-1) ** (-3) did not raise NUMERIC_ERROR"); 321 okay := FALSE; 322 exception 323 catch NUMERIC_ERROR: 324 incr(number); 325 end block; 326 327 block 328 i_num := (-1) ** intExpr(-2); 329 writeln(" ***** (-1) ** intExpr(-2) did not raise NUMERIC_ERROR"); 330 okay := FALSE; 331 exception 332 catch NUMERIC_ERROR: 333 incr(number); 334 end block; 335 336 block 337 i_num := (-1) ** intExpr(-3); 338 writeln(" ***** (-1) ** intExpr(-3) did not raise NUMERIC_ERROR"); 339 okay := FALSE; 340 exception 341 catch NUMERIC_ERROR: 342 incr(number); 343 end block; 344 345 block 346 i_num := intExpr(-1) ** (-2); 347 writeln(" ***** (-1) ** (-2) did not raise NUMERIC_ERROR"); 348 okay := FALSE; 349 exception 350 catch NUMERIC_ERROR: 351 incr(number); 352 end block; 353 354 block 355 i_num := intExpr(-1) ** (-3); 356 writeln(" ***** (-1) ** (-3) did not raise NUMERIC_ERROR"); 357 okay := FALSE; 358 exception 359 catch NUMERIC_ERROR: 360 incr(number); 361 end block; 362 363 block 364 i_num := intExpr(-1) ** intExpr(-2); 365 writeln(" ***** (-1) ** intExpr(-2) did not raise NUMERIC_ERROR"); 366 okay := FALSE; 367 exception 368 catch NUMERIC_ERROR: 369 incr(number); 370 end block; 371 372 block 373 i_num := intExpr(-1) ** intExpr(-3); 374 writeln(" ***** (-1) ** intExpr(-3) did not raise NUMERIC_ERROR"); 375 okay := FALSE; 376 exception 377 catch NUMERIC_ERROR: 378 incr(number); 379 end block; 380 381 if okay and number <> 32 then 382 writeln(" ***** Integer exceptions for exponentiation do not work correct"); 383 writeln; 384 okay := FALSE; 385 end if; 386 end func; 387 388 389const proc: check_integer is func 390 local 391 var boolean: okay is TRUE; 392 var integer: number is 0; 393 var integer: zero is 0; 394 var integer: one is 0; 395 var integer: i_num is 0; 396 const integer: int0 is 0; 397 const integer: int2m is -2; 398 const integer: int3m is -3; 399 begin 400 block 401 i_num := 1 div 0; 402 writeln(" ***** 1 div 0 did not raise NUMERIC_ERROR"); 403 okay := FALSE; 404 exception 405 catch NUMERIC_ERROR: 406 incr(number); 407 end block; 408 409 block 410 i_num := 1 div zero; 411 writeln(" ***** 1 div zero did not raise NUMERIC_ERROR"); 412 okay := FALSE; 413 exception 414 catch NUMERIC_ERROR: 415 incr(number); 416 end block; 417 418 block 419 i_num := one div 0; 420 writeln(" ***** one div 0 did not raise NUMERIC_ERROR"); 421 okay := FALSE; 422 exception 423 catch NUMERIC_ERROR: 424 incr(number); 425 end block; 426 427 block 428 i_num := one div zero; 429 writeln(" ***** one div zero did not raise NUMERIC_ERROR"); 430 okay := FALSE; 431 exception 432 catch NUMERIC_ERROR: 433 incr(number); 434 end block; 435 436 block 437 i_num := 0 div 0; 438 writeln(" ***** 0 div 0 did not raise NUMERIC_ERROR"); 439 okay := FALSE; 440 exception 441 catch NUMERIC_ERROR: 442 incr(number); 443 end block; 444 445 block 446 i_num := 0 div zero; 447 writeln(" ***** 0 div zero did not raise NUMERIC_ERROR"); 448 okay := FALSE; 449 exception 450 catch NUMERIC_ERROR: 451 incr(number); 452 end block; 453 454 block 455 i_num := zero div 0; 456 writeln(" ***** zero div 0 did not raise NUMERIC_ERROR"); 457 okay := FALSE; 458 exception 459 catch NUMERIC_ERROR: 460 incr(number); 461 end block; 462 463 block 464 i_num := zero div zero; 465 writeln(" ***** zero div zero did not raise NUMERIC_ERROR"); 466 okay := FALSE; 467 exception 468 catch NUMERIC_ERROR: 469 incr(number); 470 end block; 471 472 block 473 i_num := 1 rem 0; 474 writeln(" ***** 1 rem 0 did not raise NUMERIC_ERROR"); 475 okay := FALSE; 476 exception 477 catch NUMERIC_ERROR: 478 incr(number); 479 end block; 480 481 block 482 i_num := 1 rem zero; 483 writeln(" ***** 1 rem zero did not raise NUMERIC_ERROR"); 484 okay := FALSE; 485 exception 486 catch NUMERIC_ERROR: 487 incr(number); 488 end block; 489 490 block 491 i_num := one rem 0; 492 writeln(" ***** one rem 0 did not raise NUMERIC_ERROR"); 493 okay := FALSE; 494 exception 495 catch NUMERIC_ERROR: 496 incr(number); 497 end block; 498 499 block 500 i_num := one rem zero; 501 writeln(" ***** one rem zero did not raise NUMERIC_ERROR"); 502 okay := FALSE; 503 exception 504 catch NUMERIC_ERROR: 505 incr(number); 506 end block; 507 508 block 509 i_num := 0 rem 0; 510 writeln(" ***** 0 rem 0 did not raise NUMERIC_ERROR"); 511 okay := FALSE; 512 exception 513 catch NUMERIC_ERROR: 514 incr(number); 515 end block; 516 517 block 518 i_num := 0 rem zero; 519 writeln(" ***** 0 rem zero did not raise NUMERIC_ERROR"); 520 okay := FALSE; 521 exception 522 catch NUMERIC_ERROR: 523 incr(number); 524 end block; 525 526 block 527 i_num := zero rem 0; 528 writeln(" ***** zero rem 0 did not raise NUMERIC_ERROR"); 529 okay := FALSE; 530 exception 531 catch NUMERIC_ERROR: 532 incr(number); 533 end block; 534 535 block 536 i_num := zero rem zero; 537 writeln(" ***** zero rem zero did not raise NUMERIC_ERROR"); 538 okay := FALSE; 539 exception 540 catch NUMERIC_ERROR: 541 incr(number); 542 end block; 543 544 block 545 i_num := 1 mdiv 0; 546 writeln(" ***** 1 mdiv 0 did not raise NUMERIC_ERROR"); 547 okay := FALSE; 548 exception 549 catch NUMERIC_ERROR: 550 incr(number); 551 end block; 552 553 block 554 i_num := 1 mdiv zero; 555 writeln(" ***** 1 mdiv zero did not raise NUMERIC_ERROR"); 556 okay := FALSE; 557 exception 558 catch NUMERIC_ERROR: 559 incr(number); 560 end block; 561 562 block 563 i_num := one mdiv 0; 564 writeln(" ***** one mdiv 0 did not raise NUMERIC_ERROR"); 565 okay := FALSE; 566 exception 567 catch NUMERIC_ERROR: 568 incr(number); 569 end block; 570 571 block 572 i_num := one mdiv zero; 573 writeln(" ***** one mdiv zero did not raise NUMERIC_ERROR"); 574 okay := FALSE; 575 exception 576 catch NUMERIC_ERROR: 577 incr(number); 578 end block; 579 580 block 581 i_num := 0 mdiv 0; 582 writeln(" ***** 0 mdiv 0 did not raise NUMERIC_ERROR"); 583 okay := FALSE; 584 exception 585 catch NUMERIC_ERROR: 586 incr(number); 587 end block; 588 589 block 590 i_num := 0 mdiv zero; 591 writeln(" ***** 0 mdiv zero did not raise NUMERIC_ERROR"); 592 okay := FALSE; 593 exception 594 catch NUMERIC_ERROR: 595 incr(number); 596 end block; 597 598 block 599 i_num := zero mdiv 0; 600 writeln(" ***** zero mdiv 0 did not raise NUMERIC_ERROR"); 601 okay := FALSE; 602 exception 603 catch NUMERIC_ERROR: 604 incr(number); 605 end block; 606 607 block 608 i_num := zero mdiv zero; 609 writeln(" ***** zero mdiv zero did not raise NUMERIC_ERROR"); 610 okay := FALSE; 611 exception 612 catch NUMERIC_ERROR: 613 incr(number); 614 end block; 615 616 block 617 i_num := 1 mod 0; 618 writeln(" ***** 1 mod 0 did not raise NUMERIC_ERROR"); 619 okay := FALSE; 620 exception 621 catch NUMERIC_ERROR: 622 incr(number); 623 end block; 624 625 block 626 i_num := 1 mod zero; 627 writeln(" ***** 1 mod zero did not raise NUMERIC_ERROR"); 628 okay := FALSE; 629 exception 630 catch NUMERIC_ERROR: 631 incr(number); 632 end block; 633 634 block 635 i_num := one mod 0; 636 writeln(" ***** one mod 0 did not raise NUMERIC_ERROR"); 637 okay := FALSE; 638 exception 639 catch NUMERIC_ERROR: 640 incr(number); 641 end block; 642 643 block 644 i_num := one mod zero; 645 writeln(" ***** one mod zero did not raise NUMERIC_ERROR"); 646 okay := FALSE; 647 exception 648 catch NUMERIC_ERROR: 649 incr(number); 650 end block; 651 652 block 653 i_num := 0 mod 0; 654 writeln(" ***** 0 mod 0 did not raise NUMERIC_ERROR"); 655 okay := FALSE; 656 exception 657 catch NUMERIC_ERROR: 658 incr(number); 659 end block; 660 661 block 662 i_num := 0 mod zero; 663 writeln(" ***** 0 mod zero did not raise NUMERIC_ERROR"); 664 okay := FALSE; 665 exception 666 catch NUMERIC_ERROR: 667 incr(number); 668 end block; 669 670 block 671 i_num := zero mod 0; 672 writeln(" ***** zero mod 0 did not raise NUMERIC_ERROR"); 673 okay := FALSE; 674 exception 675 catch NUMERIC_ERROR: 676 incr(number); 677 end block; 678 679 block 680 i_num := zero mod zero; 681 writeln(" ***** zero mod zero did not raise NUMERIC_ERROR"); 682 okay := FALSE; 683 exception 684 catch NUMERIC_ERROR: 685 incr(number); 686 end block; 687 688 block 689 i_num := ! (-1); 690 writeln(" ***** ! (-1) did not raise NUMERIC_ERROR"); 691 okay := FALSE; 692 exception 693 catch NUMERIC_ERROR: 694 incr(number); 695 end block; 696 697 block 698 i_num := log2(-1); 699 writeln(" ***** log2(-1) did not raise NUMERIC_ERROR"); 700 okay := FALSE; 701 exception 702 catch NUMERIC_ERROR: 703 incr(number); 704 end block; 705 706 block 707 i_num := integer parse ""; 708 writeln(" ***** integer parse \"\" did not raise RANGE_ERROR"); 709 okay := FALSE; 710 exception 711 catch RANGE_ERROR: 712 incr(number); 713 end block; 714 715 block 716 i_num := integer parse "123asdf"; 717 writeln(" ***** integer parse \"123asdf\" did not raise RANGE_ERROR"); 718 okay := FALSE; 719 exception 720 catch RANGE_ERROR: 721 incr(number); 722 end block; 723 724 block 725 i_num := integer parse "asdf"; 726 writeln(" ***** integer parse \"asdf\" did not raise RANGE_ERROR"); 727 okay := FALSE; 728 exception 729 catch RANGE_ERROR: 730 incr(number); 731 end block; 732 733 block 734 i_num := rand(1, 0); 735 writeln(" ***** rand(1, 0) did not raise RANGE_ERROR"); 736 okay := FALSE; 737 exception 738 catch RANGE_ERROR: 739 incr(number); 740 end block; 741 742 block 743 i_num := sqrt(-1); 744 writeln(" ***** sqrt(-1) did not raise NUMERIC_ERROR"); 745 okay := FALSE; 746 exception 747 catch NUMERIC_ERROR: 748 incr(number); 749 end block; 750 751 block 752 block 753 i_num := 1 div 0; 754 writeln(" ***** 1 div 0 did not raise NUMERIC_ERROR"); 755 okay := FALSE; 756 exception 757 catch NUMERIC_ERROR: 758 incr(number); 759 end block; 760 exception 761 catch NUMERIC_ERROR: 762 writeln(" ***** NUMERIC_ERROR caught at wrong level"); 763 end block; 764 765 block 766 block 767 i_num := 1 div 0; 768 writeln(" ***** 1 div 0 did not raise NUMERIC_ERROR"); 769 okay := FALSE; 770 exception 771 catch RANGE_ERROR: 772 writeln(" ***** NUMERIC_ERROR caught at wrong level"); 773 end block; 774 exception 775 catch NUMERIC_ERROR: 776 incr(number); 777 end block; 778 779 check_integer_exponentiation(okay); 780 781 if okay and number = 41 then 782 writeln("Integer exceptions work correct."); 783 else 784 writeln(" ***** Integer exceptions do not work correct"); 785 writeln; 786 end if; 787 end func; 788 789 790const func bigInteger: bigIntExpr (in bigInteger: number) is 791 return number; 792 793 794const proc: check_bigInteger_exponentiation (inout boolean: okay) is func 795 local 796 var integer: number is 0; 797 var bigInteger: i_num is 0_; 798 begin 799 block 800 i_num := 0_ ** 0; 801 if i_num = 1_ then 802 incr(number); 803 else 804 writeln(" ***** 0_ ** 0 did not deliver 1_"); 805 okay := FALSE; 806 end if; 807 exception 808 catch NUMERIC_ERROR: 809 writeln(" ***** 0_ ** 0 did raise NUMERIC_ERROR"); 810 okay := FALSE; 811 end block; 812 813 block 814 i_num := 0_ ** (-2); 815 writeln(" ***** 0_ ** (-2) did not raise NUMERIC_ERROR"); 816 okay := FALSE; 817 exception 818 catch NUMERIC_ERROR: 819 incr(number); 820 end block; 821 822 block 823 i_num := 0_ ** intExpr(0); 824 if i_num = 1_ then 825 incr(number); 826 else 827 writeln(" ***** 0_ ** intExpr(0) did not deliver 1_"); 828 okay := FALSE; 829 end if; 830 exception 831 catch NUMERIC_ERROR: 832 writeln(" ***** 0_ ** intExpr(0) did raise NUMERIC_ERROR"); 833 okay := FALSE; 834 end block; 835 836 block 837 i_num := 0_ ** intExpr(-2); 838 writeln(" ***** 0_ ** intExpr(-2) did not raise NUMERIC_ERROR"); 839 okay := FALSE; 840 exception 841 catch NUMERIC_ERROR: 842 incr(number); 843 end block; 844 845 block 846 i_num := bigIntExpr(0_) ** 0; 847 if i_num = 1_ then 848 incr(number); 849 else 850 writeln(" ***** bigIntExpr(0_) ** 0 did not deliver 1"); 851 okay := FALSE; 852 end if; 853 exception 854 catch NUMERIC_ERROR: 855 writeln(" ***** bigIntExpr(0_) ** 0 did raise NUMERIC_ERROR"); 856 okay := FALSE; 857 end block; 858 859 block 860 i_num := bigIntExpr(0_) ** (-2); 861 writeln(" ***** bigIntExpr(0_) ** (-2) did not raise NUMERIC_ERROR"); 862 okay := FALSE; 863 exception 864 catch NUMERIC_ERROR: 865 incr(number); 866 end block; 867 868 block 869 i_num := bigIntExpr(0_) ** intExpr(0); 870 if i_num = 1_ then 871 incr(number); 872 else 873 writeln(" ***** bigIntExpr(0_) ** intExpr(0) did not deliver 1"); 874 okay := FALSE; 875 end if; 876 exception 877 catch NUMERIC_ERROR: 878 writeln(" ***** bigIntExpr(0_) ** intExpr(0) did raise NUMERIC_ERROR"); 879 okay := FALSE; 880 end block; 881 882 block 883 i_num := bigIntExpr(0_) ** intExpr(-2); 884 writeln(" ***** bigIntExpr(0_) ** intExpr(-2) did not raise NUMERIC_ERROR"); 885 okay := FALSE; 886 exception 887 catch NUMERIC_ERROR: 888 incr(number); 889 end block; 890 891 block 892 i_num := 1_ ** (-2); 893 writeln(" ***** 1_ ** (-2) did not raise NUMERIC_ERROR"); 894 okay := FALSE; 895 exception 896 catch NUMERIC_ERROR: 897 incr(number); 898 end block; 899 900 block 901 i_num := 1_ ** intExpr(-2); 902 writeln(" ***** 1_ ** bigIntExpr(-2) did not raise NUMERIC_ERROR"); 903 okay := FALSE; 904 exception 905 catch NUMERIC_ERROR: 906 incr(number); 907 end block; 908 909 block 910 i_num := bigIntExpr(1_) ** (-2); 911 writeln(" ***** bigIntExpr(1_) ** (-2) did not raise NUMERIC_ERROR"); 912 okay := FALSE; 913 exception 914 catch NUMERIC_ERROR: 915 incr(number); 916 end block; 917 918 block 919 i_num := bigIntExpr(1_) ** intExpr(-2); 920 writeln(" ***** bigIntExpr(1_) ** intExpr(-2) did not raise NUMERIC_ERROR"); 921 okay := FALSE; 922 exception 923 catch NUMERIC_ERROR: 924 incr(number); 925 end block; 926 927 block 928 i_num := 2_ ** (-2); 929 writeln(" ***** 2_ ** (-2) did not raise NUMERIC_ERROR"); 930 okay := FALSE; 931 exception 932 catch NUMERIC_ERROR: 933 incr(number); 934 end block; 935 936 block 937 i_num := 2_ ** intExpr(-2); 938 writeln(" ***** 2_ ** intExpr(-2) did not raise NUMERIC_ERROR"); 939 okay := FALSE; 940 exception 941 catch NUMERIC_ERROR: 942 incr(number); 943 end block; 944 945 block 946 i_num := bigIntExpr(2_) ** (-2); 947 writeln(" ***** bigIntExpr(2_) ** (-2) did not raise NUMERIC_ERROR"); 948 okay := FALSE; 949 exception 950 catch NUMERIC_ERROR: 951 incr(number); 952 end block; 953 954 block 955 i_num := bigIntExpr(2_) ** intExpr(-2); 956 writeln(" ***** bigIntExpr(2_) ** intExpr(-2) did not raise NUMERIC_ERROR"); 957 okay := FALSE; 958 exception 959 catch NUMERIC_ERROR: 960 incr(number); 961 end block; 962 963 block 964 i_num := 3_ ** (-2); 965 writeln(" ***** 3_ ** (-2) did not raise NUMERIC_ERROR"); 966 okay := FALSE; 967 exception 968 catch NUMERIC_ERROR: 969 incr(number); 970 end block; 971 972 block 973 i_num := 3_ ** intExpr(-2); 974 writeln(" ***** 3_ ** intExpr(-2) did not raise NUMERIC_ERROR"); 975 okay := FALSE; 976 exception 977 catch NUMERIC_ERROR: 978 incr(number); 979 end block; 980 981 block 982 i_num := bigIntExpr(3_) ** (-2); 983 writeln(" ***** bigIntExpr(3_) ** (-2) did not raise NUMERIC_ERROR"); 984 okay := FALSE; 985 exception 986 catch NUMERIC_ERROR: 987 incr(number); 988 end block; 989 990 block 991 i_num := bigIntExpr(3_) ** intExpr(-2); 992 writeln(" ***** 3_ ** intExpr(-2) did not raise NUMERIC_ERROR"); 993 okay := FALSE; 994 exception 995 catch NUMERIC_ERROR: 996 incr(number); 997 end block; 998 999 block 1000 i_num := 4_ ** (-2); 1001 writeln(" ***** 4_ ** (-2) did not raise NUMERIC_ERROR"); 1002 okay := FALSE; 1003 exception 1004 catch NUMERIC_ERROR: 1005 incr(number); 1006 end block; 1007 1008 block 1009 i_num := 4_ ** intExpr(-2); 1010 writeln(" ***** 4_ ** intExpr(-2) did not raise NUMERIC_ERROR"); 1011 okay := FALSE; 1012 exception 1013 catch NUMERIC_ERROR: 1014 incr(number); 1015 end block; 1016 1017 block 1018 i_num := bigIntExpr(4_) ** (-2); 1019 writeln(" ***** bigIntExpr(4_) ** (-2) did not raise NUMERIC_ERROR"); 1020 okay := FALSE; 1021 exception 1022 catch NUMERIC_ERROR: 1023 incr(number); 1024 end block; 1025 1026 block 1027 i_num := bigIntExpr(4_) ** intExpr(-2); 1028 writeln(" ***** bigIntExpr(4_) ** intExpr(-2) did not raise NUMERIC_ERROR"); 1029 okay := FALSE; 1030 exception 1031 catch NUMERIC_ERROR: 1032 incr(number); 1033 end block; 1034 1035 block 1036 i_num := (-1_) ** (-2); 1037 writeln(" ***** (-1_) ** (-2) did not raise NUMERIC_ERROR"); 1038 okay := FALSE; 1039 exception 1040 catch NUMERIC_ERROR: 1041 incr(number); 1042 end block; 1043 1044 block 1045 i_num := (-1_) ** (-3); 1046 writeln(" ***** (-1_) ** (-3) did not raise NUMERIC_ERROR"); 1047 okay := FALSE; 1048 exception 1049 catch NUMERIC_ERROR: 1050 incr(number); 1051 end block; 1052 1053 block 1054 i_num := (-1_) ** intExpr(-2); 1055 writeln(" ***** (-1_) ** intExpr(-2) did not raise NUMERIC_ERROR"); 1056 okay := FALSE; 1057 exception 1058 catch NUMERIC_ERROR: 1059 incr(number); 1060 end block; 1061 1062 block 1063 i_num := (-1_) ** intExpr(-3); 1064 writeln(" ***** (-1_) ** intExpr(-3) did not raise NUMERIC_ERROR"); 1065 okay := FALSE; 1066 exception 1067 catch NUMERIC_ERROR: 1068 incr(number); 1069 end block; 1070 1071 block 1072 i_num := bigIntExpr(-1_) ** (-2); 1073 writeln(" ***** (-1_) ** (-2) did not raise NUMERIC_ERROR"); 1074 okay := FALSE; 1075 exception 1076 catch NUMERIC_ERROR: 1077 incr(number); 1078 end block; 1079 1080 block 1081 i_num := bigIntExpr(-1_) ** (-3); 1082 writeln(" ***** (-1_) ** (-3) did not raise NUMERIC_ERROR"); 1083 okay := FALSE; 1084 exception 1085 catch NUMERIC_ERROR: 1086 incr(number); 1087 end block; 1088 1089 block 1090 i_num := bigIntExpr(-1_) ** intExpr(-2); 1091 writeln(" ***** (-1_) ** intExpr(-2) did not raise NUMERIC_ERROR"); 1092 okay := FALSE; 1093 exception 1094 catch NUMERIC_ERROR: 1095 incr(number); 1096 end block; 1097 1098 block 1099 i_num := bigIntExpr(-1_) ** intExpr(-3); 1100 writeln(" ***** (-1_) ** intExpr(-3) did not raise NUMERIC_ERROR"); 1101 okay := FALSE; 1102 exception 1103 catch NUMERIC_ERROR: 1104 incr(number); 1105 end block; 1106 1107 if okay and number <> 32 then 1108 writeln(" ***** BigInteger exceptions for exponentiation do not work correct"); 1109 writeln; 1110 okay := FALSE; 1111 end if; 1112 end func; 1113 1114 1115const proc: check_bigInteger is func 1116 local 1117 var boolean: okay is TRUE; 1118 var integer: number is 0; 1119 var bigInteger: i_num is 0_; 1120 begin 1121 block 1122 i_num := 1_ div 0_; 1123 writeln(" ***** 1_ div 0_ did not raise NUMERIC_ERROR"); 1124 okay := FALSE; 1125 exception 1126 catch NUMERIC_ERROR: 1127 incr(number); 1128 end block; 1129 1130 block 1131 i_num := 1_ rem 0_; 1132 writeln(" ***** 1_ rem 0_ did not raise NUMERIC_ERROR"); 1133 okay := FALSE; 1134 exception 1135 catch NUMERIC_ERROR: 1136 incr(number); 1137 end block; 1138 1139 block 1140 i_num := 1_ mdiv 0_; 1141 writeln(" ***** 1_ mdiv 0_ did not raise NUMERIC_ERROR"); 1142 okay := FALSE; 1143 exception 1144 catch NUMERIC_ERROR: 1145 incr(number); 1146 end block; 1147 1148 block 1149 i_num := 1_ mod 0_; 1150 writeln(" ***** 1_ mod 0_ did not raise NUMERIC_ERROR"); 1151 okay := FALSE; 1152 exception 1153 catch NUMERIC_ERROR: 1154 incr(number); 1155 end block; 1156 1157 (* block 1158 i_num := ! (-1_); 1159 writeln(" ***** ! (-1_) did not raise NUMERIC_ERROR"); 1160 okay := FALSE; 1161 exception 1162 catch NUMERIC_ERROR: 1163 incr(number); 1164 end block; *) 1165 1166 block 1167 i_num := log2(-1_); 1168 writeln(" ***** log2(-1_) did not raise NUMERIC_ERROR"); 1169 okay := FALSE; 1170 exception 1171 catch NUMERIC_ERROR: 1172 incr(number); 1173 end block; 1174 1175 block 1176 i_num := bigInteger parse ""; 1177 writeln(" ***** bigInteger parse \"\" did not raise RANGE_ERROR"); 1178 okay := FALSE; 1179 exception 1180 catch RANGE_ERROR: 1181 incr(number); 1182 end block; 1183 1184 block 1185 i_num := bigInteger parse "123asdf"; 1186 writeln(" ***** bigInteger parse \"123asdf\" did not raise RANGE_ERROR"); 1187 okay := FALSE; 1188 exception 1189 catch RANGE_ERROR: 1190 incr(number); 1191 end block; 1192 1193 block 1194 i_num := bigInteger parse "asdf"; 1195 writeln(" ***** bigInteger parse \"asdf\" did not raise RANGE_ERROR"); 1196 okay := FALSE; 1197 exception 1198 catch RANGE_ERROR: 1199 incr(number); 1200 end block; 1201 1202 block 1203 i_num := rand(1_, 0_); 1204 writeln(" ***** rand(1_, 0_) did not raise RANGE_ERROR"); 1205 okay := FALSE; 1206 exception 1207 catch RANGE_ERROR: 1208 incr(number); 1209 end block; 1210 1211 block 1212 i_num := sqrt(-1_); 1213 writeln(" ***** sqrt(-1_) did not raise NUMERIC_ERROR"); 1214 okay := FALSE; 1215 exception 1216 catch NUMERIC_ERROR: 1217 incr(number); 1218 end block; 1219 1220 block 1221 block 1222 i_num := 1_ div 0_; 1223 writeln(" ***** 1_ div 0_ did not raise NUMERIC_ERROR"); 1224 okay := FALSE; 1225 exception 1226 catch NUMERIC_ERROR: 1227 incr(number); 1228 end block; 1229 exception 1230 catch NUMERIC_ERROR: 1231 writeln(" ***** NUMERIC_ERROR caught at wrong level"); 1232 end block; 1233 1234 block 1235 block 1236 i_num := 1_ div 0_; 1237 writeln(" ***** 1_ div 0_ did not raise NUMERIC_ERROR"); 1238 okay := FALSE; 1239 exception 1240 catch RANGE_ERROR: 1241 writeln(" ***** NUMERIC_ERROR caught at wrong level"); 1242 end block; 1243 exception 1244 catch NUMERIC_ERROR: 1245 incr(number); 1246 end block; 1247 1248 check_bigInteger_exponentiation(okay); 1249 1250 if okay and number = 12 then 1251 writeln("BigInteger exceptions work correct."); 1252 else 1253 writeln(" ***** BigInteger exceptions do not work correct"); 1254 writeln; 1255 end if; 1256 end func; 1257 1258 1259const proc: check_float is func 1260 local 1261 var boolean: okay is TRUE; 1262 var integer: number is 0; 1263 var float: f_num is 0.0; 1264 var integer: i_num is 0; 1265 begin 1266 block 1267 f_num := rand(1.0, 0.0); 1268 writeln(" ***** rand(1.0, 0.0) did not raise RANGE_ERROR"); 1269 okay := FALSE; 1270 exception 1271 catch RANGE_ERROR: 1272 incr(number); 1273 end block; 1274 1275 block 1276 f_num := sqrt(-1.0); 1277 if isNaN(f_num) then 1278 incr(number); 1279 else 1280 writeln(" ***** sqrt(-1.0) did not deliver NaN"); 1281 okay := FALSE; 1282 end if; 1283 exception 1284 catch NUMERIC_ERROR: 1285 writeln(" ***** sqrt(-1.0) raises NUMERIC_ERROR"); 1286 okay := FALSE; 1287 end block; 1288 1289(* 1290 block 1291 i_num := trunc(1.0E37); 1292 writeln(" ***** trunc(1.0E37) returned " <& i_num); 1293 exception 1294 catch NUMERIC_ERROR: 1295 writeln(" ***** trunc(1.0E37) raised NUMERIC_ERROR"); 1296 end block; 1297*) 1298 1299 block 1300 f_num := 1.0 / 0.0; 1301 if f_num = Infinity then 1302 incr(number); 1303 else 1304 writeln(" ***** 1.0 / 0.0 did not deliver Infinity"); 1305 okay := FALSE; 1306 end if; 1307 exception 1308 catch NUMERIC_ERROR: 1309 writeln(" ***** 1.0 / 0.0 raises NUMERIC_ERROR"); 1310 okay := FALSE; 1311 end block; 1312 1313 block 1314 f_num := 1.0 / -0.0; 1315 if f_num = -Infinity then 1316 incr(number); 1317 else 1318 writeln(" ***** 1.0 / -0.0 did not deliver -Infinity"); 1319 okay := FALSE; 1320 end if; 1321 exception 1322 catch NUMERIC_ERROR: 1323 writeln(" ***** 1.0 / -0.0 raises NUMERIC_ERROR"); 1324 okay := FALSE; 1325 end block; 1326 1327 block 1328 f_num := -1.0 / 0.0; 1329 if f_num = -Infinity then 1330 incr(number); 1331 else 1332 writeln(" ***** -1.0 / 0.0 did not deliver -Infinity"); 1333 okay := FALSE; 1334 end if; 1335 exception 1336 catch NUMERIC_ERROR: 1337 writeln(" ***** -1.0 / 0.0 raises NUMERIC_ERROR"); 1338 okay := FALSE; 1339 end block; 1340 1341 block 1342 f_num := -1.0 / -0.0; 1343 if f_num = Infinity then 1344 incr(number); 1345 else 1346 writeln(" ***** -1.0 / -0.0 did not deliver Infinity"); 1347 okay := FALSE; 1348 end if; 1349 exception 1350 catch NUMERIC_ERROR: 1351 writeln(" ***** -1.0 / -0.0 raises NUMERIC_ERROR"); 1352 okay := FALSE; 1353 end block; 1354 1355 block 1356 f_num := 0.0 / 0.0; 1357 if isNaN(f_num) then 1358 incr(number); 1359 else 1360 writeln(" ***** 0.0 / 0.0 did not deliver NaN"); 1361 okay := FALSE; 1362 end if; 1363 exception 1364 catch NUMERIC_ERROR: 1365 writeln(" ***** 0.0 / 0.0 raises NUMERIC_ERROR"); 1366 okay := FALSE; 1367 end block; 1368 1369 block 1370 f_num := 0.0 / -0.0; 1371 if isNaN(f_num) then 1372 incr(number); 1373 else 1374 writeln(" ***** 0.0 / -0.0 did not deliver NaN"); 1375 okay := FALSE; 1376 end if; 1377 exception 1378 catch NUMERIC_ERROR: 1379 writeln(" ***** 0.0 / -0.0 raises NUMERIC_ERROR"); 1380 okay := FALSE; 1381 end block; 1382 1383 block 1384 f_num := -0.0 / 0.0; 1385 if isNaN(f_num) then 1386 incr(number); 1387 else 1388 writeln(" ***** -0.0 / 0.0 did not deliver NaN"); 1389 okay := FALSE; 1390 end if; 1391 exception 1392 catch NUMERIC_ERROR: 1393 writeln(" ***** -0.0 / 0.0 raises NUMERIC_ERROR"); 1394 okay := FALSE; 1395 end block; 1396 1397 block 1398 f_num := -0.0 / -0.0; 1399 if isNaN(f_num) then 1400 incr(number); 1401 else 1402 writeln(" ***** -0.0 / -0.0 did not deliver NaN"); 1403 okay := FALSE; 1404 end if; 1405 exception 1406 catch NUMERIC_ERROR: 1407 writeln(" ***** -0.0 / -0.0 raises NUMERIC_ERROR"); 1408 okay := FALSE; 1409 end block; 1410 1411 block 1412 f_num := 0.0 ** (-2); 1413 if f_num = Infinity then 1414 incr(number); 1415 else 1416 writeln(" ***** 0.0 ** (-2) did not deliver Infinity"); 1417 writeln(f_num); 1418 okay := FALSE; 1419 end if; 1420 exception 1421 catch NUMERIC_ERROR: 1422 writeln(" ***** 0.0 ** (-2) did raise NUMERIC_ERROR"); 1423 okay := FALSE; 1424 end block; 1425 1426 block 1427 f_num := 0.0 ** 0.0; 1428 if f_num = 1.0 then 1429 incr(number); 1430 else 1431 writeln(" ***** 0.0 ** 0.0 did not deliver 1.0"); 1432 writeln(f_num); 1433 okay := FALSE; 1434 end if; 1435 exception 1436 catch NUMERIC_ERROR: 1437 writeln(" ***** 0.0 ** 0.0 did raise NUMERIC_ERROR"); 1438 okay := FALSE; 1439 end block; 1440 1441 block 1442 f_num := 0.0 ** (-1.0); 1443 if f_num = Infinity then 1444 incr(number); 1445 else 1446 writeln(" ***** 0.0 ** (-1.0) did not deliver Infinity"); 1447 okay := FALSE; 1448 end if; 1449 exception 1450 catch NUMERIC_ERROR: 1451 writeln(" ***** 0.0 ** (-1.0) did raise NUMERIC_ERROR"); 1452 okay := FALSE; 1453 end block; 1454 1455 block 1456 f_num := (-2.0) ** 0.5; 1457 incr(number); 1458 exception 1459 catch NUMERIC_ERROR: 1460 writeln(" ***** (-2.0) ** 0.5 did raise NUMERIC_ERROR"); 1461 okay := FALSE; 1462 end block; 1463 1464 if okay and number = 14 then 1465 writeln("Floating point exceptions work correct."); 1466 else 1467 writeln(" ***** Floating point exceptions do not work correct"); 1468 writeln; 1469 end if; 1470 end func; 1471 1472 1473const proc: check_string is func 1474 local 1475 var boolean: okay is TRUE; 1476 var integer: number is 0; 1477 var integer: i_num is 0; 1478 var string: stri is ""; 1479 var char: ch is ' '; 1480 begin 1481 block 1482 ch := "asdf"[-1]; 1483 writeln(" ***** \"asdf\"[-1] did not raise INDEX_ERROR"); 1484 okay := FALSE; 1485 exception 1486 catch INDEX_ERROR: 1487 incr(number); 1488 end block; 1489 1490 block 1491 ch := "asdf"[0]; 1492 writeln(" ***** \"asdf\"[0] did not raise INDEX_ERROR"); 1493 okay := FALSE; 1494 exception 1495 catch INDEX_ERROR: 1496 incr(number); 1497 end block; 1498 1499 block 1500 ch := "asdf"[1]; 1501 incr(number); 1502 exception 1503 catch INDEX_ERROR: 1504 writeln(" ***** \"asdf\"[1] did raise INDEX_ERROR"); 1505 okay := FALSE; 1506 end block; 1507 1508 block 1509 ch := "asdf"[4]; 1510 incr(number); 1511 exception 1512 catch INDEX_ERROR: 1513 writeln(" ***** \"asdf\"[4] did raise INDEX_ERROR"); 1514 okay := FALSE; 1515 end block; 1516 1517 block 1518 ch := "asdf"[5]; 1519 writeln(" ***** \"asdf\"[5] did not raise INDEX_ERROR"); 1520 okay := FALSE; 1521 exception 1522 catch INDEX_ERROR: 1523 incr(number); 1524 end block; 1525 1526 block 1527 ch := "asdf"[6]; 1528 writeln(" ***** \"asdf\"[6] did not raise INDEX_ERROR"); 1529 okay := FALSE; 1530 exception 1531 catch INDEX_ERROR: 1532 incr(number); 1533 end block; 1534 1535 block 1536 stri := "asdf"; 1537 stri @:= [-1] 'x'; 1538 writeln(" ***** stri @:= [-1] 'x'; did not raise INDEX_ERROR"); 1539 okay := FALSE; 1540 exception 1541 catch INDEX_ERROR: 1542 incr(number); 1543 end block; 1544 1545 block 1546 stri := "asdf"; 1547 stri @:= [0] 'x'; 1548 writeln(" ***** stri @:= [0] 'x'; did not raise INDEX_ERROR"); 1549 okay := FALSE; 1550 exception 1551 catch INDEX_ERROR: 1552 incr(number); 1553 end block; 1554 1555 block 1556 stri := "asdf"; 1557 stri @:= [1] 'x'; 1558 incr(number); 1559 exception 1560 catch INDEX_ERROR: 1561 writeln(" ***** stri @:= [1] 'x'; did raise INDEX_ERROR"); 1562 okay := FALSE; 1563 end block; 1564 1565 block 1566 stri := "asdf"; 1567 stri @:= [4] 'x'; 1568 incr(number); 1569 exception 1570 catch INDEX_ERROR: 1571 writeln(" ***** stri @:= [4] 'x'; did raise INDEX_ERROR"); 1572 okay := FALSE; 1573 end block; 1574 1575 block 1576 stri := "asdf"; 1577 stri @:= [5] 'x'; 1578 writeln(" ***** stri @:= [5] 'x'; did not raise INDEX_ERROR"); 1579 okay := FALSE; 1580 exception 1581 catch INDEX_ERROR: 1582 incr(number); 1583 end block; 1584 1585 block 1586 stri := "asdf"; 1587 stri @:= [6] 'x'; 1588 writeln(" ***** stri @:= [6] 'x'; did not raise INDEX_ERROR"); 1589 okay := FALSE; 1590 exception 1591 catch INDEX_ERROR: 1592 incr(number); 1593 end block; 1594 1595 block 1596 stri := "asdf"; 1597 i_num := -1; 1598 stri @:= [i_num] 'x'; 1599 writeln(" ***** stri @:= [-1] 'x'; did not raise INDEX_ERROR"); 1600 okay := FALSE; 1601 exception 1602 catch INDEX_ERROR: 1603 incr(number); 1604 end block; 1605 1606 block 1607 stri := "asdf"; 1608 i_num := 0; 1609 stri @:= [i_num] 'x'; 1610 writeln(" ***** stri @:= [0] 'x'; did not raise INDEX_ERROR"); 1611 okay := FALSE; 1612 exception 1613 catch INDEX_ERROR: 1614 incr(number); 1615 end block; 1616 1617 block 1618 stri := "asdf"; 1619 i_num := 1; 1620 stri @:= [i_num] 'x'; 1621 incr(number); 1622 exception 1623 catch INDEX_ERROR: 1624 writeln(" ***** stri @:= [1] 'x'; did raise INDEX_ERROR"); 1625 okay := FALSE; 1626 end block; 1627 1628 block 1629 stri := "asdf"; 1630 i_num := 4; 1631 stri @:= [i_num] 'x'; 1632 incr(number); 1633 exception 1634 catch INDEX_ERROR: 1635 writeln(" ***** stri @:= [4] 'x'; did raise INDEX_ERROR"); 1636 okay := FALSE; 1637 end block; 1638 1639 block 1640 stri := "asdf"; 1641 i_num := 5; 1642 stri @:= [i_num] 'x'; 1643 writeln(" ***** stri @:= [5] 'x'; did not raise INDEX_ERROR"); 1644 okay := FALSE; 1645 exception 1646 catch INDEX_ERROR: 1647 incr(number); 1648 end block; 1649 1650 block 1651 stri := "asdf"; 1652 i_num := 6; 1653 stri @:= [i_num] 'x'; 1654 writeln(" ***** stri @:= [6] 'x'; did not raise INDEX_ERROR"); 1655 okay := FALSE; 1656 exception 1657 catch INDEX_ERROR: 1658 incr(number); 1659 end block; 1660 1661 block 1662 stri := "asdf" mult -1; 1663 writeln(" ***** \"asdf\" mult -1 did not raise RANGE_ERROR"); 1664 okay := FALSE; 1665 exception 1666 catch RANGE_ERROR: 1667 incr(number); 1668 end block; 1669(* 1670 block 1671 stri := "a" mult 1048576; 1672 stri := stri mult 16384; 1673 stri := stri mult 1048576; 1674 stri := stri mult 64; 1675 stri := stri mult 64; 1676 writeln(" ***** string mult does not raise MEMORY_ERROR"); 1677 okay := FALSE; 1678 exception 1679 catch MEMORY_ERROR: 1680 incr(number); 1681 end block; 1682*) 1683 block 1684 i_num := pos("asdf", "df", -1); 1685 writeln(" ***** pos(\"asdf\", \"df\", -1) did not raise RANGE_ERROR"); 1686 okay := FALSE; 1687 exception 1688 catch RANGE_ERROR: 1689 incr(number); 1690 end block; 1691 1692 block 1693 stri := str('\99999;'); 1694 incr(number); 1695 exception 1696 catch RANGE_ERROR: writeln(" ***** str('\\99999;') raises RANGE_ERROR"); 1697 okay := FALSE; 1698 end block; 1699 1700 if okay and number = 21 then 1701 writeln("String exceptions work correct."); 1702 else 1703 writeln(" ***** String exceptions do not work correct"); 1704 writeln; 1705 end if; 1706 end func; 1707 1708 1709const proc: check_array is func 1710 local 1711 var boolean: okay is TRUE; 1712 var integer: number is 0; 1713 var integer: index is 0; 1714 var integer: i_num is 0; 1715 var array integer: arr is 0 times 1; 1716 const array integer: constantArray is 4 times 1; 1717 begin 1718 block 1719 i_num := constantArray[-1]; 1720 writeln(" ***** constantArray[-1] did not raise INDEX_ERROR"); 1721 okay := FALSE; 1722 exception 1723 catch INDEX_ERROR: 1724 incr(number); 1725 end block; 1726 1727 block 1728 i_num := constantArray[0]; 1729 writeln(" ***** constantArray[0] did not raise INDEX_ERROR"); 1730 okay := FALSE; 1731 exception 1732 catch INDEX_ERROR: 1733 incr(number); 1734 end block; 1735 1736 block 1737 i_num := constantArray[1]; 1738 incr(number); 1739 exception 1740 catch INDEX_ERROR: 1741 writeln(" ***** constantArray[1] did raise INDEX_ERROR"); 1742 okay := FALSE; 1743 end block; 1744 1745 block 1746 i_num := constantArray[4]; 1747 incr(number); 1748 exception 1749 catch INDEX_ERROR: 1750 writeln(" ***** constantArray[4] did raise INDEX_ERROR"); 1751 okay := FALSE; 1752 end block; 1753 1754 block 1755 i_num := constantArray[5]; 1756 writeln(" ***** constantArray[5] did not raise INDEX_ERROR"); 1757 okay := FALSE; 1758 exception 1759 catch INDEX_ERROR: 1760 incr(number); 1761 end block; 1762 1763 block 1764 i_num := constantArray[6]; 1765 writeln(" ***** constantArray[6] did not raise INDEX_ERROR"); 1766 okay := FALSE; 1767 exception 1768 catch INDEX_ERROR: 1769 incr(number); 1770 end block; 1771 1772 block 1773 index := -1; 1774 i_num := constantArray[index]; 1775 writeln(" ***** constantArray[index] for -1 did not raise INDEX_ERROR"); 1776 okay := FALSE; 1777 exception 1778 catch INDEX_ERROR: 1779 incr(number); 1780 end block; 1781 1782 block 1783 index := 0; 1784 i_num := constantArray[index]; 1785 writeln(" ***** constantArray[index] for 0 did not raise INDEX_ERROR"); 1786 okay := FALSE; 1787 exception 1788 catch INDEX_ERROR: 1789 incr(number); 1790 end block; 1791 1792 block 1793 index := 1; 1794 i_num := constantArray[index]; 1795 incr(number); 1796 exception 1797 catch INDEX_ERROR: 1798 writeln(" ***** constantArray[index] for 1 did raise INDEX_ERROR"); 1799 okay := FALSE; 1800 end block; 1801 1802 block 1803 index := 4; 1804 i_num := constantArray[index]; 1805 incr(number); 1806 exception 1807 catch INDEX_ERROR: 1808 writeln(" ***** constantArray[index] for 4 did raise INDEX_ERROR"); 1809 okay := FALSE; 1810 end block; 1811 1812 block 1813 index := 5; 1814 i_num := constantArray[index]; 1815 writeln(" ***** constantArray[index] for 5 did not raise INDEX_ERROR"); 1816 okay := FALSE; 1817 exception 1818 catch INDEX_ERROR: 1819 incr(number); 1820 end block; 1821 1822 block 1823 index := 6; 1824 i_num := constantArray[index]; 1825 writeln(" ***** constantArray[index] for 6 did not raise INDEX_ERROR"); 1826 okay := FALSE; 1827 exception 1828 catch INDEX_ERROR: 1829 incr(number); 1830 end block; 1831 1832 block 1833 i_num := (4 times 1)[-1]; 1834 writeln(" ***** (4 times 1)[-1] did not raise INDEX_ERROR"); 1835 okay := FALSE; 1836 exception 1837 catch INDEX_ERROR: 1838 incr(number); 1839 end block; 1840 1841 block 1842 i_num := (4 times 1)[0]; 1843 writeln(" ***** (4 times 1)[0] did not raise INDEX_ERROR"); 1844 okay := FALSE; 1845 exception 1846 catch INDEX_ERROR: 1847 incr(number); 1848 end block; 1849 1850 block 1851 i_num := (4 times 1)[1]; 1852 incr(number); 1853 exception 1854 catch INDEX_ERROR: 1855 writeln(" ***** (4 times 1)[1] did raise INDEX_ERROR"); 1856 okay := FALSE; 1857 end block; 1858 1859 block 1860 i_num := (4 times 1)[4]; 1861 incr(number); 1862 exception 1863 catch INDEX_ERROR: 1864 writeln(" ***** (4 times 1)[4] did raise INDEX_ERROR"); 1865 okay := FALSE; 1866 end block; 1867 1868 block 1869 i_num := (4 times 1)[5]; 1870 writeln(" ***** (4 times 1)[5] did not raise INDEX_ERROR"); 1871 okay := FALSE; 1872 exception 1873 catch INDEX_ERROR: 1874 incr(number); 1875 end block; 1876 1877 block 1878 i_num := (4 times 1)[6]; 1879 writeln(" ***** (4 times 1)[6] did not raise INDEX_ERROR"); 1880 okay := FALSE; 1881 exception 1882 catch INDEX_ERROR: 1883 incr(number); 1884 end block; 1885 1886 block 1887 arr := 4 times 1; 1888 arr[-1] := 2; 1889 writeln(" ***** arr[-1] := 2; did not raise INDEX_ERROR"); 1890 okay := FALSE; 1891 exception 1892 catch INDEX_ERROR: 1893 incr(number); 1894 end block; 1895 1896 block 1897 arr := 4 times 1; 1898 arr[0] := 2; 1899 writeln(" ***** arr[0] := 2; did not raise INDEX_ERROR"); 1900 okay := FALSE; 1901 exception 1902 catch INDEX_ERROR: 1903 incr(number); 1904 end block; 1905 1906 block 1907 arr := 4 times 1; 1908 arr[1] := 2; 1909 incr(number); 1910 exception 1911 catch INDEX_ERROR: 1912 writeln(" ***** arr[1] := 2; did raise INDEX_ERROR"); 1913 okay := FALSE; 1914 end block; 1915 1916 block 1917 arr := 4 times 1; 1918 arr[4] := 2; 1919 incr(number); 1920 exception 1921 catch INDEX_ERROR: 1922 writeln(" ***** arr[4] := 2; did raise INDEX_ERROR"); 1923 okay := FALSE; 1924 end block; 1925 1926 block 1927 arr := 4 times 1; 1928 arr[5] := 2; 1929 writeln(" ***** arr[5] := 2; did not raise INDEX_ERROR"); 1930 okay := FALSE; 1931 exception 1932 catch INDEX_ERROR: 1933 incr(number); 1934 end block; 1935 1936 block 1937 arr := 4 times 1; 1938 arr[6] := 2; 1939 writeln(" ***** arr[6] := 2; did not raise INDEX_ERROR"); 1940 okay := FALSE; 1941 exception 1942 catch INDEX_ERROR: 1943 incr(number); 1944 end block; 1945 1946 block 1947 arr := 4 times 1; 1948 i_num := remove(arr, -1); 1949 writeln(" ***** remove(arr, -1); did not raise INDEX_ERROR"); 1950 okay := FALSE; 1951 exception 1952 catch INDEX_ERROR: 1953 incr(number); 1954 end block; 1955 1956 block 1957 arr := 4 times 1; 1958 i_num := remove(arr, 0); 1959 writeln(" ***** remove(arr, 0); did not raise INDEX_ERROR"); 1960 okay := FALSE; 1961 exception 1962 catch INDEX_ERROR: 1963 incr(number); 1964 end block; 1965 1966 block 1967 arr := 4 times 1; 1968 i_num := remove(arr, 1); 1969 incr(number); 1970 exception 1971 catch INDEX_ERROR: 1972 writeln(" ***** remove(arr, 1); did raise INDEX_ERROR"); 1973 okay := FALSE; 1974 end block; 1975 1976 block 1977 arr := 4 times 1; 1978 i_num := remove(arr, 4); 1979 incr(number); 1980 exception 1981 catch INDEX_ERROR: 1982 writeln(" ***** remove(arr, 4); did raise INDEX_ERROR"); 1983 okay := FALSE; 1984 end block; 1985 1986 block 1987 arr := 4 times 1; 1988 i_num := remove(arr, 5); 1989 writeln(" ***** remove(arr, 5); did not raise INDEX_ERROR"); 1990 okay := FALSE; 1991 exception 1992 catch INDEX_ERROR: 1993 incr(number); 1994 end block; 1995 1996 block 1997 arr := 4 times 1; 1998 i_num := remove(arr, 6); 1999 writeln(" ***** remove(arr, 6); did not raise INDEX_ERROR"); 2000 okay := FALSE; 2001 exception 2002 catch INDEX_ERROR: 2003 incr(number); 2004 end block; 2005 2006 block 2007 arr := -1 times 1; 2008 writeln(" ***** -1 times 1 did not raise RANGE_ERROR"); 2009 okay := FALSE; 2010 exception 2011 catch RANGE_ERROR: 2012 incr(number); 2013 end block; 2014 2015 if okay and number = 31 then 2016 writeln("Array exceptions work correct."); 2017 else 2018 writeln(" ***** Array exceptions do not work correct"); 2019 writeln; 2020 end if; 2021 end func; 2022 2023 2024const proc: check_file is func 2025 local 2026 var boolean: okay is TRUE; 2027 var integer: number is 0; 2028 var integer: i_num is 0; 2029 var string: test_file_name is ""; 2030 var string: test_file_name8 is ""; 2031 var file: aFile is STD_NULL; 2032 var string: stri is ""; 2033 var integer: file_pos is 0; 2034 var bigInteger: big_file_pos is 0_; 2035 begin 2036 block 2037 i_num := length(STD_NULL); 2038 writeln(" ***** length(STD_NULL) succeeded"); 2039 okay := FALSE; 2040 exception 2041 catch FILE_ERROR: 2042 incr(number); 2043 end block; 2044 block 2045 i_num := tell(STD_NULL); 2046 writeln(" ***** tell(STD_NULL) succeeded"); 2047 okay := FALSE; 2048 exception 2049 catch FILE_ERROR: 2050 incr(number); 2051 end block; 2052 block 2053 seek(STD_NULL, 1); 2054 writeln(" ***** seek(STD_NULL, 1) succeeded"); 2055 okay := FALSE; 2056 exception 2057 catch FILE_ERROR: 2058 incr(number); 2059 end block; 2060 2061 block 2062 i_num := length(aFile); 2063 writeln(" ***** length for STD_NULL succeeded"); 2064 okay := FALSE; 2065 exception 2066 catch FILE_ERROR: 2067 incr(number); 2068 end block; 2069 block 2070 i_num := tell(aFile); 2071 writeln(" ***** tell for STD_NULL succeeded"); 2072 okay := FALSE; 2073 exception 2074 catch FILE_ERROR: 2075 incr(number); 2076 end block; 2077 block 2078 seek(aFile, 1); 2079 writeln(" ***** seek for STD_NULL succeeded"); 2080 okay := FALSE; 2081 exception 2082 catch FILE_ERROR: 2083 incr(number); 2084 end block; 2085 2086 repeat 2087 test_file_name := homeDir <& "/tmp_test_file_" <& rand(0, 999) lpad0 3; 2088 until fileType(test_file_name) = FILE_ABSENT; 2089 repeat 2090 test_file_name8 := homeDir <& "/tmp_test_file8_" <& rand(0, 999) lpad0 3; 2091 until fileType(test_file_name8) = FILE_ABSENT; 2092 2093 aFile := open(test_file_name, "w"); 2094 if aFile = STD_NULL then 2095 writeln(" ***** Failed to open file"); 2096 else 2097 block 2098 stri := gets(aFile, 0); 2099 incr(number); 2100 exception 2101 catch FILE_ERROR: 2102 writeln(" ***** gets(aFile, 0) from write only file fails"); 2103 okay := FALSE; 2104 end block; 2105 block 2106 stri := gets(aFile, 10); 2107 writeln(" ***** gets from write only file succeeded"); 2108 okay := FALSE; 2109 exception 2110 catch FILE_ERROR: 2111 incr(number); 2112 end block; 2113 block 2114 stri := gets(aFile, 2000000); 2115 writeln(" ***** gets from write only file succeeded"); 2116 okay := FALSE; 2117 exception 2118 catch FILE_ERROR: 2119 incr(number); 2120 end block; 2121 block 2122 stri := getln(aFile); 2123 writeln(" ***** getln from write only file succeeded"); 2124 okay := FALSE; 2125 exception 2126 catch FILE_ERROR: 2127 incr(number); 2128 end block; 2129 block 2130 stri := getwd(aFile); 2131 writeln(" ***** getwd from write only file succeeded"); 2132 okay := FALSE; 2133 exception 2134 catch FILE_ERROR: 2135 incr(number); 2136 end block; 2137 close(aFile); 2138 end if; 2139 2140 aFile := openUtf8(test_file_name8, "w"); 2141 if aFile = STD_NULL then 2142 writeln(" ***** Failed to open UTF-8 file"); 2143 else 2144 block 2145 stri := gets(aFile, 0); 2146 incr(number); 2147 exception 2148 catch FILE_ERROR: 2149 writeln(" ***** gets(aFile, 0) from UTF-8 write only file fails"); 2150 okay := FALSE; 2151 end block; 2152 block 2153 stri := gets(aFile, 10); 2154 writeln(" ***** gets from UTF-8 write only file succeeded"); 2155 okay := FALSE; 2156 exception 2157 catch FILE_ERROR: 2158 incr(number); 2159 end block; 2160 block 2161 stri := gets(aFile, 2000000); 2162 writeln(" ***** gets from UTF-8 write only file succeeded"); 2163 okay := FALSE; 2164 exception 2165 catch FILE_ERROR: 2166 incr(number); 2167 end block; 2168 block 2169 stri := getln(aFile); 2170 writeln(" ***** getln from UTF-8 write only file succeeded"); 2171 okay := FALSE; 2172 exception 2173 catch FILE_ERROR: 2174 incr(number); 2175 end block; 2176 block 2177 stri := getwd(aFile); 2178 writeln(" ***** getwd from UTF-8 write only file succeeded"); 2179 okay := FALSE; 2180 exception 2181 catch FILE_ERROR: 2182 incr(number); 2183 end block; 2184 close(aFile); 2185 end if; 2186 2187 aFile := open(test_file_name, "w"); 2188 if aFile = STD_NULL then 2189 writeln(" ***** Failed to open file"); 2190 else 2191 writeln(aFile, "asdf"); 2192 close(aFile); 2193 end if; 2194 aFile := open(test_file_name, "r"); 2195 if aFile = STD_NULL then 2196 writeln(" ***** Failed to open file"); 2197 else 2198 block 2199 write(aFile, ""); 2200 incr(number); 2201 exception 2202 catch FILE_ERROR: 2203 writeln(" ***** writing \"\" to read only file fails"); 2204 okay := FALSE; 2205 end block; 2206 block 2207 write(aFile, "qwert"); 2208 writeln(" ***** write to read only file succeeded"); 2209 okay := FALSE; 2210 exception 2211 catch FILE_ERROR: 2212 incr(number); 2213 end block; 2214 block 2215 close(aFile); 2216 incr(number); 2217 exception 2218 catch FILE_ERROR: 2219 writeln(" ***** closing a read only file fails"); 2220 okay := FALSE; 2221 end block; 2222 end if; 2223 2224 aFile := openUtf8(test_file_name, "r"); 2225 if aFile = STD_NULL then 2226 writeln(" ***** Failed to open file"); 2227 else 2228 block 2229 write(aFile, ""); 2230 incr(number); 2231 exception 2232 catch FILE_ERROR: 2233 writeln(" ***** writing \"\" to UTF-8 read only file fails"); 2234 okay := FALSE; 2235 end block; 2236 block 2237 write(aFile, "qwert"); 2238 writeln(" ***** write to UTF-8 read only file succeeded"); 2239 okay := FALSE; 2240 exception 2241 catch FILE_ERROR: 2242 incr(number); 2243 end block; 2244 block 2245 close(aFile); 2246 incr(number); 2247 exception 2248 catch FILE_ERROR: 2249 writeln(" ***** closing an UTF-8 read only file fails"); 2250 okay := FALSE; 2251 end block; 2252 end if; 2253 2254 if fileType("./s7") = FILE_REGULAR then 2255 aFile := popen("./s7", "r"); 2256 else 2257 aFile := popen("s7", "r"); 2258 end if; 2259 if aFile = STD_NULL then 2260 writeln(" ***** Failed to popen pipe"); 2261 else 2262 block 2263 file_pos := length(aFile); 2264 writeln(" ***** length for pipe succeeded"); 2265 okay := FALSE; 2266 exception 2267 catch FILE_ERROR: 2268 incr(number); 2269 end block; 2270 block 2271 big_file_pos := bigLength(aFile); 2272 writeln(" ***** bigLength for pipe succeeded"); 2273 okay := FALSE; 2274 exception 2275 catch FILE_ERROR: 2276 incr(number); 2277 end block; 2278 block 2279 seek(aFile, 123); 2280 writeln(" ***** seek for pipe succeeded"); 2281 okay := FALSE; 2282 exception 2283 catch FILE_ERROR: 2284 incr(number); 2285 end block; 2286 block 2287 seek(aFile, 123_); 2288 writeln(" ***** seek for pipe succeeded"); 2289 okay := FALSE; 2290 exception 2291 catch FILE_ERROR: 2292 incr(number); 2293 end block; 2294 block 2295 file_pos := tell(aFile); 2296 writeln(" ***** tell for pipe succeeded"); 2297 okay := FALSE; 2298 exception 2299 catch FILE_ERROR: 2300 incr(number); 2301 end block; 2302 block 2303 big_file_pos := bigTell(aFile); 2304 writeln(" ***** bigTell for pipe succeeded"); 2305 okay := FALSE; 2306 exception 2307 catch FILE_ERROR: 2308 incr(number); 2309 end block; 2310 ignore(gets(aFile, 1)); # Necessary to avoid a SIGPIPE in the executed process 2311 close(aFile); 2312 end if; 2313 2314 if fileType("./s7") = FILE_REGULAR then 2315 aFile := popen8("./s7", "r"); 2316 else 2317 aFile := popen8("s7", "r"); 2318 end if; 2319 if aFile = STD_NULL then 2320 writeln(" ***** Failed to popen pipe"); 2321 else 2322 block 2323 file_pos := length(aFile); 2324 writeln(" ***** length for pipe succeeded"); 2325 okay := FALSE; 2326 exception 2327 catch FILE_ERROR: 2328 incr(number); 2329 end block; 2330 block 2331 big_file_pos := bigLength(aFile); 2332 writeln(" ***** bigLength for pipe succeeded"); 2333 okay := FALSE; 2334 exception 2335 catch FILE_ERROR: 2336 incr(number); 2337 end block; 2338 block 2339 seek(aFile, 123); 2340 writeln(" ***** seek for pipe succeeded"); 2341 okay := FALSE; 2342 exception 2343 catch FILE_ERROR: 2344 incr(number); 2345 end block; 2346 block 2347 seek(aFile, 123_); 2348 writeln(" ***** seek for pipe succeeded"); 2349 okay := FALSE; 2350 exception 2351 catch FILE_ERROR: 2352 incr(number); 2353 end block; 2354 block 2355 file_pos := tell(aFile); 2356 writeln(" ***** tell for pipe succeeded"); 2357 okay := FALSE; 2358 exception 2359 catch FILE_ERROR: 2360 incr(number); 2361 end block; 2362 block 2363 big_file_pos := bigTell(aFile); 2364 writeln(" ***** bigTell for pipe succeeded"); 2365 okay := FALSE; 2366 exception 2367 catch FILE_ERROR: 2368 incr(number); 2369 end block; 2370 ignore(gets(aFile, 1)); # Necessary to avoid a SIGPIPE in the executed process 2371 close(aFile); 2372 end if; 2373 2374 block 2375 removeFile(test_file_name); 2376 removeFile(test_file_name8); 2377 incr(number); 2378 exception 2379 catch FILE_ERROR: 2380 writeln(" ***** removeFile fails"); 2381 okay := FALSE; 2382 end block; 2383 2384 if okay and number = 35 then 2385 writeln("File exceptions work correct."); 2386 else 2387 writeln(" ***** File exceptions do not work correct"); 2388 writeln; 2389 end if; 2390 end func; 2391 2392 2393const proc: main is func 2394 local 2395 var string: stri is ""; 2396 var boolean: bool is FALSE; 2397 var integer: number is 0; 2398 var reference: obj is NIL; 2399 begin 2400 # f4(6); 2401 writeln; 2402 check_integer; 2403 check_bigInteger; 2404 check_float; 2405 check_string; 2406 check_array; 2407 check_file; 2408 2409(* 2410 block 2411 obj := ref_list.EMPTY[0]; 2412 writeln(" ***** ref_list.EMPTY[0] did not raise INDEX_ERROR"); 2413 exception 2414 catch INDEX_ERROR: writeln("ref_list.EMPTY[0] raises INDEX_ERROR"); 2415 end block; 2416 2417 block 2418 obj := ref_list.EMPTY[1]; 2419 writeln(" ***** ref_list.EMPTY[1] did not raise INDEX_ERROR"); 2420 exception 2421 catch INDEX_ERROR: writeln("ref_list.EMPTY[1] raises INDEX_ERROR"); 2422 end block; 2423 2424 block 2425 ignore(action "asdf"); 2426 writeln(" ***** action \"asdf\" did not raise RANGE_ERROR"); 2427 exception 2428 catch RANGE_ERROR: writeln("action \"asdf\" raises RANGE_ERROR"); 2429 end block; 2430*) 2431 2432 block 2433 seek(STD_IN, 0); 2434 writeln(" ***** seek(STD_IN, 0) did not raise RANGE_ERROR"); 2435 exception 2436 catch RANGE_ERROR: writeln("seek(STD_IN, 0) raises RANGE_ERROR"); 2437 end block; 2438 2439 block 2440 stri := gets(STD_IN, -1); 2441 writeln(" ***** gets(STD_IN, -1) did not raise RANGE_ERROR"); 2442 exception 2443 catch RANGE_ERROR: writeln("gets(STD_IN, -1) raises RANGE_ERROR"); 2444 end block; 2445 2446 block 2447 number := test_func(1 div 0); 2448 writeln(" ***** test_func(1 div 0) did not raise NUMERIC_ERROR"); 2449 exception 2450 catch NUMERIC_ERROR: writeln("test_func(1 div 0) raises NUMERIC_ERROR"); 2451 catch RANGE_ERROR: writeln("test_func(1 div 0) raises RANGE_ERROR"); 2452 end block; 2453 2454 block 2455 bool := 1 div 0 = 0 and TRUE; 2456 writeln(" ***** 1 div 0 = 0 and TRUE did not raise NUMERIC_ERROR"); 2457 exception 2458 catch NUMERIC_ERROR: writeln("1 div 0 = 0 and TRUE raises NUMERIC_ERROR"); 2459 catch RANGE_ERROR: writeln("1 div 0 = 0 and TRUE raises RANGE_ERROR"); 2460 end block; 2461 2462 block 2463 bool := 1 div 0 = 0 and FALSE; 2464 writeln(" ***** 1 div 0 = 0 and FALSE did not raise NUMERIC_ERROR"); 2465 exception 2466 catch NUMERIC_ERROR: writeln("1 div 0 = 0 and FALSE raises NUMERIC_ERROR"); 2467 catch RANGE_ERROR: writeln("1 div 0 = 0 and FALSE raises RANGE_ERROR"); 2468 end block; 2469 2470 block 2471 bool := TRUE and 1 div 0 = 0; 2472 writeln(" ***** TRUE and 1 div 0 = 0 did not raise NUMERIC_ERROR"); 2473 exception 2474 catch NUMERIC_ERROR: writeln("TRUE and 1 div 0 = 0 raises NUMERIC_ERROR"); 2475 catch RANGE_ERROR: writeln("TRUE and 1 div 0 = 0 raises RANGE_ERROR"); 2476 end block; 2477 2478 block 2479 bool := 1 div 0 = 0 or TRUE; 2480 writeln(" ***** 1 div 0 = 0 or TRUE did not raise NUMERIC_ERROR"); 2481 exception 2482 catch NUMERIC_ERROR: writeln("1 div 0 = 0 or TRUE raises NUMERIC_ERROR"); 2483 catch RANGE_ERROR: writeln("1 div 0 = 0 or TRUE raises RANGE_ERROR"); 2484 end block; 2485 2486 block 2487 bool := 1 div 0 = 0 or FALSE; 2488 writeln(" ***** 1 div 0 = 0 or FALSE did not raise NUMERIC_ERROR"); 2489 exception 2490 catch NUMERIC_ERROR: writeln("1 div 0 = 0 or FALSE raises NUMERIC_ERROR"); 2491 catch RANGE_ERROR: writeln("1 div 0 = 0 or FALSE raises RANGE_ERROR"); 2492 end block; 2493 2494 block 2495 bool := FALSE or 1 div 0 = 0; 2496 writeln(" ***** FALSE or 1 div 0 = 0 did not raise NUMERIC_ERROR"); 2497 exception 2498 catch NUMERIC_ERROR: writeln("FALSE or 1 div 0 = 0 raises NUMERIC_ERROR"); 2499 catch RANGE_ERROR: writeln("FALSE or 1 div 0 = 0 raises RANGE_ERROR"); 2500 end block; 2501 2502 block 2503 if 1 div 0 = 0 then 2504 writeln(" ***** if 1 div 0 did not raise NUMERIC_ERROR"); 2505 end if; 2506 writeln(" ***** if 1 div 0 did not raise NUMERIC_ERROR"); 2507 exception 2508 catch NUMERIC_ERROR: writeln("if 1 div 0 raises NUMERIC_ERROR"); 2509 catch RANGE_ERROR: writeln("if 1 div 0 raises RANGE_ERROR"); 2510 end block; 2511 2512 block 2513 if TRUE then 2514 number := 1 div 0; 2515 end if; 2516 writeln(" ***** 1 div 0 in if then did not raise NUMERIC_ERROR"); 2517 exception 2518 catch NUMERIC_ERROR: writeln("1 div 0 in if then raises NUMERIC_ERROR"); 2519 catch RANGE_ERROR: writeln("1 div 0 in if then raises RANGE_ERROR"); 2520 end block; 2521 2522 block 2523 if FALSE then 2524 noop; 2525 else 2526 number := 1 div 0; 2527 end if; 2528 writeln(" ***** 1 div 0 in if else did not raise NUMERIC_ERROR"); 2529 exception 2530 catch NUMERIC_ERROR: writeln("1 div 0 in if else raises NUMERIC_ERROR"); 2531 catch RANGE_ERROR: writeln("1 div 0 in if else raises RANGE_ERROR"); 2532 end block; 2533 2534 block 2535 while 1 div 0 = 0 do 2536 writeln(" ***** while 1 div 0 did not raise NUMERIC_ERROR"); 2537 end while; 2538 writeln(" ***** while 1 div 0 did not raise NUMERIC_ERROR"); 2539 exception 2540 catch NUMERIC_ERROR: writeln("while 1 div 0 raises NUMERIC_ERROR"); 2541 catch RANGE_ERROR: writeln("while 1 div 0 raises RANGE_ERROR"); 2542 end block; 2543 2544 block 2545 while TRUE do 2546 number := 1 div 0; 2547 end while; 2548 writeln(" ***** 1 div 0 in while did not raise NUMERIC_ERROR"); 2549 exception 2550 catch NUMERIC_ERROR: writeln("1 div 0 in while raises NUMERIC_ERROR"); 2551 catch RANGE_ERROR: writeln("1 div 0 in while raises RANGE_ERROR"); 2552 end block; 2553 2554 block 2555 repeat 2556 noop; 2557 until 1 div 0 = 0; 2558 writeln(" ***** repeat until 1 div 0 did not raise NUMERIC_ERROR"); 2559 exception 2560 catch NUMERIC_ERROR: writeln("repeat until 1 div 0 raises NUMERIC_ERROR"); 2561 catch RANGE_ERROR: writeln("repeat until 1 div 0 raises RANGE_ERROR"); 2562 end block; 2563 2564 block 2565 repeat 2566 number := 1 div 0; 2567 until TRUE; 2568 writeln(" ***** 1 div 0 in repeat did not raise NUMERIC_ERROR"); 2569 exception 2570 catch NUMERIC_ERROR: writeln("1 div 0 in repeat raises NUMERIC_ERROR"); 2571 catch RANGE_ERROR: writeln("1 div 0 in repeat raises RANGE_ERROR"); 2572 end block; 2573 end func; 2574