1with X_Statements_Raise; 2with Ada.Exceptions; use Ada.Exceptions; 3separate (T_Statements) 4procedure Test_Raise is 5 C1 : constant Exception_Id := Constraint_Error'Identity; 6 C2 : constant Exception_Id := C1; 7 8 package Pack1 is 9 False_External : exception; 10 end Pack1; 11 package body Pack1 is separate; 12 13 package Pack2 is new X_Statements_Raise; 14 15 task T is 16 entry E; 17 end T; 18 task body T is 19 begin 20 raise Constraint_Error; -- raise, raise_standard 21 raise Tasking_Error; -- raise, raise_standard, locally handled (in task) 22 23 accept E do 24 Raise_Exception (Constraint_Error'Identity, "message"); -- raise_standard, procedure_call 25 Raise_Exception (C2); -- raise_standard, procedure_call 26 raise Constraint_Error; -- raise, raise_standard 27 raise Tasking_Error; -- raise, raise_standard 28 raise Storage_Error; -- raise, raise_standard, locally handled (in accept) 29 exception 30 when Storage_Error => 31 null; -- null; 32 end E; 33 exception 34 when Tasking_Error => 35 raise; -- raise, reraise 36 end T; 37 38 E : exception; 39begin 40 raise E; -- raise, Raise_nonpublic 41 42 raise Pack2.Exported; -- raise, raise_foreign 43 raise Constraint_Error; -- raise, raise_standard, locally handled (in proc) 44 raise Program_Error; -- raise, raise_standard 45 46 declare -- block, unnamed block, declare_block, effective_declare_block 47 package Pack2 is end Pack2; 48 package body Pack2 is 49 begin 50 raise Constraint_Error; -- raise, raise_standard, locally handled (in proc) 51 raise Tasking_Error; -- raise, raise_standard, locally handled (in package) 52 raise Program_Error; -- raise, raise_standard 53 exception 54 when Occur: Tasking_Error => 55 Reraise_Occurrence (Occur); -- reraise, procedure_call 56 end Pack2; 57 begin 58 raise Storage_Error; -- raise, raise_standard, locally handled (in block) 59 raise Numeric_Error; -- raise, raise_standard, locally handled (in block), => Constraint_Error 60 raise Tasking_Error; -- raise, raise_standard, locally handled (in proc) 61 raise Program_Error; -- raise, raise_standard 62 exception 63 when Constraint_Error => 64 null; -- null 65 when Storage_Error => 66 null; -- null 67 end; 68 69 begin -- block, unnamed block 70 raise Program_Error; -- raise, raise_standard, locally handled (in block) 71 exception 72 when others => -- null_when_others 73 null; -- null 74 end; 75 76exception 77 when Constraint_Error => 78 null; -- null 79 when Tasking_Error => 80 null; -- null 81end Test_Raise; 82