Remove old autovect-branch by moving to "dead" directory.

[official-gcc.git] / old-autovect-branch / gcc / testsuite / ada / acats / tests / c9 / c951002.a

-- C951002.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 an entry and a procedure within the same protected object
--      will not be executed simultaneously.
--
-- TEST DESCRIPTION:
--      Two tasks are used.  The first calls an entry who's barrier is set
--      and is thus queued.  The second calls a procedure in the same 
--      protected object.  This procedure clears the entry barrier of the 
--      first then executes a lengthy compute bound procedure.  This is 
--      intended to allow a multiprocessor, or a time-slicing implementation 
--      of a uniprocessor, to (erroneously) permit the first task to continue
--      while the second is still computing.  Flags in each process in the 
--      PO are checked to ensure that they do not run out of sequence or in 
--      parallel.  
--      In the second part of the test another entry and procedure are used
--      but in this case the procedure is started first.  A different task
--      calls the entry AFTER the procedure has started.  If the entry 
--      completes before the procedure the test fails.
--
--      This test will not be effective on a uniprocessor without time-slicing
--      It is designed to increase the chances of failure on a multiprocessor,
--      or a uniprocessor with time-slicing, if the entry and procedure in a 
--      Protected Object are not forced to acquire a single execution 
--      resource.  It is not guaranteed to fail.
--
--
-- CHANGE HISTORY:
--      06 Dec 94   SAIC    ACVC 2.0
--
--!

with Report;
with ImpDef;

procedure C951002 is
   
   -- These global error flags are used for failure conditions within
   -- the protected object.  We cannot call Report.Failed (thus Text_io)
   -- which would result in a bounded error.
   --
   TC_Error_01 : Boolean := false;
   TC_Error_02 : Boolean := false;
   TC_Error_03 : Boolean := false;
   TC_Error_04 : Boolean := false;
   TC_Error_05 : Boolean := false;
   TC_Error_06 : Boolean := false;

