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, 379 insertions, 0 deletions
diff --git a/gcc/testsuite/ada/acats/tests/c9/c940013.a b/gcc/testsuite/ada/acats/tests/c9/c940013.a new file mode 100644 index 000000000..58d34bc96 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/c9/c940013.a @@ -0,0 +1,379 @@ +-- 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; |