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