Mercurial > hg > CbC > CbC_gcc

comparison gcc/testsuite/ada/acats/tests/c9/c94005b.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 -- C94005B.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 IF A TASK TYPE IS DECLARED IN A LIBRARY PACKAGE, ANY
26 -- BLOCKS, SUBPROGRAMS, OR TASKS THAT DECLARE OBJECTS OF THAT TYPE
27 -- DO WAIT FOR TERMINATION OF SUCH OBJECTS.
28 -- SUBTESTS ARE:
29 -- (A) IN A MAIN PROGRAM BLOCK.
30 -- (B) IN A LIBRARY FUNCTION.
31 -- (C) IN A MAIN PROGRAM TASK BODY.
32
33 -- THIS TEST CONTAINS SHARED VARIABLES AND RACE CONDITIONS.
34
35 -- JRK 10/8/81
36 -- SPS 11/2/82
37 -- SPS 11/21/82
38 -- JWC 11/15/85 MADE THE LIBRARY PACKAGE NAME UNIQUE, C94005B_PKG.
39 -- PWN 01/31/95 REMOVED PRAGMA PRIORITY FOR ADA 9X.
40
41
42 WITH SYSTEM; USE SYSTEM;
43 PACKAGE C94005B_PKG IS
44
45 GLOBAL : INTEGER;
46
47 TASK TYPE TT IS
48 ENTRY E (I : INTEGER);
49 END TT;
50
51 END C94005B_PKG;
52
53 with Impdef;
54 PACKAGE BODY C94005B_PKG IS
55
56 TASK BODY TT IS
57 LOCAL : INTEGER;
58 BEGIN
59 ACCEPT E (I : INTEGER) DO
60 LOCAL := I;
61 END E;
62 DELAY 60.0 * Impdef.One_Second; -- SINCE THE PARENT UNIT HAS HIGHER PRIORITY
63 -- AT THIS POINT, IT WILL RECEIVE CONTROL AND
64 -- TERMINATE IF THE ERROR IS PRESENT.
65 GLOBAL := LOCAL;
66 END TT;
67
68 END C94005B_PKG;
69
70
71 WITH REPORT; USE REPORT;
72 WITH C94005B_PKG; USE C94005B_PKG;
73 FUNCTION F RETURN INTEGER IS
74
75 T : TT;
76
77 BEGIN
78
79 T.E (IDENT_INT(2));
80 RETURN 0;
81
82 END F;
83
84 with Impdef;
85 WITH SYSTEM; USE SYSTEM;
86 WITH REPORT; USE REPORT;
87 WITH C94005B_PKG; USE C94005B_PKG;
88 WITH F;
89 PROCEDURE C94005B IS
90
91
92 BEGIN
93 TEST ("C94005B", "CHECK THAT IF A TASK TYPE IS DECLARED IN A " &
94 "LIBRARY PACKAGE, ANY BLOCKS, SUBPROGRAMS, OR " &
95 "TASKS THAT DECLARE OBJECTS OF THAT TYPE DO " &
96 "WAIT FOR TERMINATION OF SUCH OBJECTS");
97
98 --------------------------------------------------
99
100 GLOBAL := IDENT_INT (0);
101
102 DECLARE -- (A)
103
104 T : TT;
105
106 BEGIN -- (A)
107
108 T.E (IDENT_INT(1));
109
110 END; -- (A)
111
112 IF GLOBAL /= 1 THEN
113 FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
114 "BLOCK EXIT - (A)");
115 END IF;
116
117 --------------------------------------------------
118
119 GLOBAL := IDENT_INT (0);
120
121 DECLARE -- (B)
122
123 I : INTEGER;
124
125 BEGIN -- (B)
126
127 I := F ;
128
129 IF GLOBAL /= 2 THEN
130 FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
131 "FUNCTION EXIT - (B)");
132 END IF;
133
134 END; -- (B)
135
136 --------------------------------------------------
137
138 GLOBAL := IDENT_INT (0);
139
140 DECLARE -- (C)
141
142 TASK TSK IS
143 ENTRY ENT;
144 END TSK;
145
146 TASK BODY TSK IS
147 T : TT;
148 BEGIN
149 T.E (IDENT_INT(3));
150 END TSK;
151
152 BEGIN -- (C)
153
154 WHILE NOT TSK'TERMINATED LOOP
155 DELAY 0.1 * Impdef.One_Second;
156 END LOOP;
157
158 IF GLOBAL /= 3 THEN
159 FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
160 "TASK EXIT - (C)");
161 END IF;
162
163 END; -- (C)
164
165 --------------------------------------------------
166
167 RESULT;
168 END C94005B;