diff options
Diffstat (limited to 'gcc/testsuite/ada/acats/tests/c9/c940013.a')
| -rw-r--r-- | gcc/testsuite/ada/acats/tests/c9/c940013.a | 379 |
1 files changed, 0 insertions, 379 deletions
diff --git a/gcc/testsuite/ada/acats/tests/c9/c940013.a b/gcc/testsuite/ada/acats/tests/c9/c940013.a deleted file mode 100644 index 58d34bc9697..00000000000 --- a/gcc/testsuite/ada/acats/tests/c9/c940013.a +++ /dev/null @@ -1,379 +0,0 @@ --- C940013.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 items queued on a protected entry are handled FIFO and that --- the 'count attribute of that entry reflects the length of the queue. --- --- TEST DESCRIPTION: --- Use a small subset of the freeway ramp simulation shown in other --- tests. With the timing pulse off (which prevents items from being --- removed from the queue) queue up a small number of calls. Start the --- timing pulse and, at the first execution of the entry code, check the --- 'count attribute. Empty the queue. Pass the items being removed from --- the queue to the Ramp_Sensor_01 task; there check that the items are --- arriving in FIFO order. Check the final 'count value --- --- Send another batch of items at a rate which will, if the delay timing --- of the implementation is reasonable, cause the queue length to --- fluctuate in both directions. Again check that all items arrive --- FIFO. At the end check that the 'count returned to zero reflecting --- the empty queue. --- --- --- CHANGE HISTORY: --- 06 Dec 94 SAIC ACVC 2.0 --- ---! - -with Report; -with ImpDef; -with Ada.Calendar; - -procedure C940013 is - - TC_Failed_1 : Boolean := false; - -begin - - Report.Test ("C940013", "Check that queues on protected entries are " & - "handled FIFO and that 'count is correct"); - - 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; - - TC_Expected_Passage_Total : constant integer := 624; - - -- For this test give each vehicle an integer ID incremented - -- by one for each successive vehicle. In reality this would be - -- a more complex alpha-numeric ID assigned at pickup time. - type Vehicle_ID is range 1..5000; - Next_ID : Vehicle_ID := Vehicle_ID'first; - - -- In reality this would be about 5 seconds. The default value of - -- this constant in the implementation defined package is similar - -- but could, of course be considerably different - it would not - -- affect the test - -- - Pulse_Time_Delta : duration := ImpDef.Clear_Ready_Queue; - - - 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 is - entry Get_ID (Input_ID : in Vehicle_ID); - end Vehicle; - type acc_Vehicle is access Vehicle; - - task Ramp_Sensor_01 is - entry Accept_Vehicle (Input_ID : in Vehicle_ID); - entry TC_First_Three_Handled; - entry TC_All_Done; - end Ramp_Sensor_01; - - protected Pulse_State is - procedure Start_Pulse; - procedure Stop_Pulse; - function Pulsing return Boolean; - private - State : Boolean := false; -- start test will pulse off - end Pulse_State; - - protected body Pulse_State is - - procedure Start_Pulse is - begin - State := true; - end Start_Pulse; - - procedure Stop_Pulse is - begin - State := false; - end Stop_Pulse; - - function Pulsing return Boolean is - begin - return State; - end Pulsing; - - end Pulse_State; - - --================================================================ - protected Test_Ramp is - - function Meter_in_use_State return Boolean; - procedure Time_Pulse_Received; - entry Wait_at_Meter; - procedure TC_Passage (Pass_Point : Integer); - function TC_Get_Passage_Total return integer; - function TC_Get_Count return integer; - - private - - Release_One_Vehicle : Boolean := false; - -- For this test have Meter_in_Use already set - Meter_in_Use : Boolean := true; - - TC_Wait_at_Meter_First : Boolean := true; - TC_Entry_Queue_Count : integer := 0; -- 'count of Wait_at_Meter - TC_Passage_Total : integer := 0; - TC_Pass_Point_WAM : integer := 23; - - end Test_Ramp; - --================================================================ - protected body Test_Ramp is - - -- 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 totalling the - -- weighted call parameters - procedure TC_Passage (Pass_Point : Integer) is - begin - TC_Passage_Total := TC_Passage_Total + Pass_Point; - 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; - - function TC_Get_Count return integer is - begin - return TC_Entry_Queue_Count; - end TC_Get_Count; - - - -- 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 - begin - -- - TC_Passage ( TC_Pass_Point_WAM ); -- note passage - -- For this test three vehicles are queued before the first - -- is released. If the queueing mechanism is working correctly - -- the first time we pass through here the entry'count should - -- reflect this - if TC_Wait_at_Meter_First then - if Wait_at_Meter'count /= 2 then - TC_Failed_1 := true; - end if; - TC_Wait_at_Meter_First := false; - end if; - TC_Entry_Queue_Count := Wait_at_Meter'count; -- note for later - - Release_One_Vehicle := false; -- Consume the signal - null; -- stub ::: Decrement count of number of vehicles on ramp - end Wait_at_Meter; - - - procedure Time_Pulse_Received is - Load : Load_factor := Minimum_Level; -- for this version of the - Freeway_Breakdown : Boolean := false; -- test, freeway is Minimum - begin - -- if broken down, no vehicles are released - if not Freeway_Breakdown then - 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 - Next_ID := Next_ID + 1; - Next_Vehicle_Task.Get_ID(Next_ID); - 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 - This_ID : Vehicle_ID; - TC_Pass_Point_2 : constant integer := 21; - begin - accept Get_ID (Input_ID : in Vehicle_ID) do - This_ID := Input_ID; - end Get_ID; - - if Test_Ramp.Meter_in_Use_State then - Test_Ramp.TC_Passage ( TC_Pass_Point_2 ); -- note passage - null; -- stub::: Increment count of number of vehicles on ramp - Test_Ramp.Wait_at_Meter; -- Queue on the meter entry - end if; - - -- Call to the first in the series of the Ramp_Sensors - -- this "passes" the vehicle from one sensor to the next - -- Each sensor will requeue the call to the next thus this - -- rendezvous will only be completed as the vehicle is released - -- by the last sensor on the ramp. - Ramp_Sensor_01.Accept_Vehicle (This_ID); - exception - when others => - Report.Failed ("Unexpected exception in Vehicle Task"); - end Vehicle; - - task body Ramp_Sensor_01 is - TC_Pass_Point : constant integer := 31; - This_ID : Vehicle_ID; - TC_Last_ID : Vehicle_ID := Vehicle_ID'first; - begin - loop - select - accept Accept_Vehicle (Input_ID : in Vehicle_ID) do - null; -- stub:::: match up with next Real-Time notification - -- from the sensor. Requeue to next ramp sensor - This_ID := Input_ID; - - -- The following is all Test_Control code - Test_Ramp.TC_Passage ( TC_Pass_Point ); -- note passage - -- The items arrive in the order they are taken from - -- the Wait_at_Meter entry queue - if ( This_ID - TC_Last_ID ) /= 1 then - -- The tasks are being queued (or unqueued) in the - -- wrong order - Report.Failed - ("Queueing on the Wait_at_Meter queue failed"); - end if; - TC_Last_ID := This_ID; -- for the next check - if TC_Last_ID = 4 then - -- rendezvous with the test driver - accept TC_First_Three_Handled; - elsif TC_Last_ID = 9 then - -- rendezvous with the test driver - accept TC_All_Done; - end if; - end Accept_Vehicle; - or - terminate; - end select; - end loop; - exception - when others => - Report.Failed ("Unexpected exception in Ramp_Sensor_01"); - end Ramp_Sensor_01; - - - -- Task transmits a synchronizing "pulse" to all ramps - -- - task body Pulse_Task is - Pulse_Time : Ada.Calendar.Time; - begin - While not Pulse_State.Pulsing loop - -- Starts up in the quiescent state - delay ImpDef.Minimum_Task_Switch; - end loop; - Pulse_Time := Ada.Calendar.Clock; - While Pulse_State.Pulsing loop - delay until Pulse_Time; - Test_Ramp. Time_Pulse_Received; -- Transmit pulse to test_ramp - -- :::::::::: and to all the other ramps - 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 - - -- Arrange to queue three vehicles on the Wait_at_Meter queue. The - -- timing pulse is quiescent so the queue will build - for i in 1..3 loop - New_Arrival; - end loop; - - delay Pulse_Time_Delta; -- ensure all is settled - - Pulse_State.Start_Pulse; -- Start the timing pulse, the queue will - -- be serviced - - -- wait here until the first three are complete - Ramp_Sensor_01.TC_First_Three_Handled; - - if Test_Ramp.TC_Get_Count /= 0 then - Report.Failed ("Intermediate Wait_at_Entry'count is incorrect"); - end if; - - -- generate new arrivals at a rate that will make the queue increase - -- and decrease "randomly" - for i in 1..5 loop - New_Arrival; - delay Pulse_Time_Delta/2; - end loop; - - -- wait here till all have been handled - Ramp_Sensor_01.TC_All_Done; - - if Test_Ramp.TC_Get_Count /= 0 then - Report.Failed ("Final Wait_at_Entry'count is incorrect"); - end if; - - Pulse_State.Stop_Pulse; -- finish test - - - if TC_Expected_Passage_Total /= Test_Ramp.TC_Get_Passage_Total then - Report.Failed ("Unexpected paths taken"); - end if; - - - end; -- declare - - if TC_Failed_1 then - Report.Failed ("Wait_at_Meter'count incorrect"); - end if; - - Report.Result; - -end C940013; |