Subversion Repositories openrisc

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