--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/gcc/testsuite/ada/acats/tests/c9/c954001.a	Fri Oct 27 22:46:09 2017 +0900
@@ -0,0 +1,273 @@
+-- C954001.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 statement within an entry_body with parameters
+--      may requeue the entry call to a protected entry with a subtype-
+--      conformant parameter profile. Check that, if the call is queued on the
+--      new entry's queue, the original caller remains blocked after the
+--      requeue, but the entry_body containing the requeue is completed.
+--
+-- TEST DESCRIPTION:
+--      Declare a protected object which simulates a disk device. Declare an
+--      entry that requeues the caller to a second entry if the disk head is
+--      not in the proper location, but first sets the second entry's barrier
+--      to false. Declare a procedure which sets the second entry's barrier
+--      to true.
+--
+--      Declare a task which calls the first entry such that the requeue is
+--      called. This task should be queued on the second entry and remain
+--      blocked, and the first entry should be complete. Call the procedure
+--      which releases the second entry's queue. The second entry should
+--      complete, after which the task should complete.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+package C954001_0 is  -- Disk management abstraction.
+
+
+   -- Simulate a read-only disk device with a head that may be moved to
+   -- different tracks. If a read request is issued for the current
+   -- track, the request can be satisfied immediately. Otherwise, the head
+   -- must be moved to the correct track, during which time the calling task
+   -- is blocked. When the head reaches the correct track, the disk generates
+   -- an interrupt, after which the request can be satisfied, and the
+   -- calling task can proceed.
+
+   Buffer_Size : constant := 100;
+
+   type Disk_Buffer is new String (1 .. Buffer_Size);
+   type Disk_Track  is new Natural;
+
+   type Disk_Address is record
+      Track : Disk_Track;
+      -- Additional components.
+   end record;
+
+   Initial_Track : constant Disk_Track := 0;
+   New_Track     : constant Disk_Track := 5;
+
+               --==============================================--
+
+   protected Disk_Device is
+
+      entry Read (Where :     Disk_Address;            -- Read data from disk
+                  Data  : out Disk_Buffer);            -- track.
+
+      procedure Disk_Interrupt;                        -- Handle interrupt 
+                                                       -- from disk.
+
+      function TC_Track return Disk_Track;             -- Return current track.
+
+      function TC_Pending_Queued return Boolean;       -- True when there is
+                                                       -- an entry in queue
+
+   private
+
+      entry Pending_Read (Where :     Disk_Address;    -- Wait for head to 
+                          Data  : out Disk_Buffer);    -- move then read data.
+
+      Current_Track     : Disk_Track := Initial_Track; -- Current disk track.
+      Operation_Pending : Boolean    := False;         -- Vis.  entry barrier.
+      Disk_Interrupted  : Boolean    := False;         -- Priv. entry barrier.
+
+   end Disk_Device;
+
+
+end C954001_0;
+
+
+     --==================================================================--
+
+
+package body C954001_0 is  -- Disk management abstraction.
+
+
+   protected body Disk_Device is
+
+      entry Read (Where : Disk_Address; Data : out Disk_Buffer)
+        when not Operation_Pending is
+      begin
+         if (Where.Track = Current_Track) then      -- If the head is over the
+            -- Read data from disk...               -- requested track, read
+            null;                                   -- the data.
+
+         else                                       -- Otherwise, defer read
+            Operation_Pending := True;              -- while head is moved to
+                                                    -- correct track (signaled
+            --                        --            -- by a disk interrupt).
+            -- Requeue is tested here --
+            --                        --
+
+            requeue Pending_Read;                  
+
+         end if;
+      end Read;
+
+
+      procedure Disk_Interrupt is                   -- Called when the disk
+      begin                                         -- interrupts, indicating
+         Disk_Interrupted := True;                  -- that the head is over
+      end Disk_Interrupt;                           -- the correct track.
+
+
+      function TC_Track return Disk_Track is        -- Artifice required for
+      begin                                         -- testing purposes.
+         return (Current_Track);
+      end TC_Track;
+
+
+      entry Pending_Read (Where : Disk_Address; Data : out Disk_Buffer)
+        when Disk_Interrupted is
+      begin
+         Current_Track := Where.Track;              -- Head is now over the
+         -- Read data from disk...                  -- correct track; read
+         Operation_Pending := False;                -- the data.
+         Disk_Interrupted := False;
+      end Pending_Read;
+
+      function TC_Pending_Queued return Boolean is
+      begin
+         -- Return true when there is something on the Pending_Read queue
+         return (Pending_Read'Count /=0);   
+      end TC_Pending_Queued;
+
+   end Disk_Device;
+
+
+end C954001_0;
+
+
+     --==================================================================--
+
+
+with Report;
+with ImpDef;
+
+with C954001_0;  -- Disk management abstraction.
+use  C954001_0;
+
+procedure C954001 is
+
+
+   task type Read_Task is        -- an unusual (but legal) declaration
+   end Read_Task;
+   --
+   --
+   task body Read_Task is
+      Location : constant Disk_Address := (Track => New_Track);
+      Data     :          Disk_Buffer  := (others => ' ');
+   begin
+      Disk_Device.Read (Location, Data);   -- Invoke requeue statement.
+   exception
+      when others =>
+         Report.Failed ("Exception raised in task");
+   end Read_Task;
+
+               --==============================================--
+
+begin  -- Main program.
+
+   Report.Test ("C954001", "Requeue from an entry within a P.O. " &
+                           "to a private entry within the same P.O.");
+
+
+   declare
+
+      IO_Request : Read_Task;                  -- Request a read from other
+                                               -- than the current track.
+                                               -- IO_Request will be requeued
+                                               -- from Read to Pending_Read.
+   begin
+
+      -- To pass this test, the following must be true:
+      --
+      --    (A) The Read entry call made by the task IO_Request must be
+      --        completed by the requeue.
+      --    (B) IO_Request must remain blocked following the requeue.
+      --    (C) IO_Request must be queued on the Pending_Read entry queue.
+      --    (D) IO_Request must continue execution after the Pending_Read
+      --        entry completes.
+      --
+      -- First, verify (A): that the Read entry call is complete.
+      --
+      -- Call a protected operation (Disk_Device.TC_Track). Since no two
+      -- protected actions may proceed concurrently unless both are protected
+      -- function calls, a call to a protected operation at this point can
+      -- proceed only if the Read entry call is already complete.
+      --
+      -- Note that if Read is NOT complete, the test will likely hang here.
+      --
+      -- Next, verify (B): that IO_Request remains blocked following the
+      -- requeue. Also verify that Pending_Read (the entry to which
+      -- IO_Request should have been queued) has not yet executed.
+
+      -- Wait until the task had made the call and the requeue has been
+      -- effected.  
+      while not Disk_Device.TC_Pending_Queued loop
+         delay ImpDef.Minimum_Task_Switch;
+      end loop;
+
+      if Disk_Device.TC_Track /= Initial_Track then
+         Report.Failed ("Target entry of requeue executed prematurely");
+      elsif IO_Request'Terminated then
+         Report.Failed ("Caller did not remain blocked after " &
+                        "the requeue or was never requeued");
+      else
+
+         -- Verify (C): that IO_Request is queued on the
+         -- Pending_Read entry queue.
+         --
+         -- Set the barrier for Pending_Read to true. Check that the
+         -- current track is updated and that IO_Request terminates.
+
+         Disk_Device.Disk_Interrupt;           -- Simulate a disk interrupt,
+                                               -- signaling that the head is
+                                               -- over the correct track.
+
+         -- The Pending_Read entry body will complete before the next
+         -- protected action is called (Disk_Device.TC_Track).
+
+         if Disk_Device.TC_Track /= New_Track then
+            Report.Failed ("Caller was not requeued on target entry");
+         end if;
+
+         -- Finally, verify (D): that Read_Task continues after Pending_Read
+         -- completes.
+         -- 
+         -- Note that the test will hang here if Read_Task does not continue
+         -- executing following the completion of the requeued entry call.
+
+      end if;
+
+   end;  -- We will not exit the declare block until the task completes
+
+   Report.Result;
+
+end C954001;