1-- C954021.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 a requeue within a protected entry to an entry in a
28--     different protected object is queued correctly.
29--
30-- TEST DESCRIPTION:
31--      One transaction is sent through to check the paths. After processing
32--      this the Credit task sets the "overloaded" indicator.  Once this
33--      indicator is set the Distributor (a protected object) queues low
34--      priority transactions on a Wait_for_Underload queue in another
35--      protected object using a requeue. The Distributor still delivers high
36--      priority transactions.  After two high priority transactions have been
37--      processed by the Credit task it clears the overload condition.  The
38--      low priority transactions should now be delivered.
39--
40--      This series of tests uses a simulation of a transaction driven
41--      processing system.  Line Drivers accept input from an external source
42--      and build them into transaction records.  These records are then
43--      encapsulated in message tasks which remain extant for the life of the
44--      transaction in the system.  The message tasks put themselves on the
45--      input queue of a Distributor which, from information in the
46--      transaction and/or system load conditions forwards them to other
47--      operating tasks. These in turn might forward the transactions to yet
48--      other tasks for further action.  The routing is, in real life, dynamic
49--      and unpredictable at the time of message generation.  All rerouting in
50--      this  model is done by means of requeues.
51--
52--
53-- CHANGE HISTORY:
54--      06 Dec 94   SAIC    ACVC 2.0
55--      26 Nov 95   SAIC    Fixed shared global variable for ACVC 2.0.1
56--
57--!
58
59with Report;
60with ImpDef;
61
62procedure C954021 is
63
64   -- Arbitrary test values
65   Credit_Return : constant := 1;
66   Debit_Return  : constant := 2;
67
68
69   -- Mechanism to count the number of Credit Message tasks completed
70   protected TC_Tasks_Completed is
71      procedure Increment;
72      function  Count return integer;
73   private
74      Number_Complete : integer := 0;
75   end TC_Tasks_Completed;
76
77
78   TC_Credit_Messages_Expected  : constant integer := 5;
79
80   protected TC_Handshake is
81      procedure Set;
82      function First_Message_Arrived return Boolean;
83   private
84      Arrived_Flag : Boolean := false;
85   end TC_Handshake;
86
87   -- Handshaking mechanism between the Line Driver and the Credit task
88   --
89   protected body TC_Handshake is
90      --
91      procedure Set is
92      begin
93         Arrived_Flag := true;
94      end Set;
95      --
96      function First_Message_Arrived return Boolean is
97      begin
98         return Arrived_Flag;
99      end First_Message_Arrived;
100      --
101   end TC_Handshake;
102
103
104   protected type Shared_Boolean (Initial_Value : Boolean := False) is
105      procedure Set_True;
106      procedure Set_False;
107      function  Value return Boolean;
108   private
109      Current_Value : Boolean := Initial_Value;
110   end Shared_Boolean;
111
112   protected body Shared_Boolean is
113      procedure Set_True is
114      begin
115         Current_Value := True;
116      end Set_True;
117
118      procedure Set_False is
119      begin
120         Current_Value := False;
121      end Set_False;
122
123      function Value return Boolean is
124      begin
125         return Current_Value;
126      end Value;
127   end Shared_Boolean;
128
129   TC_Debit_Message_Complete    : Shared_Boolean (False);
130
131   type Transaction_Code is (Credit, Debit);
132   type Transaction_Priority is (High, Low);
133
134   type Transaction_Record;
135   type acc_Transaction_Record is access Transaction_Record;
136   type Transaction_Record is
137      record
138         ID               : integer := 0;
139         Code             : Transaction_Code := Debit;
140         Priority         : Transaction_Priority := High;
141         Account_Number   : integer := 0;
142         Stock_Number     : integer := 0;
143         Quantity         : integer := 0;
144         Return_Value     : integer := 0;
145         TC_Message_Count : integer := 0;
146         TC_Thru_Dist     : Boolean := false;
147      end record;
148
149
150   task type Message_Task is
151      entry Accept_Transaction (In_Transaction : acc_Transaction_Record);
152   end Message_Task;
153   type acc_Message_Task is access Message_Task;
154
155   task Line_Driver is
156      entry Start;
157   end Line_Driver;
158
159   protected Distributor is
160      procedure Set_Credit_Overloaded;
161      procedure Clear_Credit_Overloaded;
162      function  Credit_is_Overloaded return Boolean;
163      entry     Input (Transaction : acc_Transaction_Record);
164   private
165      Credit_Overloaded : Boolean := false;
166   end Distributor;
167
168   protected Hold is
169      procedure Underloaded;
170      entry Wait_for_Underload (Transaction : acc_Transaction_Record);
171   private
172      Release_All : Boolean := false;
173   end Hold;
174
175   task Credit_Computation is
176      entry Input(Transaction : acc_Transaction_Record);
177   end Credit_Computation;
178
179   task Debit_Computation is
180      entry Input(Transaction : acc_Transaction_Record);
181   end Debit_Computation;
182
183   --
184   -- Dispose each input Transaction_Record to the appropriate
185   -- computation tasks
186   --
187   protected body Distributor is
188
189      procedure Set_Credit_Overloaded is
190      begin
191         Credit_Overloaded := true;
192      end Set_Credit_Overloaded;
193
194      procedure Clear_Credit_Overloaded is
195      begin
196         Credit_Overloaded := false;
197         Hold.Underloaded;       -- Release all held messages
198      end Clear_Credit_Overloaded;
199
200      function  Credit_is_Overloaded return Boolean is
201      begin
202         return Credit_Overloaded;
203      end Credit_is_Overloaded;
204
205
206      entry Input (Transaction : acc_Transaction_Record) when true is
207                                                     -- barrier is always open
208      begin
209         -- Test Control: Set the indicator in the message to show it has
210         -- passed through the Distributor object
211         Transaction.TC_thru_Dist := true;
212
213         -- Pass this transaction on to the appropriate computation
214         -- task but temporarily hold low-priority transactions under
215         -- overload conditions
216         case Transaction.Code is
217            when Credit =>
218               if Credit_Overloaded and Transaction.Priority = Low then
219                  requeue Hold.Wait_for_Underload with abort;
220               else
221                  requeue Credit_Computation.Input with abort;
222              end if;
223            when Debit =>
224              requeue Debit_Computation.Input with abort;
225         end case;
226      end Input;
227   end Distributor;
228
229
230   -- Low priority Message tasks are held on the Wait_for_Underload queue
231   -- while the Credit computation system is overloaded.  Once the Credit
232   -- system reached underload send all queued messages immediately
233   --
234   protected body Hold is
235
236      -- Once this is executed the barrier condition for the entry is
237      -- evaluated
238      procedure Underloaded is
239      begin
240         Release_All := true;
241      end Underloaded;
242
243      entry Wait_for_Underload (Transaction : acc_Transaction_Record)
244                                                     when Release_All is
245      begin
246         requeue Credit_Computation.Input with abort;
247         if Wait_for_Underload'count = 0 then
248            -- Queue is purged.  Set up to hold next batch
249            Release_All := false;
250         end if;
251      end Wait_for_Underload;
252
253   end Hold;
254
255   -- Mechanism to count the number of Message tasks completed (Credit)
256   protected body TC_Tasks_Completed is
257      procedure Increment is
258      begin
259         Number_Complete := Number_Complete + 1;
260      end Increment;
261
262      function Count return integer is
263      begin
264         return Number_Complete;
265      end Count;
266   end TC_Tasks_Completed;
267
268
269   -- Assemble messages received from an external source
270   --   Creates a message task for each. The message tasks remain extant
271   --   for the life of the messages in the system.
272   --      The Line Driver task would normally be designed to loop continuously
273   --      creating the messages as input is received.  Simulate this
274   --      but limit it to the required number of dummy messages needed for
275   --      this test and allow it to terminate at that point.  Artificially
276   --      alternate High and Low priority Credit transactions for this test.
277   --
278   task body Line_Driver is
279      Current_ID       : integer := 1;
280      Current_Priority : Transaction_Priority := High;
281
282      -- Artificial: number of messages required for this test
283      type TC_Trans_Range is range 1..6;
284
285      procedure Build_Credit_Record
286                              ( Next_Transaction : acc_Transaction_Record ) is
287         Dummy_Account : constant integer := 100;
288      begin
289            Next_Transaction.ID := Current_ID;
290            Next_Transaction.Code := Credit;
291            Next_Transaction.Priority := Current_Priority;
292
293            Next_Transaction.Account_Number := Dummy_Account;
294            Current_ID := Current_ID + 1;
295      end Build_Credit_Record;
296
297
298      procedure Build_Debit_Record
299                              ( Next_Transaction : acc_Transaction_Record ) is
300         Dummy_Account : constant integer := 200;
301      begin
302            Next_Transaction.ID := Current_ID;
303            Next_Transaction.Code := Debit;
304
305            Next_Transaction.Account_Number := Dummy_Account;
306            Current_ID := Current_ID + 1;
307      end Build_Debit_Record;
308
309   begin
310
311      accept Start;   -- Wait for trigger from Main
312
313      for Transaction_Numb in TC_Trans_Range loop  -- TC: limit the loop
314         declare
315            -- Create a task for the next message
316            Next_Message_Task : acc_Message_Task := new Message_Task;
317            -- Create a record for it
318            Next_Transaction : acc_Transaction_Record :=
319                                                new Transaction_Record;
320         begin
321            if Transaction_Numb = TC_Trans_Range'first then
322               -- Send the first Credit message
323               Build_Credit_Record ( Next_Transaction );
324               Next_Message_Task.Accept_Transaction ( Next_Transaction );
325               -- TC: Wait until the first message has been received by the
326               -- Credit task and it has set the Overload indicator for the
327               -- Distributor
328               while not TC_Handshake.First_Message_Arrived loop
329                  delay ImpDef.Minimum_Task_Switch;
330               end loop;
331            elsif Transaction_Numb = TC_Trans_Range'last then
332               -- For this test send the last transaction to the Debit task
333               -- to improve the mix
334               Build_Debit_Record( Next_Transaction );
335               Next_Message_Task.Accept_Transaction ( Next_Transaction );
336            else
337               -- TC: Alternate high and low priority transactions
338               if Current_Priority = High then
339                  Current_Priority := Low;
340               else
341                  Current_Priority := High;
342               end if;
343               Build_Credit_Record( Next_Transaction );
344               Next_Message_Task.Accept_Transaction ( Next_Transaction );
345            end if;
346         end;   -- declare
347      end loop;
348
349   exception
350      when others =>
351         Report.Failed ("Unexpected exception in Line_Driver");
352   end Line_Driver;
353
354
355
356
357   task body Message_Task is
358
359      TC_Original_Transaction_Code : Transaction_Code;
360      This_Transaction : acc_Transaction_Record := new Transaction_Record;
361
362   begin
363
364      accept Accept_Transaction (In_Transaction : acc_Transaction_Record) do
365         This_Transaction.all := In_Transaction.all;
366      end Accept_Transaction;
367
368      -- Note the original code to ensure correct return
369      TC_Original_Transaction_Code := This_Transaction.Code;
370
371      -- Queue up on Distributor's Input queue
372      Distributor.Input ( This_Transaction );
373      -- This task will now wait for the requeued rendezvous
374      -- to complete before proceeding
375
376      -- After the required computations have been performed
377      -- return the Transaction_Record appropriately (probably to an output
378      -- line driver)
379      null;            -- stub
380
381      -- For the test check that the return values are as expected
382      if TC_Original_Transaction_Code /= This_Transaction.Code then
383         -- Incorrect rendezvous
384         Report.Failed ("Message Task: Incorrect code returned");
385      end if;
386
387      if This_Transaction.Code = Credit then
388         if This_Transaction.Return_Value  /= Credit_Return   or
389         not This_Transaction.TC_thru_Dist                    then
390            Report.Failed ("Expected path not traversed - Credit");
391         end if;
392         TC_Tasks_Completed.Increment;
393      else
394         if This_Transaction.Return_Value  /= Debit_Return or
395            This_Transaction.TC_Message_Count /= 1         or
396            not This_Transaction.TC_thru_Dist               then
397               Report.Failed ("Expected path not traversed - Debit");
398         end if;
399         TC_Debit_Message_Complete.Set_True;
400      end if;
401
402   exception
403      when others =>
404         Report.Failed ("Unexpected exception in Message_Task");
405   end Message_Task;
406
407
408
409
410
411   -- Computation task.  After the computation is performed the rendezvous
412   -- in the original message task is completed.
413   task body Credit_Computation is
414
415      Message_Count   : integer := 0;
416
417   begin
418      loop
419         select
420            accept Input ( Transaction : acc_Transaction_Record) do
421               if Distributor.Credit_is_Overloaded
422                                    and Transaction.Priority = Low  then
423                  -- We should not be getting any Low Priority messages. They
424                  -- should be waiting on the Hold.Wait_for_Underload
425                  -- queue
426                  Report.Failed
427                     ("Credit Task: Low priority transaction during overload");
428               end if;
429               -- Perform the computations required for this transaction
430               null; -- stub
431
432               -- For the test:
433               if not Transaction.TC_thru_Dist then
434                  Report.Failed
435                         ("Credit Task: Wrong queue, Distributor bypassed");
436               end if;
437               if Transaction.code /= Credit then
438                  Report.Failed
439                         ("Credit Task: Requeue delivered to the wrong queue");
440               end if;
441
442               -- The following is all Test Control code:
443               Transaction.Return_Value := Credit_Return;
444               Message_Count := Message_Count + 1;
445               --
446               -- Now take special action depending on which Message
447               if Message_Count = 1 then
448                  -- After the first message :
449                  Distributor.Set_Credit_Overloaded;
450                  -- Now flag the Line_Driver that the second and subsequent
451                  -- messages may now be sent
452                  TC_Handshake.Set;
453               end if;
454               if Message_Count = 3 then
455                  -- The two high priority transactions created subsequent
456                  -- to the overload have now been processed
457                  Distributor.Clear_Credit_Overloaded;
458               end if;
459            end Input;
460         or
461            terminate;
462         end select;
463      end loop;
464   exception
465      when others =>
466         Report.Failed ("Unexpected exception in Credit_Computation");
467   end Credit_Computation;
468
469
470
471   -- Computation task.  After the computation is performed the rendezvous
472   -- in the original message task is completed.
473   --
474   task body Debit_Computation is
475      Message_Count   : integer := 0;
476   begin
477      loop
478         select
479            accept Input (Transaction : acc_Transaction_Record) do
480               -- Perform the computations required for this message
481               null;      -- stub
482
483               -- For the test:
484               if not Transaction.TC_thru_Dist then
485                  Report.Failed
486                         ("Debit Task: Wrong queue, Distributor bypassed");
487               end if;
488               if Transaction.code /= Debit then
489                  Report.Failed
490                         ("Debit Task: Requeue delivered to the wrong queue");
491               end if;
492
493               -- for the test plug a known value and count
494               Transaction.Return_Value := Debit_Return;
495               -- one, and only one, message should pass through
496               Message_Count := Message_Count + 1;
497               Transaction.TC_Message_Count := Message_Count;
498            end Input;
499         or
500            terminate;
501         end select;
502      end loop;
503   exception
504      when others =>
505         Report.Failed ("Unexpected exception in Debit_Computation");
506   end Debit_Computation;
507
508
509begin
510   Report.Test ("C954021", "Requeue from one entry body to an entry in" &
511                                       " another protected object");
512
513   Line_Driver.Start;  -- Start the test
514
515
516   -- Ensure that the message tasks have completed before reporting result
517   while (TC_Tasks_Completed.Count < TC_Credit_Messages_Expected)
518         and not TC_Debit_Message_Complete.Value loop
519      delay ImpDef.Minimum_Task_Switch;
520   end loop;
521
522   Report.Result;
523
524end C954021;
525