| -- CB41003.A |
| -- |
| -- Grant of Unlimited Rights |
| -- |
| -- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, |
| -- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained |
| -- unlimited rights in the software and documentation contained herein. |
| -- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making |
| -- this public release, the Government intends to confer upon all |
| -- recipients unlimited rights equal to those held by the Government. |
| -- These rights include rights to use, duplicate, release or disclose the |
| -- released technical data and computer software in whole or in part, in |
| -- any manner and for any purpose whatsoever, and to have or permit others |
| -- to do so. |
| -- |
| -- DISCLAIMER |
| -- |
| -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR |
| -- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED |
| -- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE |
| -- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE |
| -- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A |
| -- PARTICULAR PURPOSE OF SAID MATERIAL. |
| --* |
| -- |
| -- OBJECTIVE: |
| -- Check that an exception occurrence can be saved into an object of |
| -- type Exception_Occurrence using the procedure Save_Occurrence. |
| -- Check that a saved exception occurrence can be used to reraise |
| -- another occurrence of the same exception using the procedure |
| -- Reraise_Occurrence. Check that the function Save_Occurrence will |
| -- allocate a new object of type Exception_Occurrence_Access, and saves |
| -- the source exception to the new object which is returned as the |
| -- function result. |
| -- |
| -- TEST DESCRIPTION: |
| -- This test verifies that an occurrence of an exception can be saved, |
| -- using either of two overloaded versions of Save_Occurrence. The |
| -- procedure version of Save_Occurrence is used to save an occurrence |
| -- of a user defined exception into an object of type |
| -- Exception_Occurrence. This object is then used as an input |
| -- parameter to procedure Reraise_Occurrence, the expected exception is |
| -- handled, and the exception id of the handled exception is compared |
| -- to the id of the originally raised exception. |
| -- The function version of Save_Occurrence returns a result of |
| -- Exception_Occurrence_Access, and is used to store the value of another |
| -- occurrence of the user defined exception. The resulting access value |
| -- is dereferenced and used as an input to Reraise_Occurrence. The |
| -- resulting exception is handled, and the exception id of the handled |
| -- exception is compared to the id of the originally raised exception. |
| -- |
| -- |
| -- CHANGE HISTORY: |
| -- 06 Dec 94 SAIC ACVC 2.0 |
| -- |
| --! |
| |
| with Report; |
| with Ada.Exceptions; |
| |
| procedure CB41003 is |
| |
| begin |
| |
| Report.Test ("CB41003", "Check that an exception occurrence can " & |
| "be saved into an object of type " & |
| "Exception_Occurrence using the procedure " & |
| "Save_Occurrence"); |
| |
| Test_Block: |
| declare |
| |
| use Ada.Exceptions; |
| |
| User_Exception_1, |
| User_Exception_2 : Exception; |
| |
| Saved_Occurrence : Exception_Occurrence; |
| Occurrence_Ptr : Exception_Occurrence_Access; |
| |
| User_Message : constant String := -- 200 character string. |
| "The string returned by Exception_Message may be tr" & |
| "uncated (to no less then 200 characters) by the Sa" & |
| "ve_Occurrence procedure (not the function), the Re" & |
| "raise_Occurrence proc, and the re-raise statement."; |
| |
| begin |
| |
| Raise_And_Save_Block_1 : |
| begin |
| |
| -- This nested exception structure is designed to ensure that the |
| -- appropriate exception occurrence is saved using the |
| -- Save_Occurrence procedure. |
| |
| raise Program_Error; |
| Report.Failed("Program_Error not raised"); |
| |
| exception |
| when Program_Error => |
| |
| begin |
| -- Use the procedure Raise_Exception, along with the 'Identity |
| -- attribute to raise the first user defined exception. Note |
| -- that a 200 character message is included in the call. |
| |
| Raise_Exception(User_Exception_1'Identity, User_Message); |
| Report.Failed("User_Exception_1 not raised"); |
| |
| exception |
| when Exc : User_Exception_1 => |
| |
| -- This exception occurrence is saved into a variable using |
| -- procedure Save_Occurrence. This saved occurrence should |
| -- not be confused with the raised occurrence of |
| -- Program_Error above. |
| |
| Save_Occurrence(Target => Saved_Occurrence, Source => Exc); |
| |
| when others => |
| Report.Failed("Unexpected exception handled, expecting " & |
| "User_Exception_1"); |
| end; |
| |
| when others => |
| Report.Failed("Incorrect exception generated by raise statement"); |
| |
| end Raise_And_Save_Block_1; |
| |
| |
| Reraise_And_Handle_Saved_Exception_1 : |
| begin |
| -- Reraise the exception that was saved in the previous block. |
| |
| Reraise_Occurrence(X => Saved_Occurrence); |
| |
| exception |
| when Exc : User_Exception_1 => -- Expected exception. |
| -- Check the exception id of the handled id by using the |
| -- Exception_Identity function, and compare with the id of the |
| -- originally raised exception. |
| |
| if User_Exception_1'Identity /= Exception_Identity(Exc) then |
| Report.Failed("Exception_Ids do not match - 1"); |
| end if; |
| |
| -- Check that the message associated with this exception occurrence |
| -- has not been truncated (it was originally 200 characters). |
| |
| if User_Message /= Exception_Message(Exc) then |
| Report.Failed("Exception messages do not match - 1"); |
| end if; |
| |
| when others => |
| Report.Failed |
| ("Incorrect exception raised by Reraise_Occurrence - 1"); |
| end Reraise_And_Handle_Saved_Exception_1; |
| |
| |
| Raise_And_Save_Block_2 : |
| begin |
| |
| Raise_Exception(User_Exception_2'Identity, User_Message); |
| Report.Failed("User_Exception_2 not raised"); |
| |
| exception |
| when Exc : User_Exception_2 => |
| |
| -- This exception occurrence is saved into an access object |
| -- using function Save_Occurrence. |
| |
| Occurrence_Ptr := Save_Occurrence(Source => Exc); |
| |
| when others => |
| Report.Failed("Unexpected exception handled, expecting " & |
| "User_Exception_2"); |
| end Raise_And_Save_Block_2; |
| |
| |
| Reraise_And_Handle_Saved_Exception_2 : |
| begin |
| -- Reraise the exception that was saved in the previous block. |
| -- Dereference the access object for use as input parameter. |
| |
| Reraise_Occurrence(X => Occurrence_Ptr.all); |
| |
| exception |
| when Exc : User_Exception_2 => -- Expected exception. |
| -- Check the exception id of the handled id by using the |
| -- Exception_Identity function, and compare with the id of the |
| -- originally raised exception. |
| |
| if User_Exception_2'Identity /= Exception_Identity(Exc) then |
| Report.Failed("Exception_Ids do not match - 2"); |
| end if; |
| |
| -- Check that the message associated with this exception occurrence |
| -- has not been truncated (it was originally 200 characters). |
| |
| if User_Message /= Exception_Message(Exc) then |
| Report.Failed("Exception messages do not match - 2"); |
| end if; |
| |
| when others => |
| Report.Failed |
| ("Incorrect exception raised by Reraise_Occurrence - 2"); |
| end Reraise_And_Handle_Saved_Exception_2; |
| |
| |
| -- Another example of the use of saving an exception occurrence |
| -- is demonstrated in the following block, where the ability to |
| -- save an occurrence into a data structure, for later processing, |
| -- is modeled. |
| |
| Store_And_Handle_Block: |
| declare |
| |
| Exc_Number : constant := 3; |
| Exception_1, |
| Exception_2, |
| Exception_3 : exception; |
| |
| Exception_Storage : array (1..Exc_Number) of Exception_Occurrence; |
| Messages : array (1..Exc_Number) of String(1..9) := |
| ("Message 1", "Message 2", "Message 3"); |
| |
| begin |
| |
| Outer_Block: |
| begin |
| |
| Inner_Block: |
| begin |
| |
| for i in 1..Exc_Number loop |
| begin |
| |
| begin |
| -- Exceptions all raised in a deep scope. |
| if i = 1 then |
| Raise_Exception(Exception_1'Identity, Messages(i)); |
| elsif i = 2 then |
| Raise_Exception(Exception_2'Identity, Messages(i)); |
| elsif i = 3 then |
| Raise_Exception(Exception_3'Identity, Messages(i)); |
| end if; |
| Report.Failed("Exception not raised on loop #" & |
| Integer'Image(i)); |
| end; |
| Report.Failed("Exception not propagated on loop #" & |
| Integer'Image(i)); |
| exception |
| when Exc : others => |
| |
| -- Save each occurrence into a storage array for |
| -- later processing. |
| |
| Save_Occurrence(Exception_Storage(i), Exc); |
| end; |
| end loop; |
| |
| end Inner_Block; |
| end Outer_Block; |
| |
| -- Raise the exceptions from the stored occurrences, and handle. |
| |
| for i in 1..Exc_Number loop |
| begin |
| Reraise_Occurrence(Exception_Storage(i)); |
| Report.Failed("No exception reraised for " & |
| "exception #" & Integer'Image(i)); |
| exception |
| when Exc : others => |
| -- The following sequence of checks ensures that the |
| -- correct occurrence was stored, and the associated |
| -- exception was raised and handled in the proper order. |
| if i = 1 then |
| if Exception_1'Identity /= Exception_Identity(Exc) then |
| Report.Failed("Exception_1 not raised"); |
| end if; |
| elsif i = 2 then |
| if Exception_2'Identity /= Exception_Identity(Exc) then |
| Report.Failed("Exception_2 not raised"); |
| end if; |
| elsif i = 3 then |
| if Exception_3'Identity /= Exception_Identity(Exc) then |
| Report.Failed("Exception_3 not raised"); |
| end if; |
| end if; |
| |
| if Exception_Message(Exc) /= Messages(i) then |
| Report.Failed("Incorrect message associated with " & |
| "exception #" & Integer'Image(i)); |
| end if; |
| end; |
| end loop; |
| exception |
| when others => |
| Report.Failed("Unexpected exception in Store_And_Handle_Block"); |
| end Store_And_Handle_Block; |
| |
| |
| Reraise_Out_Of_Scope: |
| declare |
| |
| TC_Value : constant := 5; |
| The_Exception : exception; |
| Saved_Exc_Occ : Exception_Occurrence; |
| |
| procedure Handle_It (Exc_Occ : in Exception_Occurrence) is |
| Must_Be_Raised : exception; |
| begin |
| if Exception_Identity(Exc_Occ) = The_Exception'Identity then |
| raise Must_Be_Raised; |
| Report.Failed("Exception Must_Be_Raised was not raised"); |
| else |
| Report.Failed("Incorrect exception handled in " & |
| "Procedure Handle_It"); |
| end if; |
| end Handle_It; |
| |
| begin |
| |
| if Report.Ident_Int(5) = TC_Value then |
| raise The_Exception; |
| end if; |
| |
| exception |
| when Exc : others => |
| Save_Occurrence (Saved_Exc_Occ, Exc); |
| begin |
| Handle_It(Saved_Exc_Occ); -- Raise another exception, in a |
| exception -- different scope. |
| when others => -- Handle this new exception. |
| begin |
| Reraise_Occurrence (Saved_Exc_Occ); -- Reraise the |
| -- original excptn. |
| Report.Failed("Saved Exception was not raised"); |
| exception |
| when Exc_2 : others => |
| if Exception_Identity (Exc_2) /= |
| The_Exception'Identity |
| then |
| Report.Failed |
| ("Incorrect exception occurrence reraised"); |
| end if; |
| end; |
| end; |
| end Reraise_Out_Of_Scope; |
| |
| |
| exception |
| when others => Report.Failed ("Exception raised in Test_Block"); |
| end Test_Block; |
| |
| Report.Result; |
| |
| end CB41003; |
