--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/gcc/testsuite/ada/acats/tests/c9/c954022.a	Fri Oct 27 22:46:09 2017 +0900
@@ -0,0 +1,351 @@
+-- C954022.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:
+--      In an entry body requeue the call to the same entry.  Check that the
+--      items go to the right queue and that they are placed back on the end 
+--      of the queue
+--
+-- TEST DESCRIPTION:
+--      Simulate part of a message handling application where the messages are
+--      composed of several segments.  The sequence of the segments within the
+--      message is specified by Seg_Sequence_No.   The segments are handled by
+--      different tasks and finally forwarded to an output driver.  The
+--      segments can arrive in any order but must be assembled into the proper
+--      sequence for final output.  There is a Sequencer task interposed
+--      before the Driver.  This takes the segments of the message off the
+--      Ordering_Queue and those that are in the right order it sends on to
+--      the driver; those that are out of order it places back on the end of
+--      the queue.
+--
+--      The test just simulates the arrival of the segments at the Sequencer.
+--      The task generating the segments handshakes with the Sequencer during
+--      the  "Await Arrival" phase  ensuring that the three segments of a
+--      message arrive in REVERSE order (the End-of-Message segment arrives
+--      first and the Header last).  In the first cycle the sequencer pulls
+--      segments off the queue and puts them back on the end till it
+--      encounters the header.  It checks the sequence of the ones it pulls
+--      off in case the segments are being put back on in the wrong part of
+--      the queue.  Having cycled once through it no longer verifies the
+--      sequence - it just executes the "application" code for the correct
+--      order for dispatch to the driver.
+-- 
+--      In this simple example no attempt is made to address segments of
+--      another message arriving or any other error conditions (such as
+--      missing segments, timing etc.)
+-- 
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      07 Nov 95   SAIC    ACVC 2.0.1
+--
+--!
+
+with Report;
+with ImpDef;
+
+procedure C954022 is
+
+   -- These global Booleans are set when failure conditions inside Protected
+   -- objects are encountered.  Report.Failed cannot be called within
+   -- the object or a Bounded Error would occur
+   --
+   TC_Failed_1 : Boolean := false;
+   TC_Failed_2 : Boolean := false;
+   TC_Failed_3 : Boolean := false;
+
+begin
+
+
+   Report.Test ("C954022", "Check Requeue to the same Protected Entry");
+   
+   declare  -- encapsulate the test
+
+      type Segment_Sequence is range 1..8;
+      Header : constant Segment_Sequence := Segment_Sequence'first;
+
+      type Message_Segment is record
+         ID              : integer;            -- Message ID
+         Seg_Sequence_No : Segment_Sequence;   -- Within the message
+         Segs_In_Message : integer;            -- Total segs this message
+         EOM             : Boolean := false;   -- true for final msg segment
+         Alpha           : string (1..128);
+      end record;
+      type acc_Message_Segment is access Message_Segment;
+
+      task TC_Simulate_Arrival;
+   
+      task type Carrier_Task is
+         entry Input ( Segment : acc_Message_Segment );
+      end Carrier_Task;
+      type acc_Carrier_Task is access Carrier_Task;
+   
+      protected Sequencer is
+         function  TC_Arrivals return integer;
+         entry Input          ( Segment : acc_Message_Segment );
+         entry Ordering_Queue ( Segment : acc_Message_Segment );
+      private
+         Number_of_Segments_Arrived  : integer := 0;
+         Number_of_Segments_Expected : integer := 0;
+         Next_Needed : Segment_Sequence := Header;
+         All_Segments_Arrived : Boolean := false;
+         Seen_EOM             : Boolean := false;
+
+         TC_First_Cycle       : Boolean := true;
+         TC_Expected_Sequence : Segment_Sequence := Header+2;
+
+      end Sequencer;
+   
+
+      task Output_Driver is
+         entry Input ( Segment : acc_Message_Segment );
+      end Output_Driver;
+   
+
+      -- Simulate the arrival of three message segments in REVERSE order
+      --
+      task body TC_Simulate_Arrival is
+         begin
+            for i in 1..3 loop
+               declare
+                  -- Create a task for the next message segment
+                  Next_Segment_Task : acc_Carrier_Task := new Carrier_Task;
+                  -- Create a record for the next segment
+                  Next_Segment : acc_Message_Segment := new Message_Segment;
+               begin
+                  if i = 1 then 
+                     -- Build the EOM segment as the first to "send"
+                     Next_Segment.Seg_Sequence_No := Header + 2;
+                     Next_Segment.Segs_In_Message := 3;
+                     Next_Segment.EOM := true;
+                  elsif i = 2 then
+                     -- Wait for the first segment to arrive at the Sequencer
+                     -- before "sending" the second
+                     while Sequencer.TC_Arrivals < 1 loop
+                        delay ImpDef.Minimum_Task_Switch;
+                     end loop;
+                     -- Build the segment
+                     Next_Segment.Seg_Sequence_No := Header +1;
+                  else
+                     -- Wait for the second segment to arrive at the Sequencer
+                     -- before "sending" the third
+                     while Sequencer.TC_Arrivals < 2 loop
+                        delay ImpDef.Minimum_Task_Switch;
+                     end loop;                  
+                     -- Build the segment. The last segment (in order) to
+                     -- arrive will be the "header" segment
+                     Next_Segment.Seg_Sequence_No := Header;
+                  end if;
+                  -- pass the record to its carrier
+                  Next_Segment_Task.Input ( Next_Segment );
+               end;
+            end loop;
+ 
+
+      exception
+         when others => 
+              Report.Failed ("Unexpected Exception in TC_Simulate_Arrival");
+      end TC_Simulate_Arrival;
+   
+
+      -- One of these is generated for each message segment and the flow 
+      -- of the segments through the system is controlled by the calls the
+      -- task makes and the requeues of those calls
+      --
+      task body Carrier_Task is
+         This_Segment : acc_Message_Segment := new Message_Segment;
+      begin
+         accept Input ( Segment : acc_Message_Segment ) do
+            This_Segment.all := Segment.all;
+         end Input;
+         null; --:: stub.  Pass the segment around the application as needed
+
+         -- Now output the segment to the Output_Driver.  First we have to 
+         -- go through the Sequencer.  
+         Sequencer.Input ( This_Segment );
+      exception
+         when others => 
+              Report.Failed ("Unexpected Exception in Carrier_Task");
+      end Carrier_Task;
+   
+      -- Store segments on the Ordering_Queue then deliver them in the correct
+      -- sequence to the Output_Driver.
+      --
+      protected body Sequencer is
+
+         function  TC_Arrivals return integer is
+         begin
+            return Number_of_Segments_Arrived;
+         end TC_Arrivals;
+
+         
+         -- Segments arriving at the Input queue are counted and checked
+         -- against the total number of segments for the message.  They
+         -- are requeued onto the ordering queue where they are held until
+         -- all the segments have arrived.
+         entry Input ( Segment : acc_Message_Segment ) when true is
+         begin
+            -- check for EOM, if so get the number of segments in the message
+            -- Note: in this portion of code no attempt is made to address
+            -- reset for new message , end conditions, missing segments, 
+            -- segments of a different message etc.
+            Number_of_Segments_Arrived := Number_of_Segments_Arrived + 1;
+            if Segment.EOM then
+               Number_of_Segments_Expected := Segment.Segs_In_Message;
+               Seen_EOM := true;
+            end if;
+
+            if Seen_EOM then
+               if Number_of_Segments_Arrived = Number_of_Segments_Expected then
+                  -- This is the last segment for this message
+                  All_Segments_Arrived := true;    -- clear the barrier
+               end if;
+            end if;
+
+            requeue Ordering_Queue;
+
+            -- At this exit point the entry queue barriers are evaluated
+
+         end Input;
+
+
+         entry Ordering_Queue ( Segment : acc_Message_Segment )
+                                                  when All_Segments_Arrived is
+            begin
+
+            --=====================================================
+            -- This part is all Test_Control code
+
+            if TC_First_Cycle then 
+               -- Check the order of the original three
+               if Segment.Seg_Sequence_No /= TC_Expected_Sequence then
+                  -- The segments are not being pulled off in the 
+                  -- expected sequence.  This could occur if the 
+                  -- requeue is not putting them back on the end.
+                  TC_Failed_3 := true;
+               end if; -- sequence check
+               -- Decrement the expected sequence
+               if TC_Expected_Sequence /= Header then
+                  TC_Expected_Sequence := TC_Expected_Sequence - 1;
+               else 
+                  TC_First_Cycle := false; -- This is the Header - the
+                                           -- first two segments are
+                                           -- back on the queue
+               end if; -- decrementing
+            end if; -- first cycle 
+            --=====================================================
+
+            -- And this is the Application code
+            if Segment.Seg_Sequence_No = Next_Needed then
+               if Segment.EOM then
+                  Next_Needed := Header;  -- reset for next message
+                  -- :: other resets not shown
+               else
+                  Next_Needed := Next_Needed + 1;
+               end if;
+               requeue Output_Driver.Input  with abort;
+               -- set to Report Failed - Requeue did not complete entry body
+               TC_Failed_1 := true;
+            else
+               -- Not the next needed - put it back on the queue
+               --    NOTE: here we are requeueing to the same entry
+               requeue Sequencer.Ordering_Queue;
+               -- set to Report Failed - Requeue did not complete entry body
+               TC_Failed_2 := true;
+            end if;
+         end Ordering_Queue;
+      end Sequencer;
+   
+
+      task body Output_Driver is
+         This_Segment : acc_Message_Segment := new Message_Segment;
+
+         TC_Expected_Sequence : Segment_Sequence := Segment_Sequence'first;
+         TC_Segment_Total : integer := 0;
+         TC_Expected_Total : integer := 3;
+      begin
+         loop
+            -- Note: normally we would expect this Accept to be in a select 
+            -- with terminate.  For the test we exit the loop on completion
+            -- to give better control
+            accept Input ( Segment : acc_Message_Segment ) do 
+               This_Segment.all := Segment.all;
+            end Input;
+   
+            null;  --::: stub - output the next segment of the message
+
+            -- The following is all test control code
+            --
+            if This_Segment.Seg_Sequence_No /= TC_Expected_Sequence then
+               Report.Failed ("Output_Driver: Segment out of sequence");
+            end if;
+            TC_Expected_Sequence := TC_Expected_Sequence + 1;
+
+            -- Now count the number of segments
+            TC_Segment_Total := TC_Segment_Total + 1;
+
+            -- Check the number and exit loop when complete
+            -- There must be exactly TC_Expected_Total in number and
+            --    the last one must be EOM
+            --    (test will hang if < TC_Expected_Total arrive
+            --    without EOM)
+            if This_Segment.EOM then
+               -- This is the last segment.
+               if TC_Segment_Total /= TC_Expected_Total then
+                  Report.Failed ("EOM and wrong number of segments");
+               end if;
+               exit;   -- the loop and terminate the task
+            elsif TC_Segment_Total = TC_Expected_Total then
+               Report.Failed ("No EOM found");
+               exit;
+            end if;
+         end loop;
+      exception
+         when others => 
+              Report.Failed ("Unexpected Exception in Output_Driver");
+      end Output_Driver;
+
+
+   begin  
+
+      null;
+
+   end; -- encapsulation
+
+   if TC_Failed_1 then
+      Report.Failed ("Requeue did not complete entry body - 1");
+   end if;
+
+   if TC_Failed_2 then
+      Report.Failed ("Requeue did not complete entry body - 2");
+   end if;
+
+   if TC_Failed_3 then
+      Report.Failed ("Sequencer: Segment out of sequence");
+   end if;
+
+   Report.Result;
+   
+end C954022;