OpenCores
URL https://opencores.org/ocsvn/openrisc_me/openrisc_me/trunk

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c9/] [c940005.a] - Blame information for rev 294

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 294 jeremybenn
-- C940005.A
2
--
3
--                             Grant of Unlimited Rights
4
--
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
14
--     to do so.
15
--
16
--                                    DISCLAIMER
17
--
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.
24
--*
25
--
26
-- OBJECTIVE:
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.
31
--
32
-- TEST DESCRIPTION:
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.
42
--
43
--
44
-- CHANGE HISTORY:
45
--      06 Dec 94   SAIC    ACVC 2.0
46
--      13 Nov 95   SAIC    Updated and fixed bugs ACVC 2.0.1
47
--
48
--!
49
 
50
 
51
with Report;
52
with ImpDef;
53
with Ada.Calendar;
54
 
55
procedure C940005 is
56
 
57
begin
58
 
59
   Report.Test ("C940005", "Check internal calls of protected functions" &
60
                        " and procedures");
61
 
62
   declare  -- encapsulate the test
63
 
64
      function "+" (Left : Ada.Calendar.Time; Right: Duration)
65
                            return Ada.Calendar.Time renames Ada.Calendar."+";
66
 
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;
74
 
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
80
 
81
      TC_Multiplier : integer := 1;  -- changed half way through
82
      TC_Expected_Passage_Total : constant integer := 486;
83
 
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
87
      -- is used
88
      Pulse_Time_Delta : constant duration := ImpDef.Long_Switch_To_New_Task;
89
 
90
      -- control over stopping tasks
91
      protected Control is
92
         procedure Stop_Now;
93
         function Stop return Boolean;
94
      private
95
         Halt : Boolean := False;
96
      end Control;
97
 
98
      protected body Control is
99
         procedure Stop_Now is
100
         begin
101
            Halt := True;
102
         end Stop_Now;
103
 
104
         function Stop return Boolean is
105
         begin
106
            return Halt;
107
         end Stop;
108
      end Control;
109
 
110
      task Pulse_Task;       -- task to generate a pulse for each ramp
111
 
112
      -- Carrier task. One is created for each vehicle arriving at the ramp
113
      task type Vehicle;
114
      type acc_Vehicle is access Vehicle;
115
 
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;
127
         entry Wait_at_Meter;
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)
132
 
133
      private
134
 
135
         Release_One_Vehicle : Boolean := false;
136
         Meter_in_Use        : Boolean := false;
137
         Fwy_Break_State     : Boolean := false;
138
 
139
 
140
         Ramp_Count : integer range 0..20 := 0;
141
         Ramp_Count_Threshold : integer := 15;
142
 
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
147
 
148
         TC_Passage_Total : integer := 0;
149
      end Test_Ramp;
150
      --================================================================
151
      protected body Test_Ramp is
152
 
153
            procedure Start_Meter is
154
            begin
155
               Meter_in_Use := True;
156
               null;  -- stub  :::: trigger the metering hardware
157
            end Start_Meter;
158
 
159
         -- External call for Meter_in_Use
160
         function Meter_in_Use_State return Boolean is
161
         begin
162
            return Meter_in_Use;
163
         end Meter_in_Use_State;
164
 
165
         -- Trace the paths through the various routines by totaling the
166
         -- weighted call parameters
167
         procedure TC_Passage (Pass_Point : Integer) is
168
         begin
169
            TC_Passage_Total := TC_Passage_Total+(Pass_Point*TC_Multiplier);
170
         end TC_Passage;
171
 
172
         -- For the final check of the whole test
173
         function TC_Get_Passage_Total return integer is
174
         begin
175
            return TC_Passage_Total;
176
         end TC_Get_Passage_Total;
177
 
178
         -- These Set/Clear routines are triggered by real-time sensors that
179
         -- reflect traffic state
180
         procedure Set_Local_Overload is
181
         begin
182
            Local_State := Local_Overload_wt;
183
            if not Meter_in_Use then
184
               Start_Meter;   -- LOCAL INTERNAL PROCEDURE FROM PROCEDURE
185
            end if;
186
         end Set_Local_Overload;
187
 
188
         --::::: Set/Clear routines for all the other sensors not shown
189
 
190
         function Local_Overload return Load_Factor is
191
         begin
192
            return Local_State;
193
         end Local_Overload;
194
 
195
         function Next_Ramp_in_Overload return Load_Factor is
196
         begin
197
            return Next_Ramp_State;
198
         end Next_Ramp_in_Overload;
199
 
200
         -- ::::::::  other overload factor states not shown
201
 
202
         -- return the summation of all the load factors
