URL
https://opencores.org/ocsvn/openrisc/openrisc/trunk
Subversion Repositories openrisc
[/] [openrisc/] [trunk/] [gnu-old/] [gcc-4.2.2/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [cb/] [cb41003.a] - Rev 149
Go to most recent revision | Compare with Previous | Blame | View Log
-- 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;
Go to most recent revision | Compare with Previous | Blame | View Log