view gcc/testsuite/ada/acats/tests/c9/c951001.a @ 158:494b0b89df80 default tip

...
author Shinji KONO <kono@ie.u-ryukyu.ac.jp>
date Mon, 25 May 2020 18:13:55 +0900
parents 04ced10e8804
children
line wrap: on
line source

-- C951001.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 two procedures in a protected object will not be 
--      executed concurrently.
--
-- TEST DESCRIPTION:
--      A very simple example of two tasks calling two procedures in the same 
--      protected object is used.  Test control code has been added to the
--      procedures such that, whichever gets called first executes a lengthy
--      calculation giving sufficient time (on a multiprocessor or a
--      time-slicing machine) for the other task to get control and call the
--      other procedure.  The control code verifies that entry to the second
--      routine is postponed until the first is complete.
--
--
-- CHANGE HISTORY:
--      06 Dec 94   SAIC    ACVC 2.0
--
--!

with Report;
with ImpDef;

procedure C951001 is

   protected Ramp_31 is

      procedure Add_Meter_Queue;
      procedure Subtract_Meter_Queue;
      function  TC_Failed return Boolean;
   
   private

      Ramp_Count : integer range 0..20 := 4;  -- Start test with some
                                              -- vehicles on the ramp
   
      TC_Add_Started       : Boolean := false;
      TC_Subtract_Started  : Boolean := false;
      TC_Add_Finished      : Boolean := false;
      TC_Subtract_Finished : Boolean := false;
      TC_Concurrent_Running: Boolean := false;
      
   end Ramp_31;

   
   protected body Ramp_31 is

      function TC_Failed return Boolean is
      begin
         -- this indicator will have been set true if any instance
         -- of concurrent running has been proved
         return TC_Concurrent_Running;
      end TC_Failed;


      procedure Add_Meter_Queue is
      begin
         --==================================================
         -- This section is all Test_Control code
         TC_Add_Started := true;
         if TC_Subtract_Started then 
            if not TC_Subtract_Finished then
               TC_Concurrent_Running := true;
            end if;
         else
            -- Subtract has not started. 
            -- Execute a lengthy routine to give it a chance to do so
            ImpDef.Exceed_Time_Slice;

            if TC_Subtract_Started then 
               -- Subtract was able to start so we have concurrent 
               -- running and the test has failed
               TC_Concurrent_Running := true;
            end if;
         end if;
         TC_Add_Finished := true;
         --==================================================
         Ramp_Count := Ramp_Count + 1;
      end Add_Meter_Queue;

      procedure Subtract_Meter_Queue is
      begin
         --==================================================
         -- This section is all Test_Control code
         TC_Subtract_Started := true;
         if TC_Add_Started then 
            if not TC_Add_Finished then
               -- We already have concurrent running
               TC_Concurrent_Running := true;
            end if;
         else
            -- Add has not started. 
            -- Execute a lengthy routine to give it a chance to do so
            ImpDef.Exceed_Time_Slice;

            if TC_Add_Started then 
               -- Add was able to start so we have concurrent 
               -- running and the test has failed
               TC_Concurrent_Running := true;
            end if;
         end if;
         TC_Subtract_Finished := true;
         --==================================================
         Ramp_Count := Ramp_Count - 1;
      end Subtract_Meter_Queue;
   
   end Ramp_31;

begin

   Report.Test ("C951001", "Check that two procedures in a protected" &
                           " object will not be executed concurrently");

   declare -- encapsulate the test

      task Vehicle_1;
      task Vehicle_2;


      -- Vehicle_1 and Vehicle_2 are simulations of Instances of the task
      -- of type Vehicle in different stages of execution

      task body Vehicle_1 is
      begin
         null;  -- ::::: stub.  preparation code
         
         -- Add to the count of vehicles on the queue   
         Ramp_31.Add_Meter_Queue;

         null;  -- ::::: stub:  wait at the meter then pass to first sensor

         -- Reduce the count of vehicles on the queue
         null;  -- ::::: stub: Ramp_31.Subtract_Meter_Queue
      exception
         when others =>
               Report.Failed ("Unexpected Exception in Vehicle_1 task");
      end Vehicle_1;


      task body Vehicle_2 is
      begin
         null;  -- ::::: stub.  preparation code
         
         -- Add to the count of vehicles on the queue   
         null;  -- ::::: stub Ramp_31.Add_Meter_Queue;  

         null;  -- ::::: stub:  wait at the meter then pass to first sensor

         -- Reduce the count of vehicles on the queue
         Ramp_31.Subtract_Meter_Queue;
      exception
         when others =>
               Report.Failed ("Unexpected Exception in Vehicle_2 task");
      end Vehicle_2;

  

   begin
      null;
   end;   -- encapsulation

   if Ramp_31.TC_Failed then
      Report.Failed ("Concurrent Running detected");
   end if;

   Report.Result;

end C951001;