203
         function Freeway_Overload return Load_Factor is
204
         begin
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;
209
 
210
         -- Freeway Breakdown is defined as traffic moving < 5mph
211
         function Freeway_Breakdown return Boolean is
212
         begin
213
            return Fwy_Break_State;
214
         end Freeway_Breakdown;
215
 
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;
220
         begin
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
225
            end if;
226
         end Add_Meter_Queue;
227
         --
228
         procedure Subtract_Meter_Queue is
229
            TC_Pass_Point : constant integer := 24;
230
         begin
231
            Ramp_Count := Ramp_Count - 1;
232
            TC_Passage ( TC_Pass_Point );  -- note passage through here
233
         end Subtract_Meter_Queue;
234
 
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;
239
         begin
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
244
         end Wait_at_Meter;
245
 
246
 
247
         procedure Time_Pulse_Received is
248
            Load : Load_factor := Freeway_Overload; -- CALL MULTILEVEL
249
                                                    -- FUNCTION
250
                                                    -- FROM WITHIN PROCEDURE
251
         begin
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;
256
               end if;
257
               null;    -- stub  ::: If other levels, release every other
258
                        --           pulse, every third pulse  etc.
259
            end if;
260
         end Time_Pulse_Received;
261
 
262
      end Test_Ramp;
263
      --================================================================
264
 
265
 
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;
271
      begin
272
         Test_Ramp.TC_Passage ( TC_Pass_Point );  -- Note passage through here
273
         null;
274
      end New_arrival;
275
 
276
 
277
      -- Carrier task. One is created for each vehicle arriving at the ramp
278
      task body Vehicle is
279
         TC_Pass_point   : constant integer :=  1;
280
         TC_Pass_Point_2 : constant integer := 21;
281
         TC_Pass_Point_3 : constant integer :=  2;
282
      begin
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
291
         end if;
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
295
      exception
296
         when others =>
297
               Report.Failed ("Unexpected exception in Vehicle Task");
298
      end Vehicle;
299
 
300
 
301
      -- Task transmits a synchronizing "pulse" to all ramps
302
      --
303
      task body Pulse_Task is
304
         Pulse_Time : Ada.Calendar.Time := Ada.Calendar.Clock;
305
      begin
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
311
         end loop;
312
      exception
313
         when others =>
314
               Report.Failed ("Unexpected exception in Pulse_Task");
315
      end Pulse_Task;
316
 
317
 
318
   begin -- declare
319
 
320
      -- Test driver.  This is ALL test control code
321
 
322
      -- First simulate calls to the protected functions and procedures
323
      -- from without the protected object
324
      --
325
      -- CALL FUNCTIONS
326
      if Test_Ramp.Local_Overload /= Clear_Level then
327
         Report.Failed ("External Call to Local_Overload incorrect");
328
      end if;
329
      if Test_Ramp.Next_Ramp_in_Overload /= Clear_Level then
330
         Report.Failed ("External Call to Next_Ramp_in_Overload incorrect");
331
      end if;
332
      if Test_Ramp.Freeway_Overload /= Clear_Level then
333
         Report.Failed ("External Call to Freeway_Overload incorrect");
334
      end if;
335
 
336
      -- Now Simulate the arrival of a vehicle to verify path through test
337
      New_Arrival;
338
      delay Pulse_Time_Delta*2;  -- allow it to pass through the complex
339
 
340
      TC_Multiplier := 5;  -- change the weights for the paths for the next
341
                           -- part of the test
342
 
343
      -- Simulate a real-time sensor reporting overload
344
      Test_Ramp.Set_Local_Overload;  -- CALL A PROCEDURE  (and change levels)
345
 
346
      -- CALL FUNCTIONS again
347
      if Test_Ramp.Local_Overload /= Minimum_Level then
348
         Report.Failed ("External Call to Local_Overload incorrect - 2");
349
      end if;
350
      if Test_Ramp.Freeway_Overload /= Minimum_Level then
351
         Report.Failed ("External Call to Freeway_Overload incorrect -2");
352
      end if;
353
 
354
      -- Now Simulate the arrival of another vehicle again causing
355
      -- INTERNAL CALLS but following different paths (queuing on the
356
      -- meter etc.)
357
      New_Arrival;
358
      delay Pulse_Time_Delta*2;  -- allow it to pass through the complex
359
 
360
      Control.Stop_Now;  -- finish test
361
 
362
      if TC_Expected_Passage_Total /= Test_Ramp.TC_Get_Passage_Total then
363
         Report.Failed ("Unexpected paths taken");
364
      end if;
365
 
366
   end; -- declare
367
 
368
   Report.Result;
369
 
370
end C940005;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.