--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/gcc/testsuite/ada/acats/tests/c9/c954010.a	Fri Oct 27 22:46:09 2017 +0900
@@ -0,0 +1,286 @@
+-- C954010.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 a requeue within an accept statement does not block.
+--      This test uses: Requeue to an entry in a different task
+--                      Parameterless call
+--                      Requeue with abort
+--
+-- TEST DESCRIPTION:
+--      In the Distributor task, requeue two successive calls on the entries
+--      of two separate target tasks.  Verify that the target tasks are
+--      run in parallel proving that the first requeue does not block
+--      while the first target rendezvous takes place.                 
+--
+--      This series of tests uses a simulation of a transaction driven 
+--      processing system.  Line Drivers accept input from an external source
+--      and build them into transaction records.  These records are then 
+--      encapsulated in message tasks which remain extant for the life of the
+--      transaction in the system. The message tasks put themselves on the 
+--      input queue of a Distributor which, from information in the 
+--      transaction and/or system load conditions forwards them to other 
+--      operating tasks. These in turn might forward the transactions to yet 
+--      other tasks for further action.  The  routing is, in real life, 
+--      dynamic and unpredictable at the time of message generation. All 
+--      rerouting in this  model is done by means of requeues.
+--
+--      This test is directed towards the BLOCKING of the REQUEUE only
+--      If the original caller does not block, the outcome of the test will
+--      not be affected.  If the original caller does not continue after
+--      the return, the test will not pass.  
+--      If the requeue gets placed on the wrong entry a failing test could
+--      pass (eg. if the first message is delivered to the second
+--      computation task and the second message to the first) - a check for
+--      this condition is made in other tests
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+with Report;
+with ImpDef;
+
+procedure C954010 is
+
+   -- Mechanism to count the number of Message tasks completed
+   protected TC_Tasks_Completed is
+      procedure Increment;
+      function  Count return integer;
+   private
+      Number_Complete : integer := 0;
+   end TC_Tasks_Completed;
+   --
+   TC_Expected_To_Complete   : constant integer := 2;
+
+
+   task type Message_Task;
+   type acc_Message_Task is access Message_Task;
+
+   task Line_Driver is
+      entry Start;
+   end Line_Driver;
+
+   task Distributor is 
+      entry Input;
+   end Distributor;
+
+   task Credit_Computation is
+      entry Input;
+   end Credit_Computation;
+
+   task Debit_Computation is
+      entry Input;
+      entry TC_Artificial_Rendezvous_1;      -- test purposes only
+      entry TC_Artificial_Rendezvous_2;      -- test purposes only
+   end Debit_Computation;
+
+   
+   -- Mechanism to count the number of Message tasks completed
+   protected body TC_Tasks_Completed is
+      procedure Increment is
+      begin
+         Number_Complete := Number_Complete + 1;
+      end Increment;
+
+      function Count return integer is
+      begin
+         return Number_Complete;
+      end Count;
+   end TC_Tasks_Completed;
+
+
+
+   -- Assemble messages received from an external source
+   --   Creates a message task for each and sends this to a Distributor 
+   --   for appropriate disposal around the network of tasks
+   --      Such a task would normally be designed to loop continuously
+   --      creating the messages as input is received.  Simulate this 
+   --      but limit it to two dummy messages for this test and allow it
+   --      to terminate at that point
+   --
+   task body Line_Driver is
+
+   begin
+
+      accept Start;      -- Wait for trigger from main
+
+      for i in 1..2 loop
+         declare
+            -- create a new message task 
+            N : acc_Message_Task := new Message_Task; 
+         begin
+            -- preparation code
+            null; -- stub
+
+         end;   -- declare
+      end loop;
+
+   exception
+      when others => 
+         Report.Failed ("Unexpected exception in Line_Driver");
+   end Line_Driver;
+
+
+   task body Message_Task is
+   begin
+      -- Queue up on Distributor's Input queue
+      Distributor.Input;
+      
+      -- After the required computations have been performed
+      -- return the message appropriately (probably to an output
+      -- line driver
+      null;            -- stub
+
+      -- Increment to show completion of this task
+      TC_Tasks_Completed.Increment;
+
+   exception
+      when others => 
+         Report.Failed ("Unexpected exception in Message_Task");
+
+   end Message_Task;
+
+
+   -- Dispose each input message to the appropriate computation tasks
+   --    Normally this would be according to some parameters in the entry
+   --    but this simple test is using parameterless entries.  
+   --
+   task body Distributor is
+     Last_was_for_Credit_Computation : Boolean := false;   -- switch
+   begin
+      loop
+         select
+            accept Input do
+               -- Determine to which task the message should be 
+               -- distributed
+               --      For this test arbitrarily send the first to 
+               --      Credit_Computation and the second to Debit_Computation
+               if Last_was_for_Credit_Computation then
+                  requeue Debit_Computation.Input with abort;
+               else 
+                  Last_was_for_Credit_Computation := true;
+                  requeue Credit_Computation.Input with abort;
+               end if;
+            end Input;
+         or
+            terminate;
+         end select;
+      end loop;
+
+   exception
+      when others => 
+         Report.Failed ("Unexpected exception in Distributor");
+   end Distributor;
+                                          
+                                                
+   -- Computation task.  After the computation is performed the rendezvous
+   -- in the original message task is completed.                              
+   task body Credit_Computation is
+   begin
+      loop
+         select 
+            accept Input do
+               -- Perform the computations required for this message
+               --
+               null;     -- stub
+
+               --   For the test:
+               --   Artificially rendezvous with Debit_Computation.
+               --   If the first requeue in Distributor has blocked 
+               --   waiting for the current rendezvous to complete then the
+               --   second message will not be sent to Debit_Computation 
+               --   which will still be waiting on its Input accept.  
+               --   This task will HANG
+               --
+               Debit_Computation.TC_Artificial_Rendezvous_1;
+               --
+            end Input;
+         or
+            terminate;
+         end select;
+      end loop;
+   exception
+      when others => 
+         Report.Failed ("Unexpected exception in Credit_Computation");
+   end Credit_Computation;
+
+                                                
+   -- Computation task.  After the computation is performed the rendezvous
+   -- in the original message task is completed.                              
+   task body Debit_Computation is
+      Message_Count      : integer := 0;
+      TC_AR1_is_complete : Boolean := false;
+   begin
+      loop
+         select
+            accept Input do
+               -- Perform the computations required for this message
+               null;    -- stub
+            end Input;
+            Message_Count := Message_Count + 1;
+         or
+            -- Guard until the rendezvous with the message for this task
+            -- has completed
+            when Message_Count > 0 =>
+            accept TC_Artificial_Rendezvous_1;    -- see comments in
+                                                  -- Credit_Computation above
+            TC_AR1_is_complete := true; 
+         or
+            -- Completion rendezvous with the main procedure
+            when TC_AR1_is_complete =>
+            accept TC_Artificial_Rendezvous_2;
+         or
+            terminate;
+         end select;
+      end loop;
+   exception
+      when others => 
+         Report.Failed ("Unexpected exception in Debit_Computation");
+
+
+   end Debit_Computation;
+
+
+begin -- c954010
+   Report.Test ("C954010", "Requeue in an accept body does not block");
+
+   Line_Driver.Start;
+
+   -- Ensure that both messages were delivered to the computation tasks
+   -- This shows that both requeues were effective.
+   -- 
+   Debit_Computation.TC_Artificial_Rendezvous_2;
+
+   -- Ensure that the message tasks completed
+   while (TC_Tasks_Completed.Count < TC_Expected_To_Complete) loop
+      delay ImpDef.Minimum_Task_Switch;   
+   end loop;
+
+   Report.Result;
+
+end C954010;