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