summaryrefslogtreecommitdiff
path: root/gcc/testsuite/ada/acats/tests/c9/c951002.a
blob: 65b696c4af93d18771db1200cec784e2231b894d (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
-- C951002.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 an entry and a procedure within the same protected object
--      will not be executed simultaneously.
--
-- TEST DESCRIPTION:
--      Two tasks are used.  The first calls an entry who's barrier is set
--      and is thus queued.  The second calls a procedure in the same 
--      protected object.  This procedure clears the entry barrier of the 
--      first then executes a lengthy compute bound procedure.  This is 
--      intended to allow a multiprocessor, or a time-slicing implementation 
--      of a uniprocessor, to (erroneously) permit the first task to continue
--      while the second is still computing.  Flags in each process in the 
--      PO are checked to ensure that they do not run out of sequence or in 
--      parallel.  
--      In the second part of the test another entry and procedure are used
--      but in this case the procedure is started first.  A different task
--      calls the entry AFTER the procedure has started.  If the entry 
--      completes before the procedure the test fails.
--
--      This test will not be effective on a uniprocessor without time-slicing
--      It is designed to increase the chances of failure on a multiprocessor,
--      or a uniprocessor with time-slicing, if the entry and procedure in a 
--      Protected Object are not forced to acquire a single execution 
--      resource.  It is not guaranteed to fail.
--
--
-- CHANGE HISTORY:
--      06 Dec 94   SAIC    ACVC 2.0
--
--!

with Report;
with ImpDef;

procedure C951002 is
   
   -- These global error flags are used for failure conditions within
   -- the protected object.  We cannot call Report.Failed (thus Text_io)
   -- which would result in a bounded error.
   --
   TC_Error_01 : Boolean := false;
   TC_Error_02 : Boolean := false;
   TC_Error_03 : Boolean := false;
   TC_Error_04 : Boolean := false;
   TC_Error_05 : Boolean := false;
   TC_Error_06 : Boolean := false;

begin

   Report.Test ("C951002", "Check that a procedure and an entry body " &
                           "in a protected object will not run concurrently");

   declare -- encapsulate the test
      
      task Credit_Message is
         entry TC_Start;
      end Credit_Message;

      task Credit_Task is
         entry TC_Start;
      end Credit_Task;

      task Debit_Message is
         entry TC_Start;
      end Debit_Message;

      task Debit_Task is
         entry TC_Start;
      end Debit_Task;

      --====================================

      protected Hold is

         entry Wait_for_CR_Underload;
         procedure Clear_CR_Overload;
         entry Wait_for_DB_Underload;
         procedure Set_DB_Overload;
         procedure Clear_DB_Overload;
         --
         function TC_Message_is_Queued return Boolean;

      private
         Credit_Overloaded     : Boolean := true;  -- Test starts in overload
         Debit_Overloaded      : Boolean := false; 
         -- 
         TC_CR_Proc_Finished   : Boolean := false;
         TC_CR_Entry_Finished  : Boolean := false;
         TC_DB_Proc_Finished   : Boolean := false;
         TC_DB_Entry_Finished  : Boolean := false;
      end Hold;
      --====================
      protected body Hold is
   
         entry Wait_for_CR_Underload when not Credit_Overloaded is
         begin
            -- The barrier must only be re-evaluated at the end of the 
            -- of the execution of the procedure, also while the procedure
            -- is executing this entry body must not be executed
            if not TC_CR_Proc_Finished then
               TC_Error_01 := true;  -- Set error indicator
            end if;
            TC_CR_Entry_Finished := true;
         end Wait_for_CR_Underload ;
   
         -- This is the procedure which should NOT be able to run in 
         -- parallel with the entry body
         --
         procedure Clear_CR_Overload is
         begin

            -- The entry body must not be executed until this procedure
            -- is completed.  
            if TC_CR_Entry_Finished then
               TC_Error_02 := true;  -- Set error indicator
            end if;
            Credit_Overloaded := false;   -- clear the entry barrier

            -- Execute an implementation defined compute bound routine which 
            -- is designed to run long enough to allow a task switch on a
            -- time-sliced uniprocessor, or for a multiprocessor to pick up
            -- another task.
            -- 
            ImpDef.Exceed_Time_Slice;
            
            -- Again, the entry body must not be executed until the current 
            -- procedure is completed.  
            --
            if TC_CR_Entry_Finished then
               TC_Error_03 := true;  -- Set error indicator
            end if;
            TC_CR_Proc_Finished := true;

         end Clear_CR_Overload;
   
         --============
         -- The following subprogram and entry body are used in the second
         -- part of the test
         
         entry Wait_for_DB_Underload when not Debit_Overloaded is
         begin
            -- By the time the task that calls this entry is allowed access to
            -- the queue the barrier, which starts off as open, will be closed
            -- by the Set_DB_Overload procedure.  It is only reopened 
            -- at the end of the test
            if not TC_DB_Proc_Finished then
               TC_Error_04 := true;  -- Set error indicator
            end if;
            TC_DB_Entry_Finished := true;
         end Wait_for_DB_Underload ;
   
   
         procedure Set_DB_Overload is
         begin
            -- The task timing is such that this procedure should be started
            -- before the entry is called.  Thus the entry should be blocked
            -- until the end of this procedure which then sets the barrier
            --
            if TC_DB_Entry_Finished then
               TC_Error_05 := true;  -- Set error indicator
            end if;

            -- Execute an implementation defined compute bound routine which 
            -- is designed to run long enough to allow a task switch on a
            -- time-sliced uniprocessor, or for a multiprocessor to pick up
            -- another task
            -- 
            ImpDef.Exceed_Time_Slice;
            
            Debit_Overloaded := true;   -- set the entry barrier

            if TC_DB_Entry_Finished then
               TC_Error_06 := true;  -- Set error indicator
            end if;
            TC_DB_Proc_Finished := true;

         end Set_DB_Overload;
   
         procedure Clear_DB_Overload is
         begin
            Debit_Overloaded := false;  -- open the entry barrier
         end Clear_DB_Overload;

         function TC_Message_is_Queued return Boolean is
         begin
   
            -- returns true when one message arrives on the queue
            return (Wait_for_CR_Underload'Count = 1);   
                                                    
         end TC_Message_is_Queued ;

      end Hold;

      --====================================

      task body Credit_Message is
      begin
         accept TC_Start;
         --::  some application processing.  Part of the process finds that
         --    the Overload threshold has been exceeded for the Credit
         --    application.  This message task queues itself on a queue
         --    waiting till the overload in no longer in effect 
         Hold.Wait_for_CR_Underload;
      exception
         when others =>
            Report.Failed ("Unexpected Exception in Credit_Message Task");
      end Credit_Message;

      task body Credit_Task is
      begin
         accept TC_Start;
         --  Application code here (not shown) determines that the
         --  underload threshold has been reached
         Hold.Clear_CR_Overload;
      exception
         when others =>
            Report.Failed ("Unexpected Exception in Credit_Task");
      end Credit_Task;

      --============== 

      -- The following two tasks are used in the second part of the test

      task body Debit_Message is
      begin
         accept TC_Start;
         --::  some application processing.  Part of the process finds that
         --    the Overload threshold has been exceeded for the Debit 
         --    application.  This message task queues itself on a queue
         --    waiting till the overload is no longer in effect 
         --
         Hold.Wait_for_DB_Underload;
      exception
         when others =>
            Report.Failed ("Unexpected Exception in Debit_Message Task");
      end Debit_Message;

      task body Debit_Task is
      begin
         accept TC_Start;
         --  Application code here (not shown) determines that the
         --  underload threshold has been reached
         Hold.Set_DB_Overload;
      exception
         when others =>
            Report.Failed ("Unexpected Exception in Debit_Task");
      end Debit_Task;
   
   begin -- declare

      Credit_Message.TC_Start;
      
      -- Wait until the message is queued on the entry before starting
      -- the Credit_Task
      while not Hold.TC_Message_is_Queued loop
         delay ImpDef.Long_Minimum_Task_Switch;   
      end loop;
      --
      Credit_Task.TC_Start;

      -- Ensure the first part of the test is complete before continuing
      while not (Credit_Message'terminated and Credit_Task'terminated) loop
         delay ImpDef.Long_Minimum_Task_Switch;   
      end loop;

      --======================================================
      -- Second part of the test


      Debit_Task.TC_Start;
      
      -- Delay long enough to allow a task switch to the Debit_Task and
      -- for it to reach the accept statement and call Hold.Set_DB_Overload
      -- before starting Debit_Message
      --
      delay ImpDef.Long_Switch_To_New_Task;

      Debit_Message.TC_Start;

      while not Debit_Task'terminated loop
         delay ImpDef.Long_Minimum_Task_Switch;   
      end loop;    
  
      Hold.Clear_DB_Overload;  -- Allow completion 
   
   end; -- declare (encapsulation)

   if TC_Error_01 then
      Report.Failed ("Wait_for_CR_Underload executed out of sequence");
   end if;
   if TC_Error_02 then
      Report.Failed ("Credit: Entry executed before procedure");
   end if;
   if TC_Error_03 then
      Report.Failed ("Credit: Entry executed in parallel");
   end if;
   if TC_Error_04 then
      Report.Failed ("Wait_for_DB_Underload executed out of sequence");
   end if;
   if TC_Error_05 then
      Report.Failed ("Debit: Entry executed before procedure");
   end if;
   if TC_Error_06 then
      Report.Failed ("Debit: Entry executed in parallel");
   end if;
   
   Report.Result;

end C951002;