diff options
Diffstat (limited to 'gcc/testsuite/ada/acats/tests/cb/cb20001.a')
| -rw-r--r-- | gcc/testsuite/ada/acats/tests/cb/cb20001.a | 228 |
1 files changed, 0 insertions, 228 deletions
diff --git a/gcc/testsuite/ada/acats/tests/cb/cb20001.a b/gcc/testsuite/ada/acats/tests/cb/cb20001.a deleted file mode 100644 index ccfad52e41e..00000000000 --- a/gcc/testsuite/ada/acats/tests/cb/cb20001.a +++ /dev/null @@ -1,228 +0,0 @@ --- 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; |