Mercurial > hg > CbC > CbC_gcc

comparison gcc/testsuite/ada/acats/tests/c9/c94002b.ada @ 111:04ced10e8804

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
gcc 7
author kono
date Fri, 27 Oct 2017 22:46:09 +0900
parents
children
comparison
equal deleted inserted replaced
68:561a7518be6b 111:04ced10e8804
1 -- C94002B.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 MASTER UNIT, WHICH ALLOCATES TASKS OF A GLOBAL ACCESS
26 -- TYPE MAY TERMINATE WITHOUT WAITING FOR THE ALLOCATED TASKS TO
27 -- TERMINATE.
28
29 -- SUBTESTS ARE:
30 -- (A) A SIMPLE TASK ALLOCATOR, IN A BLOCK.
31 -- (B) A RECORD OF TASK ALLOCATOR, IN A SUBPROGRAM.
32 -- (C) A RECORD OF ARRAY OF TASK ALLOCATOR, IN A TASK BODY.
33
34 -- JRK 10/8/81
35 -- SPS 11/2/82
36 -- SPS 11/21/82
37 -- JRK 11/29/82
38 -- TBN 1/20/86 REPLACED WITH C94006A-B.ADA AFTER LOWERING THE DELAY
39 -- VALUES, AND MODIFYING THE COMMENTS.
40 -- PWN 09/11/94 REMOVED PRAGMA PRIORITY FOR ADA 9X.
41
42 with Impdef;
43 WITH REPORT; USE REPORT;
44 WITH SYSTEM; USE SYSTEM;
45 PROCEDURE C94002B IS
46
47 TASK TYPE TT IS
48 ENTRY E;
49 END TT;
50
51 TASK BODY TT IS
52 BEGIN
53 ACCEPT E;
54 ACCEPT E;
55 END TT;
56
57
58 BEGIN
59 TEST ("C94002B", "CHECK THAT A MASTER UNIT, WHICH ALLOCATES " &
60 "TASKS OF A GLOBAL ACCESS TYPE MAY TERMINATE " &
61 "WITHOUT WAITING FOR THE ALLOCATED TASKS TO " &
62 "TERMINATE");
63
64 --------------------------------------------------
65
66 DECLARE -- (A)
67
68 TYPE A_T IS ACCESS TT;
69 A1 : A_T;
70
71 BEGIN -- (A)
72
73 DECLARE
74 A2 : A_T;
75 BEGIN
76 A2 := NEW TT;
77 A2.ALL.E;
78 A1 := A2;
79 END;
80
81 IF A1.ALL'TERMINATED THEN
82 FAILED ("ALLOCATED TASK PREMATURELY TERMINATED - (A)");
83 END IF;
84
85 A1.ALL.E;
86
87 END; -- (A)
88
89 --------------------------------------------------
90
91 DECLARE -- (B)
92
93 I : INTEGER;
94
95 FUNCTION F RETURN INTEGER IS
96
97 TYPE RT IS
98 RECORD
99 T : TT;
100 END RECORD;
101 TYPE ART IS ACCESS RT;
102 AR1 : ART;
103
104 PROCEDURE P (AR : OUT ART) IS
105 AR2 : ART;
106 BEGIN
107 AR2 := NEW RT;
108 AR2.T.E;
109 AR := AR2;
110 END P;
111
112 BEGIN
113 P (AR1);
114
115 IF AR1.T'TERMINATED THEN
116 FAILED ("ALLOCATED TASK PREMATURELY TERMINATED " &
117 "- (B)");
118 END IF;
119
120 AR1.T.E;
121 RETURN 0;
122 END F;
123
124 BEGIN -- (B)
125
126 I := F;
127
128 END; -- (B)
129
130 --------------------------------------------------
131
132 DECLARE -- (C)
133
134 LOOP_COUNT : INTEGER := 0;
135 CUT_OFF : CONSTANT := 60; -- DELAY.
136
137 TASK TSK IS
138 ENTRY ENT;
139 END TSK;
140
141 TASK BODY TSK IS
142
143 LOOP_COUNT1 : INTEGER := 0;
144 CUT_OFF1 : CONSTANT := 60; -- DELAY.
145
146 TYPE RAT;
147 TYPE ARAT IS ACCESS RAT;
148 TYPE ARR IS ARRAY (1..1) OF TT;
149 TYPE RAT IS
150 RECORD
151 A : ARAT;
152 T : ARR;
153 END RECORD;
154 ARA1 : ARAT;
155
156 TASK TSK1 IS
157 ENTRY ENT1 (ARA : OUT ARAT);
158 END TSK1;
159
160 TASK BODY TSK1 IS
161 ARA2 : ARAT;
162 BEGIN
163 ARA2 := NEW RAT;
164 ARA2.T(1).E;
165 ACCEPT ENT1 (ARA : OUT ARAT) DO
166 ARA := ARA2;
167 END ENT1;
168 END TSK1;
169
170 BEGIN
171 TSK1.ENT1 (ARA1);
172
173 WHILE NOT TSK1'TERMINATED AND LOOP_COUNT1 < CUT_OFF1 LOOP
174 DELAY 1.0 * Impdef.One_Second;
175 LOOP_COUNT1 := LOOP_COUNT1 + 1;
176 END LOOP;
177
178 IF LOOP_COUNT1 >= CUT_OFF1 THEN
179 FAILED ("DEPENDENT TASK TSK1 NOT TERMINATED " &
180 "WITHIN ONE MINUTE - (C)");
181 END IF;
182
183 IF ARA1.T(1)'TERMINATED THEN
184 FAILED ("ALLOCATED TASK PREMATURELY TERMINATED " &
185 "- (C)");
186 END IF;
187
188 ARA1.T(1).E;
189 END TSK;
190
191 BEGIN -- (C)
192
193 WHILE NOT TSK'TERMINATED AND LOOP_COUNT < CUT_OFF LOOP
194 DELAY 2.0 * Impdef.One_Second;
195 LOOP_COUNT := LOOP_COUNT + 1;
196 END LOOP;
197
198 IF LOOP_COUNT >= CUT_OFF THEN
199 FAILED ("DEPENDENT TASK TSK NOT TERMINATED WITHIN " &
200 "TWO MINUTES - (C)");
201 END IF;
202
203 END; -- (C)
204
205 --------------------------------------------------
206
207 RESULT;
208 END C94002B;