| -- C940005.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 can have internal calls |
| -- to other protected functions and that the body of a protected |
| -- procedure 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 - in this case only |
| -- one is shown (Test_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. |
| -- |
| -- |
| -- CHANGE HISTORY: |
| -- 06 Dec 94 SAIC ACVC 2.0 |
| -- 13 Nov 95 SAIC Updated and fixed bugs ACVC 2.0.1 |
| -- |
| --! |
| |
| |
| with Report; |
| with ImpDef; |
| with Ada.Calendar; |
| |
| procedure C940005 is |
| |
| begin |
| |
| Report.Test ("C940005", "Check internal calls of protected functions" & |
| " and procedures"); |
| |
| 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_Multiplier : integer := 1; -- changed half way through |
| TC_Expected_Passage_Total : constant 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 task. One is created for each vehicle arriving at the ramp |
| task type Vehicle; |
| type acc_Vehicle is access Vehicle; |
| |
| --================================================================ |
| protected Test_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_Passage_Total : integer := 0; |
| end Test_Ramp; |
| --================================================================ |
| protected body Test_Ramp is |
| |
| procedure Start_Meter is |
| begin |
| Meter_in_Use := True; |
| null; -- stub :::: trigger the metering hardware |
| end Start_Meter; |
| |
| -- External call for Meter_in_Use |
| 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; |
| 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 |
| -- FUNCTION |
| -- 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 Test_Ramp; |
| --================================================================ |
| |
| |
| -- Simulate the arrival of a vehicle at the Ramp_Receiver and the |
| -- generation of an accompanying carrier task |
| procedure New_Arrival is |
| Next_Vehicle_Task: acc_Vehicle := new Vehicle; |
| TC_Pass_Point : constant integer := 3; |
| begin |
| Test_Ramp.TC_Passage ( TC_Pass_Point ); -- Note passage through here |
| null; |
| end New_arrival; |
| |
| |
| -- Carrier task. One is created for each vehicle arriving at the ramp |
| task body Vehicle is |
| TC_Pass_point : constant integer := 1; |
| TC_Pass_Point_2 : constant integer := 21; |
| TC_Pass_Point_3 : constant integer := 2; |
| begin |
| Test_Ramp.TC_Passage ( TC_Pass_Point ); -- note passage through here |
| if Test_Ramp.Meter_in_Use_State then |
| Test_Ramp.TC_Passage ( TC_Pass_Point_2 ); -- note passage |
| -- Increment count of number of vehicles on ramp |
| Test_Ramp.Add_Meter_Queue; -- CALL a protected PROCEDURE |
| -- which is also called from within |
| -- enter the meter queue |
| Test_Ramp.Wait_at_Meter; -- CALL a protected ENTRY |
| end if; |
| Test_Ramp.TC_Passage ( TC_Pass_Point_3 ); -- note passage thru 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; |
| |
| |
| -- 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; |
| Test_Ramp.Time_Pulse_Received; -- causes 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 Test_Ramp.Local_Overload /= Clear_Level then |
| Report.Failed ("External Call to Local_Overload incorrect"); |
| end if; |
| if Test_Ramp.Next_Ramp_in_Overload /= Clear_Level then |
| Report.Failed ("External Call to Next_Ramp_in_Overload incorrect"); |
| end if; |
| if Test_Ramp.Freeway_Overload /= Clear_Level then |
| Report.Failed ("External Call to Freeway_Overload incorrect"); |
| end if; |
| |
| -- Now Simulate the arrival of a vehicle to verify path through test |
| New_Arrival; |
| delay Pulse_Time_Delta*2; -- allow it to pass through the complex |
| |
| TC_Multiplier := 5; -- change the weights for the paths for the next |
| -- part of the test |
| |
| -- Simulate a real-time sensor reporting overload |
| Test_Ramp.Set_Local_Overload; -- CALL A PROCEDURE (and change levels) |
| |
| -- CALL FUNCTIONS again |
| if Test_Ramp.Local_Overload /= Minimum_Level then |
| Report.Failed ("External Call to Local_Overload incorrect - 2"); |
| end if; |
| if Test_Ramp.Freeway_Overload /= Minimum_Level then |
| Report.Failed ("External Call to Freeway_Overload incorrect -2"); |
| end if; |
| |
| -- Now Simulate the arrival of another vehicle again causing |
| -- INTERNAL CALLS but following different paths (queuing on the |
| -- meter etc.) |
| New_Arrival; |
| delay Pulse_Time_Delta*2; -- allow it to pass through the complex |
| |
| Control.Stop_Now; -- finish test |
| |
| if TC_Expected_Passage_Total /= Test_Ramp.TC_Get_Passage_Total then |
| Report.Failed ("Unexpected paths taken"); |
| end if; |
| |
| end; -- declare |
| |
| Report.Result; |
| |
| end C940005; |
