1{****************************************************************} 2{ CODE GENERATOR TEST PROGRAM } 3{ By Carl Eric Codere } 4{****************************************************************} 5{ NODE TESTED : secondtryexcept() } 6{ secondraise() } 7{****************************************************************} 8{ PRE-REQUISITES: secondload() } 9{ secondassign() } 10{ secondtypeconv() } 11{ secondtryexcept() } 12{ secondcalln() } 13{ secondadd() } 14{****************************************************************} 15{ DEFINES: } 16{ FPC = Target is FreePascal compiler } 17{****************************************************************} 18{ REMARKS : Tested with Delphi 3 as reference implementation } 19{****************************************************************} 20program ttryexc1; 21 22{$ifdef fpc} 23{$mode objfpc} 24{$endif} 25 26Type 27 TAObject = class(TObject) 28 a : longint; 29 end; 30 TBObject = Class(TObject) 31 b : longint; 32 constructor create(c: longint); 33 end; 34 35 36{ The test cases were taken from the SAL internal architecture manual } 37 38 procedure fail; 39 begin 40 WriteLn('Failure.'); 41 halt(1); 42 end; 43 44var 45 global_counter : integer; 46 47 48 constructor tbobject.create(c:longint); 49 begin 50 inherited create; 51 b:=c; 52 end; 53 54 55Procedure raiseanexception; 56 57Var A : TAObject; 58var B : TAobject; 59 60begin 61{ Writeln ('Creating exception object');} 62 A:=TAObject.Create; 63{ Writeln ('Raising with this object');} 64 raise A; 65 { this should never happen, if it does there is a problem! } 66 RunError(255); 67end; 68 69 70procedure IncrementCounter(x: integer); 71begin 72 Inc(global_counter); 73end; 74 75procedure DecrementCounter(x: integer); 76begin 77 Dec(global_counter); 78end; 79 80 81Function DoTryExceptOne: boolean; 82var 83 failed : boolean; 84begin 85 Write('Try..Except clause...'); 86 global_counter:=0; 87 failed:=true; 88 DoTryExceptOne := failed; 89 Try 90 IncrementCounter(global_counter); 91 DecrementCounter(global_counter); 92 except 93 end; 94 if global_counter = 0 then 95 failed :=false; 96 DoTryExceptOne := failed; 97end; 98 99 100Function DoTryExceptTwo : boolean; 101var 102 failed : boolean; 103begin 104 Write('Try..Except with break statement...'); 105 global_counter:=0; 106 failed:=true; 107 DoTryExceptTwo := failed; 108 while (failed) do 109 begin 110 Try 111 IncrementCounter(global_counter); 112 DecrementCounter(global_counter); 113 break; 114 except 115 end; 116 end; 117 if global_counter = 0 then 118 failed :=false; 119 DoTryExceptTwo := failed; 120end; 121 122 123 124 125Function DoTryExceptFour: boolean; 126var 127 failed : boolean; 128begin 129 Write('Try..Except with exit statement...'); 130 global_counter:=0; 131 failed:=true; 132 DoTryExceptFour := failed; 133 while (failed) do 134 begin 135 Try 136 IncrementCounter(global_counter); 137 DecrementCounter(global_counter); 138 DoTryExceptFour := false; 139 exit; 140 except 141 end; 142 end; 143end; 144 145 146Function DoTryExceptFive: boolean; 147var 148 failed : boolean; 149 x : integer; 150begin 151 Write('Try..Except nested clauses (three-level nesting)...'); 152 global_counter:=0; 153 failed:=true; 154 DoTryExceptFive := failed; 155 x:=0; 156 Try 157 IncrementCounter(global_counter); 158 Try 159 DecrementCounter(global_counter); 160 IncrementCounter(global_counter); 161 Try 162 DecrementCounter(global_counter); 163 except 164 Inc(x); 165 end; 166 except 167 Inc(x); 168 End; 169 except 170 end; 171 if (global_counter = 0) then 172 failed :=false; 173 DoTryExceptFive := failed; 174end; 175 176 177Function DoTryExceptSix : boolean; 178var 179 failed : boolean; 180 x: integer; 181begin 182 Write('Try..Except nested clauses with break statement...'); 183 global_counter:=0; 184 x:=0; 185 failed:=true; 186 DoTryExceptSix := failed; 187 while (failed) do 188 begin 189 Try 190 IncrementCounter(global_counter); 191 Try 192 DecrementCounter(global_counter); 193 IncrementCounter(global_counter); 194 Try 195 DecrementCounter(global_counter); 196 break; 197 except 198 Inc(x); 199 end; 200 except 201 Inc(x); 202 End; 203 except 204 end; 205 end; 206 if (global_counter = 0) then 207 failed :=false; 208 DoTryExceptSix := failed; 209end; 210 211 212Function DoTryExceptEight : boolean; 213var 214 failed : boolean; 215 x: integer; 216begin 217 Write('Try..Except nested clauses with exit statement...'); 218 global_counter:=0; 219 x:=0; 220 failed:=true; 221 DoTryExceptEight := failed; 222 while (failed) do 223 begin 224 Try 225 IncrementCounter(global_counter); 226 Try 227 DecrementCounter(global_counter); 228 IncrementCounter(global_counter); 229 Try 230 DecrementCounter(global_counter); 231 DoTryExceptEight := false; 232 exit; 233 except 234 Inc(x); 235 end; 236 except 237 Inc(x); 238 End; 239 except 240 end; 241 end; 242end; 243 244 245Function DoTryExceptNine : boolean; 246var 247 failed : boolean; 248 x: integer; 249begin 250 Write('Try..Except nested clauses with break statement in other try-block...'); 251 global_counter:=0; 252 x:=0; 253 failed:=true; 254 DoTryExceptNine := failed; 255 Try 256 while (failed) do 257 begin 258 Try 259 IncrementCounter(global_counter); 260 Try 261 DecrementCounter(global_counter); 262 IncrementCounter(global_counter); 263 Try 264 DecrementCounter(global_counter); 265 break; 266 except 267 Inc(x); 268 end; 269 except 270 Inc(x); 271 End; 272 except 273 end; 274 end; {end while } 275 except 276 { normally this should execute! } 277 DoTryExceptNine := failed; 278 end; 279 if (global_counter = 0) and (x = 0) then 280 failed :=false; 281 DoTryExceptNine := failed; 282end; 283 284 285{****************************************************************************} 286 287{***************************************************************************} 288{ Exception is thrown } 289{***************************************************************************} 290Function DoTryExceptTen: boolean; 291var 292 failed : boolean; 293begin 294 Write('Try..Except clause with raise...'); 295 global_counter:=0; 296 failed:=true; 297 DoTryExceptTen := failed; 298 Try 299 IncrementCounter(global_counter); 300 RaiseAnException; 301 DecrementCounter(global_counter); 302 except 303 if global_counter = 1 then 304 failed :=false; 305 DoTryExceptTen := failed; 306 end; 307end; 308 309Function DoTryExceptEleven : boolean; 310var 311 failed : boolean; 312begin 313 Write('Try..Except with raise and break statement...'); 314 global_counter:=0; 315 failed:=true; 316 DoTryExceptEleven := failed; 317 while (failed) do 318 begin 319 Try 320 IncrementCounter(global_counter); 321 DecrementCounter(global_counter); 322 RaiseAnException; 323 break; 324 except 325 if global_counter = 0 then 326 failed :=false; 327 DoTryExceptEleven := failed; 328 end; 329 end; 330end; 331 332Function DoTryExceptTwelve: boolean; 333var 334 failed : boolean; 335 x : integer; 336begin 337 Write('Try..Except nested clauses (three-level nesting)...'); 338 global_counter:=0; 339 failed:=true; 340 DoTryExceptTwelve := failed; 341 x:=0; 342 Try 343 IncrementCounter(global_counter); 344 Try 345 DecrementCounter(global_counter); 346 IncrementCounter(global_counter); 347 Try 348 DecrementCounter(global_counter); 349 RaiseAnException; 350 except 351 if (global_counter = 0) then 352 failed :=false; 353 DoTryExceptTwelve := failed; 354 end; 355 except 356 DoTryExceptTwelve := true; 357 End; 358 except 359 DoTryExceptTwelve := true; 360 end; 361end; 362 363 364Function DoTryExceptThirteen: boolean; 365var 366 failed : boolean; 367 x : integer; 368begin 369 Write('Try..Except nested clauses (three-level nesting)...'); 370 global_counter:=0; 371 failed:=true; 372 DoTryExceptThirteen := failed; 373 x:=0; 374 Try 375 IncrementCounter(global_counter); 376 Try 377 DecrementCounter(global_counter); 378 IncrementCounter(global_counter); 379 RaiseAnException; 380 Try 381 DecrementCounter(global_counter); 382 except 383 DoTryExceptThirteen := true; 384 end; 385 except 386 if (global_counter = 1) then 387 failed :=false; 388 DoTryExceptThirteen := failed; 389 End; 390 except 391 DoTryExceptThirteen := true; 392 end; 393end; 394 395{***************************************************************************} 396{ Exception is thrown in except block } 397{***************************************************************************} 398Function DoTryExceptFourteen: boolean; 399var 400 failed : boolean; 401 x : integer; 402begin 403 Write('Try..Except nested clauses with single re-raise...'); 404 global_counter:=0; 405 failed:=true; 406 DoTryExceptFourteen := failed; 407 x:=0; 408 Try 409 IncrementCounter(global_counter); 410 Try 411 DecrementCounter(global_counter); 412 IncrementCounter(global_counter); 413 Try 414 DecrementCounter(global_counter); 415 RaiseAnException; 416 except 417 { raise to next block } 418 Raise; 419 end; 420 except 421 if (global_counter = 0) then 422 failed :=false; 423 DoTryExceptFourteen := failed; 424 End; 425 except 426 DoTryExceptFourteen := true; 427 end; 428end; 429 430 431 432Function DoTryExceptFifteen: boolean; 433var 434 failed : boolean; 435 x : integer; 436begin 437 Write('Try..Except nested clauses with re-reraises (1)...'); 438 global_counter:=0; 439 failed:=true; 440 DoTryExceptFifteen := failed; 441 x:=0; 442 Try 443 IncrementCounter(global_counter); 444 Try 445 DecrementCounter(global_counter); 446 IncrementCounter(global_counter); 447 Try 448 DecrementCounter(global_counter); 449 RaiseAnException; 450 except 451 { raise to next block } 452 Raise; 453 end; 454 except 455 { re-raise to next block } 456 Raise; 457 End; 458 except 459 if (global_counter = 0) then 460 failed :=false; 461 DoTryExceptFifteen := failed; 462 end; 463end; 464 465procedure nestedtryblock(var global_counter: integer); 466begin 467 IncrementCounter(global_counter); 468 Try 469 DecrementCounter(global_counter); 470 IncrementCounter(global_counter); 471 Try 472 DecrementCounter(global_counter); 473 RaiseAnException; 474 except 475 { raise to next block } 476 Raise; 477 end; 478 except 479 { re-raise to next block } 480 Raise; 481 End; 482end; 483 484 485Function DoTryExceptSixteen: boolean; 486var 487 failed : boolean; 488 x : integer; 489begin 490 Write('Try..Except nested clauses with re-reraises (2)...'); 491 global_counter:=0; 492 failed:=true; 493 DoTryExceptSixteen := failed; 494 x:=0; 495 Try 496 NestedTryBlock(global_counter); 497 except 498 if (global_counter = 0) then 499 failed :=false; 500 DoTryExceptSixteen := failed; 501 end; 502end; 503 504 505Function DoTryExceptSeventeen: boolean; 506var 507 failed : boolean; 508 x : integer; 509begin 510 Write('Try..Except nested clauses with raises...'); 511 global_counter:=0; 512 failed:=true; 513 DoTryExceptSeventeen := failed; 514 x:=0; 515 Try 516 IncrementCounter(global_counter); 517 Try 518 DecrementCounter(global_counter); 519 IncrementCounter(global_counter); 520 Try 521 DecrementCounter(global_counter); 522 RaiseAnException; 523 except 524 { raise to next block } 525 raise TAObject.Create; 526 end; 527 except 528 { re-raise to next block } 529 raise TBObject.Create(1234); 530 End; 531 except 532 if (global_counter = 0) then 533 failed :=false; 534 DoTryExceptSeventeen := failed; 535 end; 536end; 537 538{***************************************************************************} 539{ Exception flow control in except block } 540{***************************************************************************} 541Function DoTryExceptEighteen: boolean; 542var 543 failed : boolean; 544begin 545 Write('Try..Except clause with raise with break in except block...'); 546 global_counter:=0; 547 failed:=true; 548 DoTryExceptEighteen := failed; 549 while (failed) do 550 begin 551 Try 552 IncrementCounter(global_counter); 553 RaiseAnException; 554 DecrementCounter(global_counter); 555 except 556 if global_counter = 1 then 557 failed :=false; 558 DoTryExceptEighteen := failed; 559 break; 560 end; 561 end; 562end; 563 564 565Function DoTryExceptNineteen: boolean; 566var 567 failed : boolean; 568begin 569 Write('Try..Except clause with raise with exit in except block...'); 570 global_counter:=0; 571 failed:=true; 572 DoTryExceptNineteen := failed; 573 while (failed) do 574 begin 575 Try 576 IncrementCounter(global_counter); 577 RaiseAnException; 578 DecrementCounter(global_counter); 579 except 580 if global_counter = 1 then 581 failed :=false; 582 DoTryExceptNineteen := failed; 583 exit; 584 end; 585 end; 586end; 587 588 589Function DoTryExceptTwenty: boolean; 590var 591 failed : boolean; 592 x : integer; 593begin 594 Write('Try..Except nested clauses with raises with break in inner try...'); 595 global_counter:=0; 596 failed:=true; 597 DoTryExceptTwenty := failed; 598 x:=0; 599 Try 600 IncrementCounter(global_counter); 601 Try 602 while (x = 0) do 603 begin 604 DecrementCounter(global_counter); 605 IncrementCounter(global_counter); 606 Try 607 DecrementCounter(global_counter); 608 RaiseAnException; 609 except 610 { raise to next block } 611 raise TAObject.Create; 612 break; 613 end; 614 end; 615 except 616 { re-raise to next block } 617 raise TBObject.Create(1234); 618 End; 619 except 620 if (global_counter = 0) then 621 failed :=false; 622 DoTryExceptTwenty := failed; 623 end; 624end; 625 626 627Function DoTryExceptTwentyOne: boolean; 628var 629 failed : boolean; 630 x : integer; 631begin 632 Write('Try..Except nested clauses with raises with continue in inner try...'); 633 global_counter:=0; 634 failed:=true; 635 DoTryExceptTwentyOne := failed; 636 x:=0; 637 Try 638 IncrementCounter(global_counter); 639 Try 640 while (x = 0) do 641 begin 642 DecrementCounter(global_counter); 643 IncrementCounter(global_counter); 644 Try 645 DecrementCounter(global_counter); 646 RaiseAnException; 647 except 648 { raise to next block } 649 raise TAObject.Create; 650 x:=1; 651 continue; 652 end; 653 end; 654 except 655 { re-raise to next block } 656 raise TBObject.Create(1234); 657 End; 658 except 659 if (global_counter = 0) then 660 failed :=false; 661 DoTryExceptTwentyOne := failed; 662 end; 663end; 664 665 666Function DoTryExceptTwentyTwo: boolean; 667var 668 failed : boolean; 669 x : integer; 670begin 671 Write('Try..Except nested clauses with raises with exit in inner try...'); 672 global_counter:=0; 673 failed:=true; 674 DoTryExceptTwentyTwo := failed; 675 x:=0; 676 Try 677 IncrementCounter(global_counter); 678 Try 679 while (x = 0) do 680 begin 681 DecrementCounter(global_counter); 682 IncrementCounter(global_counter); 683 Try 684 DecrementCounter(global_counter); 685 RaiseAnException; 686 except 687 { raise to next block } 688 raise TAObject.Create; 689 exit; 690 end; 691 end; 692 except 693 { re-raise to next block } 694 raise TBObject.Create(1234); 695 End; 696 except 697 if (global_counter = 0) then 698 failed :=false; 699 DoTryExceptTwentyTwo := failed; 700 end; 701end; 702 703 704var 705 failed: boolean; 706begin 707 failed := DoTryExceptOne; 708 if failed then 709 fail 710 else 711 WriteLn('Success!'); 712 failed := DoTryExceptTwo; 713 if failed then 714 fail 715 else 716 WriteLn('Success!'); 717{ failed := DoTryExceptThree; 718 if failed then 719 fail 720 else 721 WriteLn('Success!');} 722 failed := DoTryExceptFour; 723 if failed then 724 fail 725 else 726 WriteLn('Success!'); 727 failed := DoTryExceptFive; 728 if failed then 729 fail 730 else 731 WriteLn('Success!'); 732 failed := DoTryExceptSix; 733 if failed then 734 fail 735 else 736 WriteLn('Success!'); 737{ failed := DoTryExceptSeven; 738 if failed then 739 fail 740 else 741 WriteLn('Success!');} 742 failed := DoTryExceptEight; 743 if failed then 744 fail 745 else 746 WriteLn('Success!'); 747 failed := DoTryExceptNine; 748 if failed then 749 fail 750 else 751 WriteLn('Success!'); 752 (************************ Exceptions are created from here ****************************) 753 failed := DoTryExceptTen; 754 if failed then 755 fail 756 else 757 WriteLn('Success!'); 758 failed := DoTryExceptEleven; 759 if failed then 760 fail 761 else 762 WriteLn('Success!'); 763 failed := DoTryExceptTwelve; 764 if failed then 765 fail 766 else 767 WriteLn('Success!'); 768 failed := DoTryExceptThirteen; 769 if failed then 770 fail 771 else 772 WriteLn('Success!'); 773 (************************ Exceptions in except block ****************************) 774 failed := DoTryExceptFourteen; 775 if failed then 776 fail 777 else 778 WriteLn('Success!'); 779 failed := DoTryExceptFifteen; 780 if failed then 781 fail 782 else 783 WriteLn('Success!'); 784 failed := DoTryExceptSixteen; 785 if failed then 786 fail 787 else 788 WriteLn('Success!'); 789 failed := DoTryExceptSeventeen; 790 if failed then 791 fail 792 else 793 WriteLn('Success!'); 794 failed := DoTryExceptEighteen; 795 if failed then 796 fail 797 else 798 WriteLn('Success!'); 799 failed := DoTryExceptNineteen; 800 if failed then 801 fail 802 else 803 WriteLn('Success!'); 804 failed := DoTryExceptTwenty; 805 if failed then 806 fail 807 else 808 WriteLn('Success!'); 809 failed := DoTryExceptTwentyOne; 810 if failed then 811 fail 812 else 813 WriteLn('Success!'); 814 failed := DoTryExceptTwentyTwo; 815 if failed then 816 fail 817 else 818 WriteLn('Success!'); 819end. 820