diff options
Diffstat (limited to 'gcc/testsuite/ada/acats/tests/c9/c940005.a')
| -rw-r--r-- | gcc/testsuite/ada/acats/tests/c9/c940005.a | 370 |
1 files changed, 0 insertions, 370 deletions
diff --git a/gcc/testsuite/ada/acats/tests/c9/c940005.a b/gcc/testsuite/ada/acats/tests/c9/c940005.a deleted file mode 100644 index adb58b18ca4..00000000000 --- a/gcc/testsuite/ada/acats/tests/c9/c940005.a +++ /dev/null @@ -1,370 +0,0 @@ --- 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; |