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