Subversion Repositories openrisc

-- 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.Long_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

         function Freeway_Overload return Load_Factor is

         begin

            return    Local_Overload                    -- EACH IS A CALL OF A

                      -- + :::: others                  -- FUNCTION FROM WITHIN

                      + Next_Ramp_in_Overload;          -- A FUNCTION

         end Freeway_Overload;

         -- Freeway Breakdown is defined as traffic moving < 5mph

         function Freeway_Breakdown return Boolean is

         begin

            return Fwy_Break_State;

         end Freeway_Breakdown;

         -- Keep count of vehicles currently on meter queue - we can't use

         -- the 'count because we need the outcall trigger

         procedure Add_Meter_Queue is

            TC_Pass_Point : constant integer := 22;

         begin

            Ramp_Count := Ramp_Count + 1;

            TC_Passage ( TC_Pass_Point );  -- note passage through here

            if Ramp_Count > Ramp_Count_Threshold then

               null;  -- :::: stub, trigger surface street notification

            end if;

         end Add_Meter_Queue;

         --

         procedure Subtract_Meter_Queue is

            TC_Pass_Point : constant integer := 24;

         begin

            Ramp_Count := Ramp_Count - 1;

            TC_Passage ( TC_Pass_Point );  -- note passage through here

         end Subtract_Meter_Queue;

         -- Here each Vehicle task queues itself awaiting release

         entry Wait_at_Meter when Release_One_Vehicle is

         -- EXAMPLE OF ENTRY WITH BARRIERS AND PERSISTENT SIGNAL

            TC_Pass_Point : constant integer := 23;

         begin

            TC_Passage ( TC_Pass_Point );   -- note passage through here

            Release_One_Vehicle := false;   -- Consume the signal

            -- Decrement number of vehicles on ramp

            Subtract_Meter_Queue;  -- CALL PROCEDURE FROM WITHIN ENTRY BODY

         end Wait_at_Meter;

         procedure Time_Pulse_Received is

            Load : Load_factor := Freeway_Overload; -- CALL MULTILEVEL FUNCTN

                                                    -- FROM WITHIN PROCEDURE

         begin

            -- if broken down, no vehicles are released

            if not Freeway_Breakdown then    -- CALL FUNCTION FROM A PROCEDURE

               if Load < Moderate_Level then

                  Release_One_Vehicle := true;

               end if;

               null;    -- stub  ::: If other levels, release every other

                        --           pulse, every third pulse  etc.

            end if;

         end Time_Pulse_Received;

      end Ramp;

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

      -- Now create two Ramp objects from this type

      Ramp_31 : Ramp;

      Ramp_32 : Ramp;

      -- Simulate the arrival of a vehicle at the Ramp_Receiver of Ramp_31

      -- and the generation of an accompanying carrier task

      procedure New_Arrival_31 is

         Next_Vehicle_Task_31: acc_Vehicle_31 := new Vehicle_31;

         TC_Pass_Point : constant integer := 3;

      begin

         Ramp_31.TC_Passage ( TC_Pass_Point );  -- Note passage through here

         null;   --::: stub

      end New_arrival_31;

      -- Carrier task. One is created for each vehicle arriving at Ramp_31

      task body Vehicle_31 is

         TC_Pass_point   : constant integer :=  1;

         TC_Pass_Point_2 : constant integer := 21;

         TC_Pass_Point_3 : constant integer :=  2;

      begin

         Ramp_31.TC_Passage ( TC_Pass_Point );  -- note passage through here

         if Ramp_31.Meter_in_Use_State then

            Ramp_31.TC_Passage ( TC_Pass_Point_2 );  -- note passage

            -- Increment count of number of vehicles on ramp

            Ramp_31.Add_Meter_Queue;    -- CALL a protected PROCEDURE

                                          -- which is also called from within

            -- enter the meter queue

            Ramp_31.Wait_at_Meter;      -- CALL a protected ENTRY

         end if;

         Ramp_31.TC_Passage ( TC_Pass_Point_3 );  -- note passage through here

         null;  --:::: call to the first in the series of the Ramp_Sensors

                --     this "passes" the vehicle from one sensor to the next

      exception

         when others =>

               Report.Failed ("Unexpected exception in Vehicle Task");

      end Vehicle_31;

      -- Simulate the arrival of a vehicle at the Ramp_Receiver and the

      -- generation of an accompanying carrier task

      procedure New_Arrival_32 is

         Next_Vehicle_Task_32 : acc_Vehicle_32 := new Vehicle_32;

         TC_Pass_Point : constant integer := 3;

      begin

         Ramp_32.TC_Passage ( TC_Pass_Point );  -- Note passage through here

         null;  --::: stub

      end New_arrival_32;

      -- Carrier task. One is created for each vehicle arriving at Ramp_32

      task body Vehicle_32 is

         TC_Pass_point   : constant integer :=  1;

         TC_Pass_Point_2 : constant integer := 21;

         TC_Pass_Point_3 : constant integer :=  2;

      begin

         Ramp_32.TC_Passage ( TC_Pass_Point );  -- note passage through here

         if Ramp_32.Meter_in_Use_State then

            Ramp_32.TC_Passage ( TC_Pass_Point_2 );  -- note passage

            -- Increment count of number of vehicles on ramp

            Ramp_32.Add_Meter_Queue;    -- CALL a protected PROCEDURE

                                          -- which is also called from within

            -- enter the meter queue

            Ramp_32.Wait_at_Meter;      -- CALL a protected ENTRY

         end if;

         Ramp_32.TC_Passage ( TC_Pass_Point_3 );  -- note passage through here

         null;  --:::: call to the first in the series of the Ramp_Sensors

                --     this "passes" the vehicle from one sensor to the next

      exception

         when others =>

               Report.Failed ("Unexpected exception in Vehicle Task");

      end Vehicle_32;

      -- Task transmits a synchronizing "pulse" to all ramps

      --

      task body Pulse_Task is

         Pulse_Time : Ada.Calendar.Time := Ada.Calendar.Clock;

      begin

         While not Control.Stop loop

            delay until Pulse_Time;

            Ramp_31.Time_Pulse_Received;    -- CALL OF PROCEDURE CAUSES

            Ramp_32.Time_Pulse_Received;    -- INTERNAL CALLS

            -- ::::::::::  and to all the others

            Pulse_Time := Pulse_Time + Pulse_Time_Delta; -- calculate next

         end loop;

      exception

         when others =>

               Report.Failed ("Unexpected exception in Pulse_Task");

      end Pulse_Task;

   begin -- declare

      -- Test driver.  This is ALL test control code

      -- First simulate calls to the protected functions and procedures

      -- from without the protected object

      --

      -- CALL FUNCTIONS

      if not ( Ramp_31.Local_Overload = Clear_Level and

               Ramp_31.Next_Ramp_in_Overload = Clear_Level and

               Ramp_31.Freeway_Overload = Clear_Level ) then

         Report.Failed ("Initial Calls to Ramp_31 incorrect");

      end if;

      if not ( Ramp_32.Local_Overload = Clear_Level and

               Ramp_32.Next_Ramp_in_Overload = Clear_Level and

               Ramp_32.Freeway_Overload = Clear_Level ) then

         Report.Failed ("Initial Calls to Ramp_32 incorrect");

      end if;

      -- Now Simulate the arrival of a vehicle at each ramp to verify

      -- basic paths through the test

      New_Arrival_31;

      New_Arrival_32;

      delay Pulse_Time_Delta*2;  -- allow them to pass through the complex

      -- Simulate real-time sensors reporting overload

      Ramp_31.Set_Local_Overload;  -- CALL A PROCEDURE  (and change levels)

      Ramp_32.Set_Local_Overload;  -- CALL A PROCEDURE  (and change levels)

      -- CALL FUNCTIONS again

      if not ( Ramp_31.Local_Overload = Minimum_Level and

               Ramp_31.Freeway_Overload = Minimum_Level ) then

         Report.Failed ("Secondary Calls to Ramp_31 incorrect");

      end if;

      if not ( Ramp_32.Local_Overload = Minimum_Level and

               Ramp_32.Freeway_Overload = Minimum_Level ) then

         Report.Failed ("Secondary Calls to Ramp_32 incorrect");

      end if;

      -- Now Simulate the arrival of another vehicle at each ramp again causing

      -- INTERNAL CALLS but following different paths (queuing on the

      -- meter etc.)

      New_Arrival_31;

      New_Arrival_32;

      delay Pulse_Time_Delta*2;  -- allow them to pass through the complex

      Control.Stop_Now;  -- finish test

      if not (TC_Expected_Passage_Total = Ramp_31.TC_Get_Passage_Total and

              TC_Expected_Passage_Total = Ramp_32.TC_Get_Passage_Total) then

         Report.Failed ("Unexpected paths taken");

      end if;

   end; -- declare

   Report.Result;

end C940007;