begin

   Report.Test ("C951002", "Check that a procedure and an entry body " &
                           "in a protected object will not run concurrently");

   declare -- encapsulate the test
      
      task Credit_Message is
         entry TC_Start;
      end Credit_Message;

      task Credit_Task is
         entry TC_Start;
      end Credit_Task;

      task Debit_Message is
         entry TC_Start;
      end Debit_Message;

      task Debit_Task is
         entry TC_Start;
      end Debit_Task;

      --====================================

      protected Hold is

         entry Wait_for_CR_Underload;
         procedure Clear_CR_Overload;
         entry Wait_for_DB_Underload;
         procedure Set_DB_Overload;
         procedure Clear_DB_Overload;
         --
         function TC_Message_is_Queued return Boolean;

      private
         Credit_Overloaded     : Boolean := true;  -- Test starts in overload
         Debit_Overloaded      : Boolean := false; 
         -- 
         TC_CR_Proc_Finished   : Boolean := false;
         TC_CR_Entry_Finished  : Boolean := false;
         TC_DB_Proc_Finished   : Boolean := false;
         TC_DB_Entry_Finished  : Boolean := false;
      end Hold;
      --====================
      protected body Hold is
   
         entry Wait_for_CR_Underload when not Credit_Overloaded is
         begin
            -- The barrier must only be re-evaluated at the end of the 
            -- of the execution of the procedure, also while the procedure
            -- is executing this entry body must not be executed
            if not TC_CR_Proc_Finished then
               TC_Error_01 := true;  -- Set error indicator
            end if;
            TC_CR_Entry_Finished := true;
         end Wait_for_CR_Underload ;
   
         -- This is the procedure which should NOT be able to run in 
         -- parallel with the entry body
         --
         procedure Clear_CR_Overload is
         begin

            -- The entry body must not be executed until this procedure
            -- is completed.  
            if TC_CR_Entry_Finished then
               TC_Error_02 := true;  -- Set error indicator
            end if;
            Credit_Overloaded := false;   -- clear the entry barrier

            -- Execute an implementation defined compute bound routine which 
            -- is designed to run long enough to allow a task switch on a
            -- time-sliced uniprocessor, or for a multiprocessor to pick up
            -- another task.
            -- 
            ImpDef.Exceed_Time_Slice;
            
            -- Again, the entry body must not be executed until the current 
            -- procedure is completed.  
            --
            if TC_CR_Entry_Finished then
               TC_Error_03 := true;  -- Set error indicator
            end if;
            TC_CR_Proc_Finished := true;

         end Clear_CR_Overload;
   
         --============
         -- The following subprogram and entry body are used in the second
         -- part of the test
         
         entry Wait_for_DB_Underload when not Debit_Overloaded is
         begin
            -- By the time the task that calls this entry is allowed access to
            -- the queue the barrier, which starts off as open, will be closed
            -- by the Set_DB_Overload procedure.  It is only reopened 
            -- at the end of the test
            if not TC_DB_Proc_Finished then
               TC_Error_04 := true;  -- Set error indicator
            end if;
            TC_DB_Entry_Finished := true;
         end Wait_for_DB_Underload ;
   
   
         procedure Set_DB_Overload is
         begin
            -- The task timing is such that this procedure should be started
            -- before the entry is called.  Thus the entry should be blocked
            -- until the end of this procedure which then sets the barrier
            --
            if TC_DB_Entry_Finished then
               TC_Error_05 := true;  -- Set error indicator
            end if;

            -- Execute an implementation defined compute bound routine which 
            -- is designed to run long enough to allow a task switch on a
            -- time-sliced uniprocessor, or for a multiprocessor to pick up
            -- another task
            -- 
            ImpDef.Exceed_Time_Slice;
            
            Debit_Overloaded := true;   -- set the entry barrier

            if TC_DB_Entry_Finished then
               TC_Error_06 := true;  -- Set error indicator
            end if;
            TC_DB_Proc_Finished := true;

         end Set_DB_Overload;
   
         procedure Clear_DB_Overload is
         begin
            Debit_Overloaded := false;  -- open the entry barrier
         end Clear_DB_Overload;

         function TC_Message_is_Queued return Boolean is
         begin
   
            -- returns true when one message arrives on the queue
            return (Wait_for_CR_Underload'Count = 1);   
                                                    
         end TC_Message_is_Queued ;

      end Hold;

      --====================================

      task body Credit_Message is
      begin
         accept TC_Start;
         --::  some application processing.  Part of the process finds that
         --    the Overload threshold has been exceeded for the Credit
         --    application.  This message task queues itself on a queue
         --    waiting till the overload in no longer in effect 
         Hold.Wait_for_CR_Underload;
      exception
         when others =>
            Report.Failed ("Unexpected Exception in Credit_Message Task");
      end Credit_Message;

      task body Credit_Task is
      begin
         accept TC_Start;
         --  Application code here (not shown) determines that the
         --  underload threshold has been reached
         Hold.Clear_CR_Overload;
      exception
         when others =>
            Report.Failed ("Unexpected Exception in Credit_Task");
      end Credit_Task;

      --============== 

      -- The following two tasks are used in the second part of the test

      task body Debit_Message is
      begin
         accept TC_Start;
         --::  some application processing.  Part of the process finds that
         --    the Overload threshold has been exceeded for the Debit 
         --    application.  This message task queues itself on a queue
         --    waiting till the overload is no longer in effect 
         --
         Hold.Wait_for_DB_Underload;
      exception
         when others =>
            Report.Failed ("Unexpected Exception in Debit_Message Task");
      end Debit_Message;

      task body Debit_Task is
      begin
         accept TC_Start;
         --  Application code here (not shown) determines that the
         --  underload threshold has been reached
         Hold.Set_DB_Overload;
      exception
         when others =>
            Report.Failed ("Unexpected Exception in Debit_Task");
      end Debit_Task;
   
   begin -- declare

      Credit_Message.TC_Start;
      
      -- Wait until the message is queued on the entry before starting
      -- the Credit_Task
      while not Hold.TC_Message_is_Queued loop
         delay ImpDef.Minimum_Task_Switch;   
      end loop;
      --
      Credit_Task.TC_Start;

      -- Ensure the first part of the test is complete before continuing
      while not (Credit_Message'terminated and Credit_Task'terminated) loop
         delay ImpDef.Minimum_Task_Switch;   
      end loop;

      --======================================================
      -- Second part of the test


      Debit_Task.TC_Start;
      
      -- Delay long enough to allow a task switch to the Debit_Task and
      -- for it to reach the accept statement and call Hold.Set_DB_Overload
      -- before starting Debit_Message
      --
      delay ImpDef.Switch_To_New_Task;

      Debit_Message.TC_Start;

      while not Debit_Task'terminated loop
         delay ImpDef.Minimum_Task_Switch;   
      end loop;    
  
      Hold.Clear_DB_Overload;  -- Allow completion 
   
   end; -- declare (encapsulation)

   if TC_Error_01 then
      Report.Failed ("Wait_for_CR_Underload executed out of sequence");
   end if;
   if TC_Error_02 then
      Report.Failed ("Credit: Entry executed before procedure");
   end if;
   if TC_Error_03 then
      Report.Failed ("Credit: Entry executed in parallel");
   end if;
   if TC_Error_04 then
      Report.Failed ("Wait_for_DB_Underload executed out of sequence");
   end if;
   if TC_Error_05 then
      Report.Failed ("Debit: Entry executed before procedure");
   end if;
   if TC_Error_06 then
      Report.Failed ("Debit: Entry executed in parallel");
   end if;
   
   Report.Result;

end C951002;