--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/gcc/testsuite/ada/acats/tests/c9/c954018.a	Fri Oct 27 22:46:09 2017 +0900
@@ -0,0 +1,227 @@
+-- C954018.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 if a task is aborted while a requeued call is queued 
+--      on one of its entries the original caller receives Tasking_Error
+--      and the requeuing task is unaffected.
+--         This test uses: Requeue to an entry in a different task
+--                         Parameterless call
+--                         Requeue with abort
+--
+-- TEST DESCRIPTION:
+--      The Intermediate task requeues a call from the Original_Caller to the
+--      Receiver on an entry with a guard that is always false.  While the 
+--      Original_Caller is still queued the Receiver is aborted.
+--      Check that Tasking_Error is raised in the Original_Caller, that the 
+--      Receiver does, indeed, get aborted and the Intermediate task 
+--      is undisturbed.
+--      There are several delay loops in this test any one of which could 
+--      cause it to hang and thus indicate failure.  
+--      
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+
+with Report;
+with ImpDef;
+
+
+procedure C954018 is
+
+
+   -- Protected object to control the shared test variables
+   --
+   protected TC_State is
+      function  On_Entry_Queue return Boolean;
+      procedure Set_On_Entry_Queue; 
+      function  Original_Caller_Complete return Boolean;
+      procedure Set_Original_Caller_Complete;
+      function  Intermediate_Complete return Boolean;
+      procedure Set_Intermediate_Complete;
+   private
+      On_Entry_Queue_Flag           : Boolean := false;
+      Original_Caller_Complete_Flag : Boolean := false;
+      Intermediate_Complete_Flag    : Boolean := false;
+   end TC_State;
+   --
+   --
+   protected body TC_State is
+      function On_Entry_Queue return Boolean is
+      begin 
+         return On_Entry_Queue_Flag;
+      end On_Entry_Queue;
+      
+      procedure Set_On_Entry_Queue is
+      begin
+         On_Entry_Queue_Flag := true; 
+      end Set_On_Entry_Queue; 
+
+      function Original_Caller_Complete return Boolean is
+      begin
+         return Original_Caller_Complete_Flag;
+      end Original_Caller_Complete;
+
+      procedure Set_Original_Caller_Complete is
+      begin
+         Original_Caller_Complete_Flag := true;
+      end Set_Original_Caller_Complete;
+
+      function Intermediate_Complete return Boolean is
+      begin
+         return Intermediate_Complete_Flag;
+      end Intermediate_Complete;
+
+      procedure Set_Intermediate_Complete is
+      begin
+         Intermediate_Complete_Flag := true;
+      end Set_Intermediate_Complete;
+
+   end TC_State;
+
+   --================================
+
+   task Original_Caller is
+      entry Start;
+   end Original_Caller;
+
+   task Intermediate is
+      entry Input;
+      entry TC_Abort_Process_Complete;
+   end Intermediate;
+   
+   task Receiver is
+      entry Input;
+   end Receiver;
+
+   
+   task body Original_Caller is
+   begin 
+      accept Start;    -- wait for the trigger from Main
+
+      Intermediate.Input;
+      Report.Failed ("Tasking_Error not raised in Original_Caller task");
+
+   exception
+      when tasking_error => 
+               TC_State.Set_Original_Caller_Complete; -- expected behavior
+      when others        => 
+               Report.Failed ("Unexpected Exception in Original_Caller task");
+   end Original_Caller;
+   
+   
+   task body Intermediate is
+   begin
+      accept Input do
+         -- Within this accept call another task
+         TC_State.Set_On_Entry_Queue;
+         requeue Receiver.Input with abort;  
+         Report.Failed ("Requeue did not complete the Accept");
+      end Input;
+
+      -- Wait for Main to ensure that the abort housekeeping is finished
+      accept TC_Abort_Process_Complete;
+
+      TC_State.Set_Intermediate_Complete;
+
+   exception
+      when others => 
+              Report.Failed ("Unexpected exception in Intermediate task");
+   end Intermediate;
+
+
+   task body Receiver is
+   begin
+      loop
+         select
+            -- A call to Input will be placed on the queue and never serviced
+            when Report.Equal (1,2) =>     -- Always false
+            accept Input do
+               Report.Failed ("Receiver in Accept");  
+            end Input;
+         or 
+            delay ImpDef.Minimum_Task_Switch;
+         end select;
+      end loop;
+   exception
+      when others =>
+            Report.Failed ("Unexpected Exception in Receiver Task");
+                                                          
+   end Receiver;
+   
+   
+begin
+
+   Report.Test ("C954018", "Requeue: abort the called task" &
+                           " while Caller is still queued");
+
+   Original_Caller.Start;
+
+
+   -- This is the main part of the test  
+
+   -- Wait for the requeue
+   while not TC_State.On_Entry_Queue loop
+      delay ImpDef.Minimum_Task_Switch;
+   end loop;
+
+   -- Delay long enough to ensure that the requeue has "arrived" on 
+   -- the entry queue.  Note: TC_State.Set_On_Entry_Queue is called the
+   -- statement before the requeue
+   --
+   delay ImpDef.Switch_To_New_Task;
+
+   -- At this point the Receiver is guaranteed to have the requeue on
+   -- the entry queue
+   --
+   abort Receiver;
+   
+   -- Wait for the whole of the abort process to complete
+   while not ( Original_Caller'terminated and Receiver'terminated ) loop
+      delay ImpDef.Minimum_Task_Switch;
+   end loop;
+
+
+   -- Inform the Intermediate task that the process is complete to allow
+   -- it to continue to completion itself
+   Intermediate.TC_Abort_Process_Complete;
+
+   -- Wait for everything to settle before reporting the result
+   while not ( Intermediate'terminated ) loop
+      delay ImpDef.Minimum_Task_Switch;
+   end loop;
+   
+
+   if not ( TC_State.Original_Caller_Complete and 
+            TC_State.Intermediate_Complete )       then
+      Report.Failed ("Proper paths not traversed");
+   end if;
+
+   Report.Result;
+
+end C954018;