summaryrefslogtreecommitdiff
path: root/gcc/testsuite/ada/acats/tests/c9/c940013.a
blob: 58d34bc9697a8b827a0ea4daf85b31c1da865936 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
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;