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
56with Report;
57with ImpDef;
58with Ada.Calendar;
59
60procedure 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
150begin  -- 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
167end C974013;
168