3 -- Grant of Unlimited Rights
5 -- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
6 -- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
7 -- unlimited rights in the software and documentation contained herein.
8 -- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making
9 -- this public release, the Government intends to confer upon all
10 -- recipients unlimited rights equal to those held by the Government.
11 -- These rights include rights to use, duplicate, release or disclose the
12 -- released technical data and computer software in whole or in part, in
13 -- any manner and for any purpose whatsoever, and to have or permit others
18 -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
19 -- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
20 -- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
21 -- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
22 -- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
23 -- PARTICULAR PURPOSE OF SAID MATERIAL.
27 -- Check that items queued on a protected entry are handled FIFO and that
28 -- the 'count attribute of that entry reflects the length of the queue.
31 -- Use a small subset of the freeway ramp simulation shown in other
32 -- tests. With the timing pulse off (which prevents items from being
33 -- removed from the queue) queue up a small number of calls. Start the
34 -- timing pulse and, at the first execution of the entry code, check the
35 -- 'count attribute. Empty the queue. Pass the items being removed from
36 -- the queue to the Ramp_Sensor_01 task; there check that the items are
37 -- arriving in FIFO order. Check the final 'count value
39 -- Send another batch of items at a rate which will, if the delay timing
40 -- of the implementation is reasonable, cause the queue length to
41 -- fluctuate in both directions. Again check that all items arrive
42 -- FIFO. At the end check that the 'count returned to zero reflecting
47 -- 06 Dec 94 SAIC ACVC 2.0
57 TC_Failed_1
: Boolean := false;
61 Report
.Test
("C940013", "Check that queues on protected entries are " &
62 "handled FIFO and that 'count is correct");
64 declare -- encapsulate the test
66 function "+" (Left
: Ada
.Calendar
.Time
; Right
: Duration)
67 return Ada
.Calendar
.Time
renames Ada
.Calendar
."+";
69 -- Weighted load given to each potential problem area and accumulated
70 type Load_Factor
is range 0..8;
71 Clear_Level
: constant Load_Factor
:= 0;
72 Minimum_Level
: constant Load_Factor
:= 1;
73 Moderate_Level
: constant Load_Factor
:= 2;
74 Serious_Level
: constant Load_Factor
:= 4;
75 Critical_Level
: constant Load_Factor
:= 6;
77 TC_Expected_Passage_Total
: constant integer := 624;
79 -- For this test give each vehicle an integer ID incremented
80 -- by one for each successive vehicle. In reality this would be
81 -- a more complex alpha-numeric ID assigned at pickup time.
82 type Vehicle_ID
is range 1..5000;
83 Next_ID
: Vehicle_ID
:= Vehicle_ID
'first;
85 -- In reality this would be about 5 seconds. The default value of
86 -- this constant in the implementation defined package is similar
87 -- but could, of course be considerably different - it would not
90 Pulse_Time_Delta
: duration := ImpDef
.Clear_Ready_Queue
;
93 task Pulse_Task
; -- task to generate a pulse for each ramp
95 -- Carrier task. One is created for each vehicle arriving at the ramp
97 entry Get_ID
(Input_ID
: in Vehicle_ID
);
99 type acc_Vehicle
is access Vehicle
;
101 task Ramp_Sensor_01
is
102 entry Accept_Vehicle
(Input_ID
: in Vehicle_ID
);
103 entry TC_First_Three_Handled
;
107 protected Pulse_State
is
108 procedure Start_Pulse
;
109 procedure Stop_Pulse
;
110 function Pulsing
return Boolean;
112 State
: Boolean := false; -- start test will pulse off
115 protected body Pulse_State
is
117 procedure Start_Pulse
is
122 procedure Stop_Pulse
is
127 function Pulsing
return Boolean is
134 --================================================================
135 protected Test_Ramp
is
137 function Meter_in_use_State
return Boolean;
138 procedure Time_Pulse_Received
;
140 procedure TC_Passage
(Pass_Point
: Integer);
141 function TC_Get_Passage_Total
return integer;
142 function TC_Get_Count
return integer;
146 Release_One_Vehicle
: Boolean := false;
147 -- For this test have Meter_in_Use already set
148 Meter_in_Use
: Boolean := true;
150 TC_Wait_at_Meter_First
: Boolean := true;
151 TC_Entry_Queue_Count
: integer := 0; -- 'count of Wait_at_Meter
152 TC_Passage_Total
: integer := 0;
153 TC_Pass_Point_WAM
: integer := 23;
156 --================================================================
157 protected body Test_Ramp
is
159 -- External call for Meter_in_Use
160 function Meter_in_Use_State
return Boolean is
163 end Meter_in_Use_State
;
165 -- Trace the paths through the various routines by totalling the
166 -- weighted call parameters
167 procedure TC_Passage
(Pass_Point
: Integer) is
169 TC_Passage_Total
:= TC_Passage_Total
+ Pass_Point
;
172 -- For the final check of the whole test
173 function TC_Get_Passage_Total
return integer is
175 return TC_Passage_Total
;
176 end TC_Get_Passage_Total
;
178 function TC_Get_Count
return integer is
180 return TC_Entry_Queue_Count
;
184 -- Here each Vehicle task queues itself awaiting release
186 entry Wait_at_Meter
when Release_One_Vehicle
is
187 -- EXAMPLE OF ENTRY WITH BARRIERS AND PERSISTENT SIGNAL
190 TC_Passage
( TC_Pass_Point_WAM
); -- note passage
191 -- For this test three vehicles are queued before the first
192 -- is released. If the queueing mechanism is working correctly
193 -- the first time we pass through here the entry'count should
195 if TC_Wait_at_Meter_First
then
196 if Wait_at_Meter
'count /= 2 then
199 TC_Wait_at_Meter_First
:= false;
201 TC_Entry_Queue_Count
:= Wait_at_Meter
'count; -- note for later
203 Release_One_Vehicle
:= false; -- Consume the signal
204 null; -- stub ::: Decrement count of number of vehicles on ramp
208 procedure Time_Pulse_Received
is
209 Load
: Load_factor
:= Minimum_Level
; -- for this version of the
210 Freeway_Breakdown
: Boolean := false; -- test, freeway is Minimum
212 -- if broken down, no vehicles are released
213 if not Freeway_Breakdown
then
214 if Load
< Moderate_Level
then
215 Release_One_Vehicle
:= true;
217 null; -- stub ::: If other levels, release every other
218 -- pulse, every third pulse etc.
220 end Time_Pulse_Received
;
223 --================================================================
225 -- Simulate the arrival of a vehicle at the Ramp_Receiver and the
226 -- generation of an accompanying carrier task
227 procedure New_Arrival
is
228 Next_Vehicle_Task
: acc_Vehicle
:= new Vehicle
;
229 TC_Pass_Point
: constant integer := 3;
231 Next_ID
:= Next_ID
+ 1;
232 Next_Vehicle_Task
.Get_ID
(Next_ID
);
233 Test_Ramp
.TC_Passage
( TC_Pass_Point
); -- Note passage through here
238 -- Carrier task. One is created for each vehicle arriving at the ramp
240 This_ID
: Vehicle_ID
;
241 TC_Pass_Point_2
: constant integer := 21;
243 accept Get_ID
(Input_ID
: in Vehicle_ID
) do
247 if Test_Ramp
.Meter_in_Use_State
then
248 Test_Ramp
.TC_Passage
( TC_Pass_Point_2
); -- note passage
249 null; -- stub::: Increment count of number of vehicles on ramp
250 Test_Ramp
.Wait_at_Meter
; -- Queue on the meter entry
253 -- Call to the first in the series of the Ramp_Sensors
254 -- this "passes" the vehicle from one sensor to the next
255 -- Each sensor will requeue the call to the next thus this
256 -- rendezvous will only be completed as the vehicle is released
257 -- by the last sensor on the ramp.
258 Ramp_Sensor_01
.Accept_Vehicle
(This_ID
);
261 Report
.Failed
("Unexpected exception in Vehicle Task");
264 task body Ramp_Sensor_01
is
265 TC_Pass_Point
: constant integer := 31;
266 This_ID
: Vehicle_ID
;
267 TC_Last_ID
: Vehicle_ID
:= Vehicle_ID
'first;
271 accept Accept_Vehicle
(Input_ID
: in Vehicle_ID
) do
272 null; -- stub:::: match up with next Real-Time notification
273 -- from the sensor. Requeue to next ramp sensor
276 -- The following is all Test_Control code
277 Test_Ramp
.TC_Passage
( TC_Pass_Point
); -- note passage
278 -- The items arrive in the order they are taken from
279 -- the Wait_at_Meter entry queue
280 if ( This_ID
- TC_Last_ID
) /= 1 then
281 -- The tasks are being queued (or unqueued) in the
284 ("Queueing on the Wait_at_Meter queue failed");
286 TC_Last_ID
:= This_ID
; -- for the next check
287 if TC_Last_ID
= 4 then
288 -- rendezvous with the test driver
289 accept TC_First_Three_Handled
;
290 elsif TC_Last_ID
= 9 then
291 -- rendezvous with the test driver
301 Report
.Failed
("Unexpected exception in Ramp_Sensor_01");
305 -- Task transmits a synchronizing "pulse" to all ramps
307 task body Pulse_Task
is
308 Pulse_Time
: Ada
.Calendar
.Time
;
310 While not Pulse_State
.Pulsing
loop
311 -- Starts up in the quiescent state
312 delay ImpDef
.Minimum_Task_Switch
;
314 Pulse_Time
:= Ada
.Calendar
.Clock
;
315 While Pulse_State
.Pulsing
loop
316 delay until Pulse_Time
;
317 Test_Ramp
. Time_Pulse_Received
; -- Transmit pulse to test_ramp
318 -- :::::::::: and to all the other ramps
319 Pulse_Time
:= Pulse_Time
+ Pulse_Time_Delta
; -- calculate next
323 Report
.Failed
("Unexpected exception in Pulse_Task");
329 -- Test driver. This is ALL test control code
331 -- Arrange to queue three vehicles on the Wait_at_Meter queue. The
332 -- timing pulse is quiescent so the queue will build
337 delay Pulse_Time_Delta
; -- ensure all is settled
339 Pulse_State
.Start_Pulse
; -- Start the timing pulse, the queue will
342 -- wait here until the first three are complete
343 Ramp_Sensor_01
.TC_First_Three_Handled
;
345 if Test_Ramp
.TC_Get_Count
/= 0 then
346 Report
.Failed
("Intermediate Wait_at_Entry'count is incorrect");
349 -- generate new arrivals at a rate that will make the queue increase
350 -- and decrease "randomly"
353 delay Pulse_Time_Delta
/2;
356 -- wait here till all have been handled
357 Ramp_Sensor_01
.TC_All_Done
;
359 if Test_Ramp
.TC_Get_Count
/= 0 then
360 Report
.Failed
("Final Wait_at_Entry'count is incorrect");
363 Pulse_State
.Stop_Pulse
; -- finish test
366 if TC_Expected_Passage_Total
/= Test_Ramp
.TC_Get_Passage_Total
then
367 Report
.Failed
("Unexpected paths taken");
374 Report
.Failed
("Wait_at_Meter'count incorrect");