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/] [cb20001.a] - Rev 149
Go to most recent revision | Compare with Previous | Blame | View Log
-- CB20001.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 exceptions can be handled in accept bodies, and that a
-- task object that has an exception handled in an accept body is still
-- viable for future use.
--
-- TEST DESCRIPTION:
-- Declare a task that has exception handlers within an accept
-- statement in the task body. Declare a task object, and make entry
-- calls with data that will cause various exceptions to be raised
-- by the accept statement. Ensure that the exceptions are:
-- 1) raised and handled locally in the accept body
-- 2) raised in the accept body and handled/reraised to be handled
-- by the task body
-- 3) raised in the accept body and propagated to the calling
-- procedure.
--
--
-- CHANGE HISTORY:
-- 06 Dec 94 SAIC ACVC 2.0
--
--!
with Report;
package CB20001_0 is
Incorrect_Data,
Location_Error,
Off_Screen_Data : exception;
TC_Handled_In_Accept,
TC_Reraised_In_Accept,
TC_Handled_In_Task_Block,
TC_Handled_In_Caller : boolean := False;
type Location_Type is range 0 .. 2000;
task type Submarine_Type is
entry Contact (Location : in Location_Type);
end Submarine_Type;
Current_Position : Location_Type := 0;
end CB20001_0;
--=================================================================--
package body CB20001_0 is
task body Submarine_Type is
begin
loop
Task_Block:
begin
select
accept Contact (Location : in Location_Type) do
if Location > 1000 then
raise Off_Screen_Data;
elsif (Location > 500) and (Location <= 1000) then
raise Location_Error;
elsif (Location > 100) and (Location <= 500) then
raise Incorrect_Data;
else
Current_Position := Location;
end if;
exception
when Off_Screen_Data =>
TC_Handled_In_Accept := True;
when Location_Error =>
TC_Reraised_In_Accept := True;
raise; -- Reraise the Location_Error exception
-- in the task block.
end Contact;
or
terminate;
end select;
exception
when Off_Screen_Data =>
TC_Handled_In_Accept := False;
Report.Failed ("Off_Screen_Data exception " &
"improperly handled in task block");
when Location_Error =>
TC_Handled_In_Task_Block := True;
end Task_Block;
end loop;
exception
when Location_Error | Off_Screen_Data =>
TC_Handled_In_Accept := False;
TC_Handled_In_Task_Block := False;
Report.Failed ("Exception improperly propagated out to task body");
when others =>
null;
end Submarine_Type;
end CB20001_0;
--=================================================================--
with CB20001_0;
with Report;
with ImpDef;
procedure CB20001 is
package Submarine_Tracking renames CB20001_0;
Trident : Submarine_Tracking.Submarine_Type; -- Declare task
Sonar_Contact : Submarine_Tracking.Location_Type;
TC_LEB_Error,
TC_Main_Handler_Used : Boolean := False;
begin
Report.Test ("CB20001", "Check that exceptions can be handled " &
"in accept bodies");
Off_Screen_Block:
begin
Sonar_Contact := 1500;
Trident.Contact (Sonar_Contact); -- Cause Off_Screen_Data exception
-- to be raised and handled in a task
-- accept body.
exception
when Submarine_Tracking.Off_Screen_Data =>
TC_Main_Handler_Used := True;
Report.Failed ("Off_Screen_Data exception improperly handled " &
"in calling procedure");
when others =>
Report.Failed ("Exception handled unexpectedly in " &
"Off_Screen_Block");
end Off_Screen_Block;
Location_Error_Block:
begin
Sonar_Contact := 700;
Trident.Contact (Sonar_Contact); -- Cause Location_Error exception
-- to be raised in task accept body,
-- propogated to a task block, and
-- handled there. Corresponding
-- exception propagated here also.
Report.Failed ("Expected exception not raised");
exception
when Submarine_Tracking.Location_Error =>
TC_LEB_Error := True;
when others =>
Report.Failed ("Exception handled unexpectedly in " &
"Location_Error_Block");
end Location_Error_Block;
Incorrect_Data_Block:
begin
Sonar_Contact := 200;
Trident.Contact (Sonar_Contact); -- Cause Incorrect_Data exception
-- to be raised in task accept body,
-- propogated to calling procedure.
Report.Failed ("Expected exception not raised");
exception
when Submarine_Tracking.Incorrect_Data =>
Submarine_Tracking.TC_Handled_In_Caller := True;
when others =>
Report.Failed ("Exception handled unexpectedly in " &
"Incorrect_Data_Block");
end Incorrect_Data_Block;
if TC_Main_Handler_Used or
not (Submarine_Tracking.TC_Handled_In_Caller and -- Check to see that
Submarine_Tracking.TC_Handled_In_Task_Block and -- all exceptions
Submarine_Tracking.TC_Handled_In_Accept and -- were handled in
Submarine_Tracking.TC_Reraised_In_Accept and -- proper locations.
TC_LEB_Error)
then
Report.Failed ("Exceptions handled in incorrect locations");
end if;
if Integer(Submarine_Tracking.Current_Position) /= 0 then
Report.Failed ("Variable incorrectly written in task processing");
end if;
delay ImpDef.Minimum_Task_Switch;
if Trident'Callable then
Report.Failed ("Task didn't terminate with exception propagation");
end if;
Report.Result;
end CB20001;
Go to most recent revision | Compare with Previous | Blame | View Log