1 files changed, 164 insertions, 0 deletions
diff --git a/gcc/testsuite/ada/acats/tests/c9/c960001.a b/gcc/testsuite/ada/acats/tests/c9/c960001.a
new file mode 100644
index 000000000..4eaa1f49f
--- /dev/null
+++ b/gcc/testsuite/ada/acats/tests/c9/c960001.a
@@ -0,0 +1,164 @@
+-- C960001.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:
+--      Confirm that a simple Delay Until statement is performed.  Check
+--      that the delay does not complete before the requested time and that it
+--      does complete thereafter
+--
+-- TEST DESCRIPTION:
+--      Simulate a task that sends a "pulse" at regular intervals.  The Delay
+--      Until statement is used to avoid accumulated drift.  For the
+--      test, we expect the delay to return very close to the requested time;
+--      we use an additional Pulse_Time_Delta for the limit.  The test
+--      driver (main) artificially limits the number of iterations by setting
+--      the Stop_Pulse Boolean after a small number.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--      15 Nov 95   SAIC    Fixed global variable problem for ACVC 2.0.1
+--
+--!
+
+with Report;
+with Ada.Calendar;
+with ImpDef;
+         
+procedure C960001 is
+
+begin
+
+   Report.Test ("C960001", "Simple Delay Until");
+
+   declare  -- To get the Report.Result after all has completed
+
+      function "+" (Left : Ada.Calendar.Time; Right: Duration)
+                            return Ada.Calendar.Time renames Ada.Calendar."+";
+      function "<" (Left, Right : Ada.Calendar.Time)
+                            return Boolean       renames Ada.Calendar."<";
+      function ">" (Left, Right : Ada.Calendar.Time)
+                            return Boolean       renames Ada.Calendar.">";
+
+      TC_Loop_Count : integer range 0..4 := 0; 
+     
+
+      -- control over stopping tasks
+      protected Control is
+         procedure Stop_Now;
+         function Stop return Boolean;
+      private
+         Halt : Boolean := False;
+      end Control;
+
+      protected body Control is
+         procedure Stop_Now is
+         begin
+            Halt := True;
+         end Stop_Now;
+
+         function Stop return Boolean is
+         begin
+            return Halt;
+         end Stop;
+      end Control;
+ 
+      task Pulse_Task is 
+         entry Trigger;
+      end Pulse_Task;
+   
+
+      -- Task to synchronize all qualified receivers.  
+      -- The entry Trigger starts the synchronization; Control.Stop 
+      -- becoming true terminates the task.
+      --
+      task body Pulse_Task is
+
+         Pulse_Time       : Ada.Calendar.Time;
+
+         Pulse_Time_Delta : duration :=  ImpDef.Clear_Ready_Queue;
+
+         TC_Last_Time : Ada.Calendar.Time;
+         TC_Current   : Ada.Calendar.Time;
+
+
+         -- This routine transmits a synchronizing "pulse" to
+         -- all receivers
+         procedure Pulse is
+         begin
+            null;  -- Stub
+            Report.Comment (".......PULSE........");
+         end Pulse;
+         
+      begin
+         accept Trigger;
+
+         Pulse_Time   := Ada.Calendar.Clock + Pulse_Time_Delta; 
+         TC_Last_Time := Pulse_Time;
+
+         while not Control.Stop loop
+            delay until Pulse_Time;
+            Pulse;
+
+            -- Calculate time for next pulse.  Note: this is based on the
+            -- last pulse time, not the time we returned from the delay
+            --
+            Pulse_Time := Pulse_Time + Pulse_Time_Delta;
+            
+            -- Test Control:
+            TC_Current := Ada.Calendar.Clock;
+            if TC_Current < TC_Last_Time then
+               Report.Failed ("Delay expired before requested time");
+            end if;
+            if TC_Current > Pulse_Time then
+               Report.Failed ("Delay too long");
+            end if;               
+            TC_Last_Time := Pulse_Time;
+            TC_Loop_Count := TC_Loop_Count +1;
+         end loop; 
+
+      exception
+         when others => 
+               Report.Failed ("Unexpected exception in Pulse_Task");
+      end Pulse_Task;
+
+
+
+   begin -- declare
+
+      Pulse_Task.Trigger;      -- Start test                            
+
+      -- Artificially limit the number of iterations
+      while TC_Loop_Count < 3 loop
+         delay ImpDef.Minimum_Task_Switch;
+      end loop;
+      --
+      Control.Stop_Now;      -- End test
+
+   end; -- declare
+
+   Report.Result;
+
+end C960001;