gcc/testsuite/ada/acats/tests/c9/c974013.a

   1 -- C974013.A
   2 --
   3 --                             Grant of Unlimited Rights
   4 --
   5 --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
   6 --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
   7 --     unlimited rights in the software and documentation contained herein.
   8 --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
   9 --     this public release, the Government intends to confer upon all
  10 --     recipients unlimited rights  equal to those held by the Government.
  11 --     These rights include rights to use, duplicate, release or disclose the
  12 --     released technical data and computer software in whole or in part, in
  13 --     any manner and for any purpose whatsoever, and to have or permit others
  14 --     to do so.
  15 --
  16 --                                    DISCLAIMER
  17 --
  18 --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
  19 --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
  20 --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
  21 --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
  22 --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
  23 --     PARTICULAR PURPOSE OF SAID MATERIAL.
  24 --*
  25 --
  26 -- OBJECTIVE:
  27 --      Check that the abortable part of an asynchronous select statement
  28 --      is aborted if it does not complete before the triggering statement
  29 --      completes, where the triggering statement is a delay_until
  30 --      statement.
  31 --
  32 --      Check that the sequence of statements of the triggering alternative
  33 --      is executed after the abortable part is left.
  34 --
  35 -- TEST DESCRIPTION:
  36 --      Declare a task with an accept statement containing an asynchronous
  37 --      select with a delay_until triggering statement.  Parameterize
  38 --      the accept statement with the amount of time to be added to the
  39 --      current time to be used for the delay. Simulate a time-consuming
  40 --      calculation by declaring a procedure containing an infinite loop.
  41 --      Call this procedure in the abortable part.
  42 --
  43 --      The delay will expire before the abortable part completes, at which
  44 --      time the abortable part is aborted, and the sequence of statements
  45 --      following the triggering statement is executed.
  46 --
  47 --      Main test logic is identical to c974001 which uses simple delay
  48 --
  49 --
  50 -- CHANGE HISTORY:
  51 --      06 Dec 94   SAIC    ACVC 2.0
  52 --      28 Nov 95   SAIC    Fixed problems for ACVC 2.0.1.
  53 --
  54 --!
  55
  56 with Report;
  57 with ImpDef;
  58 with Ada.Calendar;
  59
  60 procedure C974013 is
  61
  62
  63           --========================================================--
  64
  65    function "+" (Left : Ada.Calendar.Time; Right: Duration)
  66                             return Ada.Calendar.Time renames Ada.Calendar."+";
  67
  68
  69    Allotted_Time : constant Duration := ImpDef.Switch_To_New_Task;
  70    Calculation_Canceled : exception;
  71
  72    Count : Integer := 1234;
  73    procedure Lengthy_Calculation is
  74    begin
  75       -- Simulate a non-converging calculation.
  76       loop                                           -- Infinite loop.
  77          Count := (Count + 1) mod 10;
  78          exit when not Report.Equal (Count, Count);  -- Condition always false.
  79          delay 0.0;                                  -- abort completion point
  80       end loop;
  81    end Lengthy_Calculation;
  82
  83
  84           --========================================================--
  85
  86
  87    task type Timed_Calculation is
  88       entry Calculation (Time_Limit : in Duration);
  89    end Timed_Calculation;
  90
  91
  92    task body Timed_Calculation is
  93       Delay_Time : Ada.Calendar.Time;
  94    begin
  95       loop
  96          select
  97             accept Calculation (Time_Limit : in Duration) do
  98
  99                -- We have to construct an "until" time artificially
 100                -- as we have no control over when the test will be run
 101                --
 102                Delay_Time := Ada.Calendar.Clock + Time_Limit;
 103
 104                --                                    --
 105                -- Asynchronous select is tested here --
 106                --                                    --
 107
 108                select
 109
 110                   delay until Delay_Time;     -- Time not reached yet, so
 111                                               -- Lengthy_Calculation starts.
 112
 113                   raise Calculation_Canceled; -- This is executed after
 114                                               -- Lengthy_Calculation aborted.
 115
 116                then abort
 117
 118                   Lengthy_Calculation;        -- Delay expires before complete,
 119                                               -- so this call is aborted.
 120                   -- Check that the whole of the abortable part is aborted,
 121                   -- not just the statement in the abortable part that was
 122                   -- executing at the time
 123                   Report.Failed ("Abortable part not aborted");
 124
 125                end select;
 126
 127                Report.Failed ("Triggering alternative sequence of " &
 128                               "statements not executed");
 129
 130             exception    -- New Ada 9x: handler within accept
 131                when Calculation_Canceled =>
 132                   if Count = 1234 then
 133                      Report.Failed ("Abortable part did not execute");
 134                   end if;
 135             end Calculation;
 136          or
 137             terminate;
 138          end select;
 139       end loop;
 140    exception
 141       when others =>
 142             Report.Failed ("Unexpected exception in Timed_Calculation task");
 143    end Timed_Calculation;
 144
 145
 146           --========================================================--
 147
 148
 149
 150 begin  -- Main program.
 151
 152    Report.Test ("C974013", "Asynchronous Select: Trigger is delay_until " &
 153                            "which completes before abortable part");
 154
 155    declare
 156       Timed : Timed_Calculation;  -- Task.
 157    begin
 158       Timed.Calculation (Time_Limit => Allotted_Time); -- Asynchronous select
 159                                                        -- inside accept block.
 160    exception
 161       when Calculation_Canceled =>
 162          Report.Failed ("wrong exception handler used");
 163    end;
 164
 165    Report.Result;
 166
 167 end C974013;