aboutsummaryrefslogtreecommitdiff
path: root/gcc/testsuite/ada/acats/tests/c9/c960004.a
blob: f394aab66fcf4c0c552191e4f016af0d9e25165c (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
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
-- C960004.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:
--      With the triggering statement being a delay and with the Asynchronous
--      Select statement being in a tasking situation complete the abortable
--      part before the delay expires.  Check that the delay is cancelled 
--      and that the optional statements in the triggering part are not
--      executed.
--
-- TEST DESCRIPTION:
--      Simulate the creation of a carrier task to control the output of 
--      a message via a line driver.  If the message sending process is 
--      not complete (the completion of the rendezvous) within a
--      specified time the carrier task is designed to take corrective action.
--      Use an asynchronous select to control the timing; arrange that
--      the abortable part (the rendezvous) completes almost immediately.
--      Check that the optional statements are not executed and that the
--      test completes well before the time of the trigger delay request thus
--      showing that it has been cancelled.
--                 
--
-- CHANGE HISTORY:
--      06 Dec 94   SAIC    ACVC 2.0
--
--!
         
                   
with Report;
with Ada.Calendar;
         
procedure C960004 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;

   -- Note: a properly executing test will complete immediately.   
   Allowable_ACK_Time : duration := 600.0;         

begin

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

   declare  -- To get the Report.Result after all has completed

      type Sequence_Number is range 1..1_999_999;   -- Message Number
      subtype S_length_subtype  is integer range 1..80;

      type Message_Type (Max_String : S_length_subtype := 1) is
         record
            Message_Number    : Sequence_Number;
            Alpha             : string(1..Max_String);
         end record;

      -- TC:  Dummy message for the test
      Dummy_Alpha     : constant string := "This could be printed";
      Message_to_Send : Message_Type (Max_string => Dummy_Alpha'length);


      -- This is the carrier task.  One of these is created for each
      -- message that requires ACK
      --
      task type Require_ACK_task is 
         entry Message_In (Message_to_Send: Message_Type);
      end Require_ACK_task;      
      type acc_Require_ACK_task is access Require_ACK_task;


      --:::::::::::::::::::::::::::::::::
      -- There would also be another task type "No_ACK_Task" which would
      -- be the carrier task for those messages not requiring an ACK. 
      -- This task would call Send_Message.ACK_Not_Required.  It is not
      -- shown in this test as it is not used.
      --:::::::::::::::::::::::::::::::::


   
      task Send_Message is 
         entry ACK_Required     (Message_to_Send: Message_Type);
         entry ACK_Not_Required (Message_to_Send: Message_Type);
      end Send_Message;


      -- This is the carrier task.  One of these is created for each
      -- message that requires ACK
      --
      task body Require_ACK_task is 
         Hold_Message : Message_Type;

         procedure Time_Out (Failed_Message_Number : Sequence_Number) is
         begin
            -- Take remedial action on the timed-out message
            null;    -- stub

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

      begin   
         accept Message_In (Message_to_Send: Message_Type) do
            Hold_Message := Message_to_Send;    -- to release caller
         end Message_In;

         -- Now put the message out to the Send_Message task and 
         -- wait (no more than Allowable_Ack_Time) for its completion
         --
         select
            delay Allowable_ACK_Time;
            -- ACK not received in specified time
            Time_out (Hold_Message.Message_Number);
         then abort
            -- If the rendezvous is not completed in the above time, this
            -- call is cancelled
            --    Note: for this test this call will complete immediately
            --          and thus the trigger should be cancelled
            Send_Message.ACK_Required (Hold_Message);
         end select;

      exception
         when others => 
               Report.Failed ("Unexpected exception in Require_ACK_task");
      end Require_ACK_task;      


      -- This is the Line Driver task
      --
      task body Send_Message is
         Hold_Non_ACK_Message : Message_Type;   
      begin
         loop
            select
               accept ACK_Required (Message_to_Send: Message_Type) do
                  -- Here send the message from within the rendezvous 
                  -- waiting for full transmission to complete
                  null;  -- stub
                  -- Note: In this test this accept will complete immediately
               end ACK_Required;
            or
               accept ACK_Not_Required (Message_to_Send: Message_Type) do
                  Hold_Non_ACK_Message := Message_to_Send;
               end ACK_Not_Required;
               -- Here send the message from outside the rendezvous
               null;  -- stub
            or 
               terminate;
            end select;
         end loop;
      exception
         when others => Report.Failed ("Unexpected exception in Send_Message");
      end Send_Message;

   begin -- declare
      -- Build a dummy message 
      Message_to_Send.Alpha          := Dummy_Alpha;
      Message_to_Send.Message_Number := 110_693;

      declare
         New_Require_ACK_task : acc_Require_ACK_task := 
                                             new Require_ACK_task;
      begin
         -- Create a carrier task for this message and pass the latter in
         New_Require_ACK_task.Message_In (Message_to_Send);
      end; -- declare

   end; -- declare

   --Once we are out of the above declarative region, all tasks have completed

   TC_Elapsed_Time := Ada.Calendar.Clock - TC_Start_Time;
   
   -- Check that the test has completed well before the time of the requested
   -- delay to ensure the delay was cancelled
   --
   if (TC_Elapsed_Time > Allowable_ACK_Time/2) then
      Report.Failed ("Triggering delay statement was not cancelled");
   end if;

   Report.Result;
end C960004;