aboutsummaryrefslogtreecommitdiff
path: root/gcc/testsuite/ada/acats/tests/c9/c974014.a
blob: 03ca915f8968c717dba6d1e1d26a1a0ea1162c21 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
-- C974014.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 if the triggering alternative of an asynchronous select 
--      statement is a delay and the abortable part completes before the delay
--      expires then the delay is cancelled and the optional statements in the
--      triggering part are not performed.  In particular, check the case of
--      the ATC in non-tasking code.
--
-- TEST DESCRIPTION:
--      A fraction of in-line code is simulated.  An asynchronous select
--      is used with a triggering delay of several minutes.  The abortable
--      part, which is simulating a very lengthy, time consuming procedure
--      actually returns almost immediately thus ensuring that it completes
--      first.  At the conclusion, if a substantial amount of time has passed
--      the delay is assumed not to have been cancelled. 
--      (based on example in LRM 9.7.4)
--
--
-- CHANGE HISTORY:
--      06 Dec 94   SAIC    ACVC 2.0
--
--!


with Report;
with Ada.Calendar;
         
procedure C974014 is

   function "-" (Left, Right : Ada.Calendar.Time)
                              return Duration      renames Ada.Calendar."-";

   TC_Start_Time      : Ada.Calendar.Time := Ada.Calendar.Clock;
   TC_Elapsed_Time    : duration;

   Maximum_Allowable_Time : duration := 300.0; -- for Calculate_Gamma_Function

begin

   Report.Test ("C974014", "ATC: When abortable part completes before " &
                             "a triggering delay, check that the delay " &
                             "is cancelled & optional statements " &
                             "are not performed"); 

   declare  -- encapsulate test code

      type Gamma_Index is digits 5;   -- float precision

      -- (These two fields are assumed filled elsewhere)
      Input_Field, Result_of_Beta : Gamma_Index;   

      -- Notify and take corrective action in the event that
      -- the procedure Calculate_Gamma_Function does not converge.
      --
      procedure Non_Convergent is
      begin
         null;  -- stub

         Report.Failed ("Optional statements in triggering part" &
                                    " were performed");       
      end Non_Convergent;


      --  This is a very time consuming calculation.  It is possible,
      --  that, with certain parameters, it will not converge.  If it
      --  runs for more than Maximum_Allowable_Time it is considered
      --  not to be convergent and should be aborted.
      --
      Procedure Calculate_Gamma_Function (X, Y : Gamma_Index) is
      begin
         null;  -- Stub
         --
      end Calculate_Gamma_Function;

   begin  -- declare

      -- .....  Isolated segment of inline code

      -- Now Print Gamma Function (abort and display if not convergent)
      --
      select
         delay Maximum_Allowable_Time;  -- for Calculate_Gamma_Function
         Non_Convergent;   -- Display error and flag result as failed

      then abort
         Calculate_Gamma_Function (Input_Field, Result_of_Beta);
      end select;

      -- .....  End of Isolated segment of inline code

   end; -- declare
   
   TC_Elapsed_Time := Ada.Calendar.Clock - TC_Start_Time;

   -- Note: We are not checking for "cancellation within a reasonable time",
   -- we are checking for cancellation/non-cancellation of the delay.  We
   -- use a number which, if exceeded, means that the delay was not
   -- cancelled and has proceeded to  full term.
   --
   if ( TC_Elapsed_Time > Maximum_Allowable_Time/2 ) then
      -- Test time exceeds a reasonable value.
      Report.Failed ("Triggering delay statement was not cancelled");
   end if;


   Report.Result;

end C974014;