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