1-- Copyright 2018-2020 Free Software Foundation, Inc. 2-- 3-- This program is free software; you can redistribute it and/or modify 4-- it under the terms of the GNU General Public License as published by 5-- the Free Software Foundation; either version 3 of the License, or 6-- (at your option) any later version. 7-- 8-- This program is distributed in the hope that it will be useful, 9-- but WITHOUT ANY WARRANTY; without even the implied warranty of 10-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11-- GNU General Public License for more details. 12-- 13-- You should have received a copy of the GNU General Public License 14-- along with this program. If not, see <http://www.gnu.org/licenses/>. 15 16with Pck; use Pck; 17 18procedure Foo is 19begin 20 21 -- Part 1 of the testcase 22 23 begin 24 raise Constraint_Error; 25 exception 26 when Constraint_Error => 27 null; 28 end; 29 30 begin 31 null; 32 exception 33 when others => 34 null; 35 end; 36 37 begin 38 raise Storage_Error; 39 exception 40 when Storage_Error => 41 null; 42 end; 43 44 -- Part 2 of the testcase 45 46 begin 47 raise ABORT_SIGNAL; 48 exception 49 when others => 50 null; 51 end; 52 53 begin 54 raise Program_Error; 55 exception 56 when Program_Error => 57 null; 58 end; 59 60 begin 61 raise Storage_Error; 62 exception 63 when Storage_Error => 64 null; 65 end; 66 67 -- Part 3 of the testcase 68 69 begin 70 Global_Var := Global_Var + 1; 71 raise ABORT_SIGNAL; 72 exception 73 when others => 74 null; 75 end; 76 77 begin 78 Global_Var := Global_Var + 1; 79 raise Constraint_Error; 80 exception 81 when Constraint_Error => 82 null; 83 end; 84 85 -- Part 4 of the testcase 86 87 begin 88 Global_Var := Global_Var + 1; 89 raise Program_Error; 90 exception 91 when others => 92 null; 93 end; 94 95 begin 96 Global_Var := Global_Var + 1; 97 raise Program_Error; 98 exception 99 when Program_Error => 100 null; 101 end; 102 103end Foo; 104