c940007.a

来自「用于进行gcc测试」· A 代码 · 共 428 行 · 第 1/2 页

-- C940007.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 the body of a protected function declared as an object of a
--      given type can have internal calls to other protected functions and
--      that a protected procedure in such an object can have internal calls
--      to protected procedures and to  protected functions. 
--
-- TEST DESCRIPTION:
--      Simulate a meter at a freeway on-ramp which, when real-time sensors
--      determine that the freeway is becoming saturated, triggers stop lights
--      which control the access of vehicles to prevent further saturation. 
--      Each on-ramp is represented by a protected object of the type Ramp. 
--      The routines to sample and alter the states of the various sensors, to
--      queue the vehicles on the meter and to release them are all part of
--      the  protected object and can be shared by various tasks. Apart from
--      the function/procedure tests this example has a mix of other tasking
--      features.  In this test two objects representing two adjacent ramps
--      are created from the same type.  The same "traffic" is simulated for
--      each ramp.  The results should be identical.
--
--
-- CHANGE HISTORY:
--      06 Dec 94   SAIC    ACVC 2.0
--      13 Nov 95   SAIC    Replaced shared global variable Pulse_Stop
--                          with a protected object.
--                          ACVC 2.0.1
--
--!


with Report;
with ImpDef;
with Ada.Calendar;
        
                
procedure C940007 is

begin

   Report.Test ("C940007", "Check internal calls of protected functions" &
                        " and procedures in objects declared as a type");

   declare  -- encapsulate the test

      function "+" (Left : Ada.Calendar.Time; Right: Duration)
                          return Ada.Calendar.Time renames Ada.Calendar."+";

      -- Weighted load given to each potential problem area and accumulated
      type Load_Factor is range 0..8;
      Clear_Level    : constant Load_Factor := 0;
      Minimum_Level  : constant Load_Factor := 1;
      Moderate_Level : constant Load_Factor := 2;
      Serious_Level  : constant Load_Factor := 4;
      Critical_Level : constant Load_Factor := 6;

      -- Weighted loads given to each  Sample Point (pure weights, not levels)
      Local_Overload_wt            : constant Load_Factor := 1;
      Next_Ramp_in_Overload_wt     : constant Load_Factor := 1;
      Ramp_Junction_in_Overload_wt : constant Load_Factor :=2; --higher wght
      -- ::::  other weighted loads
          
      TC_Expected_Passage_Total : integer := 486;


      -- This is the time between synchronizing pulses to the ramps.
      -- In reality one would expect a time of 5 to 10 seconds.  In
      -- the interests of speeding up the test suite a shorter time
      -- is used
      Pulse_Time_Delta : constant duration := ImpDef.Switch_To_New_Task;


      -- control over stopping tasks
      protected Control is
         procedure Stop_Now;
         function Stop return Boolean;
      private
         Halt : Boolean := False;
      end Control;

      protected body Control is
         procedure Stop_Now is
         begin
            Halt := True;
         end Stop_Now;

         function Stop return Boolean is
         begin
            return Halt;
         end Stop;
      end Control;


      task Pulse_Task;       -- task to generate a pulse for each ramp

      -- Carrier tasks. One is created for each vehicle arriving at each ramp
      task type Vehicle_31;            -- For Ramp_31
      type acc_Vehicle_31 is access Vehicle_31;
      --
      task type Vehicle_32;            -- For Ramp_32
      type acc_Vehicle_32 is access Vehicle_32;
                
      --================================================================
      protected type Ramp is
         function Next_Ramp_in_Overload return Load_Factor;
         function Local_Overload        return Load_Factor;
         function Freeway_Overload      return Load_Factor;
         function Freeway_Breakdown     return Boolean;
         function Meter_in_Use_State    return Boolean;
         procedure Set_Local_Overload;
         procedure Add_Meter_Queue;
         procedure Subtract_Meter_Queue;
         procedure Time_Pulse_Received;
         entry Wait_at_Meter;
         procedure TC_Passage (Pass_Point : Integer);
         function TC_Get_Passage_Total return integer;
         -- ::::::::: many routines are not shown (for example none of the
         --            clears, none of the real-time-sensor handlers)
   
      private

         Release_One_Vehicle : Boolean := false;
         Meter_in_Use        : Boolean := false;
         Fwy_Break_State     : Boolean := false;
               
   
         Ramp_Count : integer range 0..20 := 0;
         Ramp_Count_Threshold : integer := 15;
   
         -- Current state of the various Sample Points
         Local_State     : Load_Factor := Clear_Level;
         Next_Ramp_State : Load_Factor := Clear_Level;
            -- ::::  other Sample Point states not shown
   
         TC_Multiplier    : integer := 1;  -- changed half way through
         TC_Passage_Total : integer := 0;
      end Ramp;  
      --================================================================
      protected body Ramp is
   
            procedure Start_Meter is
            begin
               Meter_in_Use := True;
               null;  -- stub  :::: trigger the metering hardware
            end Start_Meter;
   
         function Meter_in_Use_State return Boolean is
         begin
            return Meter_in_Use;
         end Meter_in_Use_State;

         -- Trace the paths through the various routines by totaling the
         -- weighted call parameters
         procedure TC_Passage (Pass_Point : Integer) is
         begin
            TC_Passage_Total := TC_Passage_Total+(Pass_Point*TC_Multiplier);
         end TC_Passage;
   
         -- For the final check of the whole test
         function TC_Get_Passage_Total return integer is
         begin
            return TC_Passage_Total;
         end TC_Get_Passage_Total;
   
         -- These Set/Clear routines are triggered by real-time sensors that
         -- reflect traffic state
         procedure Set_Local_Overload is
         begin
            Local_State := Local_Overload_wt;
            if not Meter_in_Use then
               Start_Meter;   -- LOCAL INTERNAL PROCEDURE FROM PROCEDURE
            end if;
            -- Change the weights for the paths for the next part of the test
            TC_Multiplier :=5;
         end Set_Local_Overload;
   
         --::::: Set/Clear routines for all the other sensors not shown

         function Local_Overload return Load_Factor is
         begin
            return Local_State;
         end Local_Overload;
   
         function Next_Ramp_in_Overload return Load_Factor is
         begin
            return Next_Ramp_State;
         end Next_Ramp_in_Overload;
   
         -- ::::::::  other overload factor states not shown
   
         -- return the summation of all the load factors