-- 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;