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 the body of a protected function can have internal calls
28 -- to other protected functions and that the body of a protected
29 -- procedure can have internal calls to protected procedures and to
30 -- protected functions.
33 -- Simulate a meter at a freeway on-ramp which, when real-time sensors
34 -- determine that the freeway is becoming saturated, triggers stop lights
35 -- which control the access of vehicles to prevent further saturation.
36 -- Each on-ramp is represented by a protected object - in this case only
37 -- one is shown (Test_Ramp). The routines to sample and alter the states
38 -- of the various sensors, to queue the vehicles on the meter and to
39 -- release them are all part of the protected object and can be shared
40 -- by various tasks. Apart from the function/procedure tests this example
41 -- has a mix of other tasking features.
45 -- 06 Dec 94 SAIC ACVC 2.0
46 -- 13 Nov 95 SAIC Updated and fixed bugs ACVC 2.0.1
59 Report
.Test
("C940005", "Check internal calls of protected functions" &
62 declare -- encapsulate the test
64 function "+" (Left
: Ada
.Calendar
.Time
; Right
: Duration)
65 return Ada
.Calendar
.Time
renames Ada
.Calendar
."+";
67 -- Weighted load given to each potential problem area and accumulated
68 type Load_Factor
is range 0..8;
69 Clear_Level
: constant Load_Factor
:= 0;
70 Minimum_Level
: constant Load_Factor
:= 1;
71 Moderate_Level
: constant Load_Factor
:= 2;
72 Serious_Level
: constant Load_Factor
:= 4;
73 Critical_Level
: constant Load_Factor
:= 6;
75 -- Weighted loads given to each Sample Point (pure weights, not levels)
76 Local_Overload_wt
: constant Load_Factor
:= 1;
77 Next_Ramp_in_Overload_wt
: constant Load_Factor
:= 1;
78 Ramp_Junction_in_Overload_wt
: constant Load_Factor
:=2; --higher wght
79 -- :::: other weighted loads
81 TC_Multiplier
: integer := 1; -- changed half way through
82 TC_Expected_Passage_Total
: constant integer := 486;
84 -- This is the time between synchronizing pulses to the ramps.
85 -- In reality one would expect a time of 5 to 10 seconds. In
86 -- the interests of speeding up the test suite a shorter time
88 Pulse_Time_Delta
: constant duration := ImpDef
.Switch_To_New_Task
;
90 -- control over stopping tasks
93 function Stop
return Boolean;
95 Halt
: Boolean := False;
98 protected body Control
is
104 function Stop
return Boolean is
110 task Pulse_Task
; -- task to generate a pulse for each ramp
112 -- Carrier task. One is created for each vehicle arriving at the ramp
114 type acc_Vehicle
is access Vehicle
;
116 --================================================================
117 protected Test_Ramp
is
118 function Next_Ramp_in_Overload
return Load_Factor
;
119 function Local_Overload
return Load_Factor
;
120 function Freeway_Overload
return Load_Factor
;
121 function Freeway_Breakdown
return Boolean;
122 function Meter_in_use_State
return Boolean;
123 procedure Set_Local_Overload
;
124 procedure Add_Meter_Queue
;
125 procedure Subtract_Meter_Queue
;
126 procedure Time_Pulse_Received
;
128 procedure TC_Passage
(Pass_Point
: Integer);
129 function TC_Get_Passage_Total
return integer;
130 -- ::::::::: many routines are not shown (for example none of the
131 -- clears, none of the real-time-sensor handlers)
135 Release_One_Vehicle
: Boolean := false;
136 Meter_in_Use
: Boolean := false;
137 Fwy_Break_State
: Boolean := false;
140 Ramp_Count
: integer range 0..20 := 0;
141 Ramp_Count_Threshold
: integer := 15;
143 -- Current state of the various Sample Points
144 Local_State
: Load_Factor
:= Clear_Level
;
145 Next_Ramp_State
: Load_Factor
:= Clear_Level
;
146 -- :::: other Sample Point states not shown
148 TC_Passage_Total
: integer := 0;
150 --================================================================
151 protected body Test_Ramp
is
153 procedure Start_Meter
is
155 Meter_in_Use
:= True;
156 null; -- stub :::: trigger the metering hardware
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 totaling the
166 -- weighted call parameters
167 procedure TC_Passage
(Pass_Point
: Integer) is
169 TC_Passage_Total
:= TC_Passage_Total
+(Pass_Point
*TC_Multiplier
);
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 -- These Set/Clear routines are triggered by real-time sensors that
179 -- reflect traffic state
180 procedure Set_Local_Overload
is
182 Local_State
:= Local_Overload_wt
;
183 if not Meter_in_Use
then
184 Start_Meter
; -- LOCAL INTERNAL PROCEDURE FROM PROCEDURE
186 end Set_Local_Overload
;
188 --::::: Set/Clear routines for all the other sensors not shown
190 function Local_Overload
return Load_Factor
is
195 function Next_Ramp_in_Overload
return Load_Factor
is
197 return Next_Ramp_State
;
198 end Next_Ramp_in_Overload
;
200 -- :::::::: other overload factor states not shown
202 -- return the summation of all the load factors
203 function Freeway_Overload
return Load_Factor
is
205 return Local_Overload
-- EACH IS A CALL OF A
206 -- + :::: others -- FUNCTION FROM WITHIN
207 + Next_Ramp_in_Overload
; -- A FUNCTION
208 end Freeway_Overload
;
210 -- Freeway Breakdown is defined as traffic moving < 5mph
211 function Freeway_Breakdown
return Boolean is
213 return Fwy_Break_State
;
214 end Freeway_Breakdown
;
216 -- Keep count of vehicles currently on meter queue - we can't use
217 -- the 'count because we need the outcall trigger
218 procedure Add_Meter_Queue
is
219 TC_Pass_Point
: constant integer := 22;
221 Ramp_Count
:= Ramp_Count
+ 1;
222 TC_Passage
( TC_Pass_Point
); -- note passage through here
223 if Ramp_Count
> Ramp_Count_Threshold
then
224 null; -- :::: stub, trigger surface street notification
228 procedure Subtract_Meter_Queue
is
229 TC_Pass_Point
: constant integer := 24;
231 Ramp_Count
:= Ramp_Count
- 1;
232 TC_Passage
( TC_Pass_Point
); -- note passage through here
233 end Subtract_Meter_Queue
;
235 -- Here each Vehicle task queues itself awaiting release
236 entry Wait_at_Meter
when Release_One_Vehicle
is
237 -- EXAMPLE OF ENTRY WITH BARRIERS AND PERSISTENT SIGNAL
238 TC_Pass_Point
: constant integer := 23;
240 TC_Passage
( TC_Pass_Point
); -- note passage through here
241 Release_One_Vehicle
:= false; -- Consume the signal
242 -- Decrement number of vehicles on ramp
243 Subtract_Meter_Queue
; -- CALL PROCEDURE FROM WITHIN ENTRY BODY
247 procedure Time_Pulse_Received
is
248 Load
: Load_factor
:= Freeway_Overload
; -- CALL MULTILEVEL
250 -- FROM WITHIN PROCEDURE
252 -- if broken down, no vehicles are released
253 if not Freeway_Breakdown
then -- CALL FUNCTION FROM A PROCEDURE
254 if Load
< Moderate_Level
then
255 Release_One_Vehicle
:= true;
257 null; -- stub ::: If other levels, release every other
258 -- pulse, every third pulse etc.
260 end Time_Pulse_Received
;
263 --================================================================
266 -- Simulate the arrival of a vehicle at the Ramp_Receiver and the
267 -- generation of an accompanying carrier task
268 procedure New_Arrival
is
269 Next_Vehicle_Task
: acc_Vehicle
:= new Vehicle
;
270 TC_Pass_Point
: constant integer := 3;
272 Test_Ramp
.TC_Passage
( TC_Pass_Point
); -- Note passage through here
277 -- Carrier task. One is created for each vehicle arriving at the ramp
279 TC_Pass_point
: constant integer := 1;
280 TC_Pass_Point_2
: constant integer := 21;
281 TC_Pass_Point_3
: constant integer := 2;
283 Test_Ramp
.TC_Passage
( TC_Pass_Point
); -- note passage through here
284 if Test_Ramp
.Meter_in_Use_State
then
285 Test_Ramp
.TC_Passage
( TC_Pass_Point_2
); -- note passage
286 -- Increment count of number of vehicles on ramp
287 Test_Ramp
.Add_Meter_Queue
; -- CALL a protected PROCEDURE
288 -- which is also called from within
289 -- enter the meter queue
290 Test_Ramp
.Wait_at_Meter
; -- CALL a protected ENTRY
292 Test_Ramp
.TC_Passage
( TC_Pass_Point_3
); -- note passage thru here
293 null; --:::: call to the first in the series of the Ramp_Sensors
294 -- this "passes" the vehicle from one sensor to the next
297 Report
.Failed
("Unexpected exception in Vehicle Task");
301 -- Task transmits a synchronizing "pulse" to all ramps
303 task body Pulse_Task
is
304 Pulse_Time
: Ada
.Calendar
.Time
:= Ada
.Calendar
.Clock
;
306 While not Control
.Stop
loop
307 delay until Pulse_Time
;
308 Test_Ramp
.Time_Pulse_Received
; -- causes INTERNAL CALLS
309 -- :::::::::: and to all the others
310 Pulse_Time
:= Pulse_Time
+ Pulse_Time_Delta
; -- calculate next
314 Report
.Failed
("Unexpected exception in Pulse_Task");
320 -- Test driver. This is ALL test control code
322 -- First simulate calls to the protected functions and procedures
323 -- from without the protected object
326 if Test_Ramp
.Local_Overload
/= Clear_Level
then
327 Report
.Failed
("External Call to Local_Overload incorrect");
329 if Test_Ramp
.Next_Ramp_in_Overload
/= Clear_Level
then
330 Report
.Failed
("External Call to Next_Ramp_in_Overload incorrect");
332 if Test_Ramp
.Freeway_Overload
/= Clear_Level
then
333 Report
.Failed
("External Call to Freeway_Overload incorrect");
336 -- Now Simulate the arrival of a vehicle to verify path through test
338 delay Pulse_Time_Delta
*2; -- allow it to pass through the complex
340 TC_Multiplier
:= 5; -- change the weights for the paths for the next
343 -- Simulate a real-time sensor reporting overload
344 Test_Ramp
.Set_Local_Overload
; -- CALL A PROCEDURE (and change levels)
346 -- CALL FUNCTIONS again
347 if Test_Ramp
.Local_Overload
/= Minimum_Level
then
348 Report
.Failed
("External Call to Local_Overload incorrect - 2");
350 if Test_Ramp
.Freeway_Overload
/= Minimum_Level
then
351 Report
.Failed
("External Call to Freeway_Overload incorrect -2");
354 -- Now Simulate the arrival of another vehicle again causing
355 -- INTERNAL CALLS but following different paths (queuing on the
358 delay Pulse_Time_Delta
*2; -- allow it to pass through the complex
360 Control
.Stop_Now
; -- finish test
362 if TC_Expected_Passage_Total
/= Test_Ramp
.TC_Get_Passage_Total
then
363 Report
.Failed
("Unexpected paths taken");