1-- C97307A.ADA
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-- CHECK THAT A TIMED ENTRY CALL THAT IS CANCELED (BECAUSE THE DELAY HAS
26-- EXPIRED) IS REMOVED FROM THE QUEUE OF THE CALLED TASK'S ENTRY.
27
28-- WRG 7/14/86
29
30with Impdef;
31WITH REPORT; USE REPORT;
32PROCEDURE C97307A IS
33
34BEGIN
35
36     TEST ("C97307A", "CHECK THAT A TIMED ENTRY CALL THAT IS " &
37                      "CANCELED (BECAUSE THE DELAY HAS EXPIRED) IS " &
38                      "REMOVED FROM THE QUEUE OF THE CALLED TASK'S " &
39                      "ENTRY");
40
41     DECLARE
42
43          DELAY_TIME : CONSTANT DURATION := 2 * 60.0 * Impdef.One_Second;
44
45          TASK EXPIRED IS
46               ENTRY INCREMENT;
47               ENTRY READ (COUNT : OUT NATURAL);
48          END EXPIRED;
49
50          TASK TYPE NON_TIMED_CALLER IS
51               ENTRY NAME (N : NATURAL);
52          END NON_TIMED_CALLER;
53
54          TASK TYPE TIMED_CALLER IS
55               ENTRY NAME (N : NATURAL);
56          END TIMED_CALLER;
57
58          CALLER1 : TIMED_CALLER;
59          CALLER2 : NON_TIMED_CALLER;
60          CALLER3 : TIMED_CALLER;
61          CALLER4 : NON_TIMED_CALLER;
62          CALLER5 : TIMED_CALLER;
63
64          TASK T IS
65               ENTRY E (NAME : NATURAL);
66          END T;
67
68          TASK DISPATCH IS
69               ENTRY READY;
70          END DISPATCH;
71
72          --------------------------------------------------
73
74          TASK BODY EXPIRED IS
75               EXPIRED_CALLS : NATURAL := 0;
76          BEGIN
77               LOOP
78                    SELECT
79                         ACCEPT INCREMENT DO
80                              EXPIRED_CALLS := EXPIRED_CALLS + 1;
81                         END INCREMENT;
82                    OR
83                         ACCEPT READ (COUNT : OUT NATURAL) DO
84                              COUNT := EXPIRED_CALLS;
85                         END READ;
86                    OR
87                         TERMINATE;
88                    END SELECT;
89               END LOOP;
90          END EXPIRED;
91
92          --------------------------------------------------
93
94          TASK BODY NON_TIMED_CALLER IS
95               MY_NAME : NATURAL;
96          BEGIN
97               ACCEPT NAME (N : NATURAL) DO
98                    MY_NAME := N;
99               END NAME;
100
101               T.E (MY_NAME);
102          END NON_TIMED_CALLER;
103
104          --------------------------------------------------
105
106          TASK BODY TIMED_CALLER IS
107               MY_NAME : NATURAL;
108          BEGIN
109               ACCEPT NAME (N : NATURAL) DO
110                    MY_NAME := N;
111               END NAME;
112
113               SELECT
114                    T.E (MY_NAME);
115                    FAILED ("TIMED ENTRY CALL NOT CANCELED FOR CALLER" &
116                            NATURAL'IMAGE(MY_NAME));
117               OR
118                    DELAY DELAY_TIME;
119                    EXPIRED.INCREMENT;
120               END SELECT;
121          EXCEPTION
122               WHEN OTHERS =>
123                    FAILED ("EXCEPTION RAISED IN TIMED_CALLER -- " &
124                            "CALLER" & NATURAL'IMAGE(MY_NAME));
125          END TIMED_CALLER;
126
127          --------------------------------------------------
128
129          TASK BODY DISPATCH IS
130          BEGIN
131               CALLER1.NAME (1);
132               ACCEPT READY;
133
134               CALLER2.NAME (2);
135               ACCEPT READY;
136
137               CALLER3.NAME (3);
138               ACCEPT READY;
139
140               CALLER4.NAME (4);
141               ACCEPT READY;
142
143               CALLER5.NAME (5);
144          END DISPATCH;
145
146          --------------------------------------------------
147
148          TASK BODY T IS
149
150               DESIRED_QUEUE_LENGTH : NATURAL := 1;
151               EXPIRED_CALLS        : NATURAL;
152
153               ACCEPTED             : ARRAY (1..5) OF NATURAL RANGE 0..5
154                                         := (OTHERS => 0);
155               ACCEPTED_INDEX       : NATURAL := 0;
156
157          BEGIN
158               LOOP
159                    LOOP
160                         EXPIRED.READ (EXPIRED_CALLS);
161                    EXIT WHEN E'COUNT >= DESIRED_QUEUE_LENGTH -
162                                         EXPIRED_CALLS;
163                         DELAY 2.0 * Impdef.One_Long_Second;
164                    END LOOP;
165               EXIT WHEN DESIRED_QUEUE_LENGTH = 5;
166                    DISPATCH.READY;
167                    DESIRED_QUEUE_LENGTH := DESIRED_QUEUE_LENGTH + 1;
168               END LOOP;
169
170               -- AT THIS POINT, FIVE TASKS WERE QUEUED.
171               -- LET THE TIMED ENTRY CALLS ISSUED BY CALLER1,
172               -- CALLER3, AND CALLER5 EXPIRE:
173
174               DELAY DELAY_TIME + 10.0 * Impdef.One_Long_Second;
175
176               -- AT THIS POINT, ALL THE TIMED ENTRY CALLS MUST HAVE
177               -- EXPIRED AND BEEN REMOVED FROM THE ENTRY QUEUE FOR E,
178               -- OTHERWISE THE IMPLEMENTATION HAS FAILED THIS TEST.
179
180               WHILE E'COUNT > 0 LOOP
181                    ACCEPT E (NAME : NATURAL) DO
182                         ACCEPTED_INDEX := ACCEPTED_INDEX + 1;
183                         ACCEPTED (ACCEPTED_INDEX) := NAME;
184                    END E;
185               END LOOP;
186
187               IF ACCEPTED /= (2, 4, 0, 0, 0) THEN
188                    FAILED ("SOME TIMED CALLS NOT REMOVED FROM ENTRY " &
189                            "QUEUE");
190                    COMMENT ("ORDER ACCEPTED WAS:" &
191                             NATURAL'IMAGE (ACCEPTED (1))  & ',' &
192                             NATURAL'IMAGE (ACCEPTED (2))  & ',' &
193                             NATURAL'IMAGE (ACCEPTED (3))  & ',' &
194                             NATURAL'IMAGE (ACCEPTED (4))  & ',' &
195                             NATURAL'IMAGE (ACCEPTED (5)) );
196               END IF;
197          END T;
198
199          --------------------------------------------------
200
201     BEGIN
202
203          NULL;
204
205     END;
206
207     RESULT;
208
209END C97307A;
210