-- CB20001.A
|
-- CB20001.A
|
--
|
--
|
-- Grant of Unlimited Rights
|
-- Grant of Unlimited Rights
|
--
|
--
|
-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
|
-- 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
|
-- 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 in the software and documentation contained herein.
|
-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making
|
-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making
|
-- this public release, the Government intends to confer upon all
|
-- this public release, the Government intends to confer upon all
|
-- recipients unlimited rights equal to those held by the Government.
|
-- recipients unlimited rights equal to those held by the Government.
|
-- These rights include rights to use, duplicate, release or disclose the
|
-- These rights include rights to use, duplicate, release or disclose the
|
-- released technical data and computer software in whole or in part, in
|
-- 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
|
-- any manner and for any purpose whatsoever, and to have or permit others
|
-- to do so.
|
-- to do so.
|
--
|
--
|
-- DISCLAIMER
|
-- DISCLAIMER
|
--
|
--
|
-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
|
-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
|
-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
|
-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
|
-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
|
-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
|
-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
|
-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
|
-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
|
-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
|
-- PARTICULAR PURPOSE OF SAID MATERIAL.
|
-- PARTICULAR PURPOSE OF SAID MATERIAL.
|
--*
|
--*
|
--
|
--
|
-- OBJECTIVE:
|
-- OBJECTIVE:
|
-- Check that exceptions can be handled in accept bodies, and that a
|
-- 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
|
-- task object that has an exception handled in an accept body is still
|
-- viable for future use.
|
-- viable for future use.
|
--
|
--
|
-- TEST DESCRIPTION:
|
-- TEST DESCRIPTION:
|
-- Declare a task that has exception handlers within an accept
|
-- Declare a task that has exception handlers within an accept
|
-- statement in the task body. Declare a task object, and make entry
|
-- statement in the task body. Declare a task object, and make entry
|
-- calls with data that will cause various exceptions to be raised
|
-- calls with data that will cause various exceptions to be raised
|
-- by the accept statement. Ensure that the exceptions are:
|
-- by the accept statement. Ensure that the exceptions are:
|
-- 1) raised and handled locally in the accept body
|
-- 1) raised and handled locally in the accept body
|
-- 2) raised in the accept body and handled/reraised to be handled
|
-- 2) raised in the accept body and handled/reraised to be handled
|
-- by the task body
|
-- by the task body
|
-- 3) raised in the accept body and propagated to the calling
|
-- 3) raised in the accept body and propagated to the calling
|
-- procedure.
|
-- procedure.
|
--
|
--
|
--
|
--
|
-- CHANGE HISTORY:
|
-- CHANGE HISTORY:
|
-- 06 Dec 94 SAIC ACVC 2.0
|
-- 06 Dec 94 SAIC ACVC 2.0
|
--
|
--
|
--!
|
--!
|
|
|
with Report;
|
with Report;
|
|
|
package CB20001_0 is
|
package CB20001_0 is
|
|
|
Incorrect_Data,
|
Incorrect_Data,
|
Location_Error,
|
Location_Error,
|
Off_Screen_Data : exception;
|
Off_Screen_Data : exception;
|
|
|
TC_Handled_In_Accept,
|
TC_Handled_In_Accept,
|
TC_Reraised_In_Accept,
|
TC_Reraised_In_Accept,
|
TC_Handled_In_Task_Block,
|
TC_Handled_In_Task_Block,
|
TC_Handled_In_Caller : boolean := False;
|
TC_Handled_In_Caller : boolean := False;
|
|
|
type Location_Type is range 0 .. 2000;
|
type Location_Type is range 0 .. 2000;
|
|
|
task type Submarine_Type is
|
task type Submarine_Type is
|
entry Contact (Location : in Location_Type);
|
entry Contact (Location : in Location_Type);
|
end Submarine_Type;
|
end Submarine_Type;
|
|
|
Current_Position : Location_Type := 0;
|
Current_Position : Location_Type := 0;
|
|
|
end CB20001_0;
|
end CB20001_0;
|
|
|
|
|
--=================================================================--
|
--=================================================================--
|
|
|
|
|
package body CB20001_0 is
|
package body CB20001_0 is
|
|
|
|
|
task body Submarine_Type is
|
task body Submarine_Type is
|
begin
|
begin
|
loop
|
loop
|
|
|
Task_Block:
|
Task_Block:
|
begin
|
begin
|
select
|
select
|
accept Contact (Location : in Location_Type) do
|
accept Contact (Location : in Location_Type) do
|
if Location > 1000 then
|
if Location > 1000 then
|
raise Off_Screen_Data;
|
raise Off_Screen_Data;
|
elsif (Location > 500) and (Location <= 1000) then
|
elsif (Location > 500) and (Location <= 1000) then
|
raise Location_Error;
|
raise Location_Error;
|
elsif (Location > 100) and (Location <= 500) then
|
elsif (Location > 100) and (Location <= 500) then
|
raise Incorrect_Data;
|
raise Incorrect_Data;
|
else
|
else
|
Current_Position := Location;
|
Current_Position := Location;
|
end if;
|
end if;
|
exception
|
exception
|
when Off_Screen_Data =>
|
when Off_Screen_Data =>
|
TC_Handled_In_Accept := True;
|
TC_Handled_In_Accept := True;
|
when Location_Error =>
|
when Location_Error =>
|
TC_Reraised_In_Accept := True;
|
TC_Reraised_In_Accept := True;
|
raise; -- Reraise the Location_Error exception
|
raise; -- Reraise the Location_Error exception
|
-- in the task block.
|
-- in the task block.
|
end Contact;
|
end Contact;
|
or
|
or
|
terminate;
|
terminate;
|
end select;
|
end select;
|
|
|
exception
|
exception
|
|
|
when Off_Screen_Data =>
|
when Off_Screen_Data =>
|
TC_Handled_In_Accept := False;
|
TC_Handled_In_Accept := False;
|
Report.Failed ("Off_Screen_Data exception " &
|
Report.Failed ("Off_Screen_Data exception " &
|
"improperly handled in task block");
|
"improperly handled in task block");
|
|
|
when Location_Error =>
|
when Location_Error =>
|
TC_Handled_In_Task_Block := True;
|
TC_Handled_In_Task_Block := True;
|
end Task_Block;
|
end Task_Block;
|
|
|
end loop;
|
end loop;
|
|
|
exception
|
exception
|
|
|
when Location_Error | Off_Screen_Data =>
|
when Location_Error | Off_Screen_Data =>
|
TC_Handled_In_Accept := False;
|
TC_Handled_In_Accept := False;
|
TC_Handled_In_Task_Block := False;
|
TC_Handled_In_Task_Block := False;
|
Report.Failed ("Exception improperly propagated out to task body");
|
Report.Failed ("Exception improperly propagated out to task body");
|
when others =>
|
when others =>
|
null;
|
null;
|
end Submarine_Type;
|
end Submarine_Type;
|
|
|
end CB20001_0;
|
end CB20001_0;
|
|
|
|
|
--=================================================================--
|
--=================================================================--
|
|
|
|
|
with CB20001_0;
|
with CB20001_0;
|
with Report;
|
with Report;
|
with ImpDef;
|
with ImpDef;
|
|
|
procedure CB20001 is
|
procedure CB20001 is
|
|
|
package Submarine_Tracking renames CB20001_0;
|
package Submarine_Tracking renames CB20001_0;
|
|
|
Trident : Submarine_Tracking.Submarine_Type; -- Declare task
|
Trident : Submarine_Tracking.Submarine_Type; -- Declare task
|
Sonar_Contact : Submarine_Tracking.Location_Type;
|
Sonar_Contact : Submarine_Tracking.Location_Type;
|
|
|
TC_LEB_Error,
|
TC_LEB_Error,
|
TC_Main_Handler_Used : Boolean := False;
|
TC_Main_Handler_Used : Boolean := False;
|
|
|
begin
|
begin
|
|
|
Report.Test ("CB20001", "Check that exceptions can be handled " &
|
Report.Test ("CB20001", "Check that exceptions can be handled " &
|
"in accept bodies");
|
"in accept bodies");
|
|
|
|
|
Off_Screen_Block:
|
Off_Screen_Block:
|
begin
|
begin
|
Sonar_Contact := 1500;
|
Sonar_Contact := 1500;
|
Trident.Contact (Sonar_Contact); -- Cause Off_Screen_Data exception
|
Trident.Contact (Sonar_Contact); -- Cause Off_Screen_Data exception
|
-- to be raised and handled in a task
|
-- to be raised and handled in a task
|
-- accept body.
|
-- accept body.
|
exception
|
exception
|
when Submarine_Tracking.Off_Screen_Data =>
|
when Submarine_Tracking.Off_Screen_Data =>
|
TC_Main_Handler_Used := True;
|
TC_Main_Handler_Used := True;
|
Report.Failed ("Off_Screen_Data exception improperly handled " &
|
Report.Failed ("Off_Screen_Data exception improperly handled " &
|
"in calling procedure");
|
"in calling procedure");
|
when others =>
|
when others =>
|
Report.Failed ("Exception handled unexpectedly in " &
|
Report.Failed ("Exception handled unexpectedly in " &
|
"Off_Screen_Block");
|
"Off_Screen_Block");
|
end Off_Screen_Block;
|
end Off_Screen_Block;
|
|
|
|
|
Location_Error_Block:
|
Location_Error_Block:
|
begin
|
begin
|
Sonar_Contact := 700;
|
Sonar_Contact := 700;
|
Trident.Contact (Sonar_Contact); -- Cause Location_Error exception
|
Trident.Contact (Sonar_Contact); -- Cause Location_Error exception
|
-- to be raised in task accept body,
|
-- to be raised in task accept body,
|
-- propogated to a task block, and
|
-- propogated to a task block, and
|
-- handled there. Corresponding
|
-- handled there. Corresponding
|
-- exception propagated here also.
|
-- exception propagated here also.
|
Report.Failed ("Expected exception not raised");
|
Report.Failed ("Expected exception not raised");
|
exception
|
exception
|
when Submarine_Tracking.Location_Error =>
|
when Submarine_Tracking.Location_Error =>
|
TC_LEB_Error := True;
|
TC_LEB_Error := True;
|
when others =>
|
when others =>
|
Report.Failed ("Exception handled unexpectedly in " &
|
Report.Failed ("Exception handled unexpectedly in " &
|
"Location_Error_Block");
|
"Location_Error_Block");
|
end Location_Error_Block;
|
end Location_Error_Block;
|
|
|
|
|
Incorrect_Data_Block:
|
Incorrect_Data_Block:
|
begin
|
begin
|
Sonar_Contact := 200;
|
Sonar_Contact := 200;
|
Trident.Contact (Sonar_Contact); -- Cause Incorrect_Data exception
|
Trident.Contact (Sonar_Contact); -- Cause Incorrect_Data exception
|
-- to be raised in task accept body,
|
-- to be raised in task accept body,
|
-- propogated to calling procedure.
|
-- propogated to calling procedure.
|
Report.Failed ("Expected exception not raised");
|
Report.Failed ("Expected exception not raised");
|
exception
|
exception
|
when Submarine_Tracking.Incorrect_Data =>
|
when Submarine_Tracking.Incorrect_Data =>
|
Submarine_Tracking.TC_Handled_In_Caller := True;
|
Submarine_Tracking.TC_Handled_In_Caller := True;
|
when others =>
|
when others =>
|
Report.Failed ("Exception handled unexpectedly in " &
|
Report.Failed ("Exception handled unexpectedly in " &
|
"Incorrect_Data_Block");
|
"Incorrect_Data_Block");
|
end Incorrect_Data_Block;
|
end Incorrect_Data_Block;
|
|
|
|
|
if TC_Main_Handler_Used or
|
if TC_Main_Handler_Used or
|
not (Submarine_Tracking.TC_Handled_In_Caller and -- Check to see that
|
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_Task_Block and -- all exceptions
|
Submarine_Tracking.TC_Handled_In_Accept and -- were handled in
|
Submarine_Tracking.TC_Handled_In_Accept and -- were handled in
|
Submarine_Tracking.TC_Reraised_In_Accept and -- proper locations.
|
Submarine_Tracking.TC_Reraised_In_Accept and -- proper locations.
|
TC_LEB_Error)
|
TC_LEB_Error)
|
then
|
then
|
Report.Failed ("Exceptions handled in incorrect locations");
|
Report.Failed ("Exceptions handled in incorrect locations");
|
end if;
|
end if;
|
|
|
if Integer(Submarine_Tracking.Current_Position) /= 0 then
|
if Integer(Submarine_Tracking.Current_Position) /= 0 then
|
Report.Failed ("Variable incorrectly written in task processing");
|
Report.Failed ("Variable incorrectly written in task processing");
|
end if;
|
end if;
|
|
|
delay ImpDef.Minimum_Task_Switch;
|
delay ImpDef.Minimum_Task_Switch;
|
if Trident'Callable then
|
if Trident'Callable then
|
Report.Failed ("Task didn't terminate with exception propagation");
|
Report.Failed ("Task didn't terminate with exception propagation");
|
end if;
|
end if;
|
|
|
Report.Result;
|
Report.Result;
|
|
|
end CB20001;
|
end CB20001;
|
|
|
