diff options
Diffstat (limited to 'gcc/testsuite/ada/acats/tests/cb/cb41003.a')
| -rw-r--r-- | gcc/testsuite/ada/acats/tests/cb/cb41003.a | 358 |
1 files changed, 0 insertions, 358 deletions
diff --git a/gcc/testsuite/ada/acats/tests/cb/cb41003.a b/gcc/testsuite/ada/acats/tests/cb/cb41003.a deleted file mode 100644 index aee0b094ce5..00000000000 --- a/gcc/testsuite/ada/acats/tests/cb/cb41003.a +++ /dev/null @@ -1,358 +0,0 @@ --- 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; |