Mercurial > hg > CbC > CbC_gcc

comparison gcc/testsuite/ada/acats/tests/c7/c74306a.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 -- C74306A.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 -- OBJECTIVE:
26 -- AFTER THE FULL DECLARATION OF A DEFERRED CONSTANT, THE VALUE OF
27 -- THE CONSTANT MAY BE USED IN ANY EXPRESSION, PARTICULARLY
28 -- EXPRESSIONS IN WHICH THE USE WOULD BE ILLEGAL BEFORE THE FULL
29 -- DECLARATION.
30
31 -- HISTORY:
32 -- BCB 03/14/88 CREATED ORIGINAL TEST.
33
34 WITH REPORT; USE REPORT;
35
36 PROCEDURE C74306A IS
37
38 GENERIC
39 TYPE GENERAL_PURPOSE IS LIMITED PRIVATE;
40 Y : IN OUT GENERAL_PURPOSE;
41 FUNCTION IDENT (X : GENERAL_PURPOSE) RETURN GENERAL_PURPOSE;
42
43 FUNCTION IDENT (X : GENERAL_PURPOSE) RETURN GENERAL_PURPOSE IS
44 BEGIN
45 IF EQUAL(3,3) THEN
46 RETURN X;
47 END IF;
48 RETURN Y;
49 END IDENT;
50
51 PACKAGE P IS
52 TYPE T IS PRIVATE;
53 C : CONSTANT T;
54 PRIVATE
55 TYPE T IS RANGE 1 .. 100;
56
57 TYPE A IS ARRAY(1..2) OF T;
58
59 TYPE B IS ARRAY(INTEGER RANGE <>) OF T;
60
61 TYPE D (DISC : T) IS RECORD
62 NULL;
63 END RECORD;
64
65 C : CONSTANT T := 50;
66
67 PARAM : T := 99;
68
69 FUNCTION IDENT_T IS NEW IDENT (T, PARAM);
70
71 FUNCTION F (X : T := C) RETURN T;
72
73 SUBTYPE RAN IS T RANGE 1 .. C;
74
75 SUBTYPE IND IS B(1..INTEGER(C));
76
77 SUBTYPE DIS IS D (DISC => C);
78
79 OBJ : T := C;
80
81 CON : CONSTANT T := C;
82
83 ARR : A := (5, C);
84
85 PAR : T := IDENT_T (C);
86
87 RANOBJ : T RANGE 1 .. C := C;
88
89 INDOBJ : B(1..INTEGER(C));
90
91 DIS_VAL : DIS;
92
93 REN : T RENAMES C;
94
95 GENERIC
96 FOR_PAR : T := C;
97 PACKAGE GENPACK IS
98 VAL : T;
99 END GENPACK;
100
101 GENERIC
102 IN_PAR : IN T;
103 PACKAGE NEWPACK IS
104 IN_VAL : T;
105 END NEWPACK;
106 END P;
107
108 USE P;
109
110 PACKAGE BODY P IS
111 TYPE A1 IS ARRAY(1..2) OF T;
112
113 TYPE B1 IS ARRAY(INTEGER RANGE <>) OF T;
114
115 TYPE D1 (DISC1 : T) IS RECORD
116 NULL;
117 END RECORD;
118
119 SUBTYPE RAN1 IS T RANGE 1 .. C;
120
121 SUBTYPE IND1 IS B1(1..INTEGER(C));
122
123 SUBTYPE DIS1 IS D1 (DISC1 => C);
124
125 OBJ1 : T := C;
126
127 FUNCVAR : T;
128
129 CON1 : CONSTANT T := C;
130
131 ARR1 : A1 := (5, C);
132
133 PAR1 : T := IDENT_T (C);
134
135 RANOBJ1 : T RANGE 1 .. C := C;
136
137 INDOBJ1 : B1(1..INTEGER(C));
138
139 DIS_VAL1 : DIS1;
140
141 REN1 : T RENAMES C;
142
143 FUNCTION F (X : T := C) RETURN T IS
144 BEGIN
145 RETURN C;
146 END F;
147
148 PACKAGE BODY GENPACK IS
149 BEGIN
150 VAL := FOR_PAR;
151 END GENPACK;
152
153 PACKAGE BODY NEWPACK IS
154 BEGIN
155 IN_VAL := IN_PAR;
156 END NEWPACK;
157
158 PACKAGE PACK IS NEW GENPACK (FOR_PAR => C);
159
160 PACKAGE NPACK IS NEW NEWPACK (IN_PAR => C);
161 BEGIN
162 TEST ("C74306A", "AFTER THE FULL DECLARATION OF A DEFERRED " &
163 "CONSTANT, THE VALUE OF THE CONSTANT MAY " &
164 "BE USED IN ANY EXPRESSION, PARTICULARLY " &
165 "EXPRESSIONS IN WHICH THE USE WOULD BE " &
166 "ILLEGAL BEFORE THE FULL DECLARATION");
167
168 IF OBJ /= IDENT_T(50) THEN
169 FAILED ("IMPROPER VALUE FOR OBJ");
170 END IF;
171
172 IF CON /= IDENT_T(50) THEN
173 FAILED ("IMPROPER VALUE FOR CON");
174 END IF;
175
176 IF ARR /= (IDENT_T(5), IDENT_T(50)) THEN
177 FAILED ("IMPROPER VALUES FOR ARR");
178 END IF;
179
180 IF PAR /= IDENT_T(50) THEN
181 FAILED ("IMPROPER VALUE FOR PAR");
182 END IF;
183
184 IF OBJ1 /= IDENT_T(50) THEN
185 FAILED ("IMPROPER VALUE FOR OBJ1");
186 END IF;
187
188 IF CON1 /= IDENT_T(50) THEN
189 FAILED ("IMPROPER VALUE FOR CON1");
190 END IF;
191
192 IF ARR1 /= (IDENT_T(5), IDENT_T(50)) THEN
193 FAILED ("IMPROPER VALUES FOR ARR1");
194 END IF;
195
196 IF PAR1 /= IDENT_T(50) THEN
197 FAILED ("IMPROPER VALUE FOR PAR1");
198 END IF;
199
200 IF PACK.VAL /= IDENT_T(50) THEN
201 FAILED ("IMPROPER VALUE FOR PACK.VAL");
202 END IF;
203
204 IF NPACK.IN_VAL /= IDENT_T(50) THEN
205 FAILED ("IMPROPER VALUE FOR NPACK.IN_VAL");
206 END IF;
207
208 IF RAN'LAST /= IDENT_T(50) THEN
209 FAILED ("IMPROPER VALUE FOR RAN'LAST");
210 END IF;
211
212 IF RANOBJ /= IDENT_T(50) THEN
213 FAILED ("IMPROPER VALUE FOR RANOBJ");
214 END IF;
215
216 IF IND'LAST /= IDENT_INT(50) THEN
217 FAILED ("IMPROPER VALUE FOR IND'LAST");
218 END IF;
219
220 IF INDOBJ'LAST /= IDENT_INT(50) THEN
221 FAILED ("IMPROPER VALUE FOR INDOBJ'LAST");
222 END IF;
223
224 IF DIS_VAL.DISC /= IDENT_T(50) THEN
225 FAILED ("IMPROPER VALUE FOR DIS_VAL.DISC");
226 END IF;
227
228 IF REN /= IDENT_T(50) THEN
229 FAILED ("IMPROPER VALUE FOR REN");
230 END IF;
231
232 IF RAN1'LAST /= IDENT_T(50) THEN
233 FAILED ("IMPROPER VALUE FOR RAN1'LAST");
234 END IF;
235
236 IF RANOBJ1 /= IDENT_T(50) THEN
237 FAILED ("IMPROPER VALUE FOR RANOBJ1");
238 END IF;
239
240 IF IND1'LAST /= IDENT_INT(50) THEN
241 FAILED ("IMPROPER VALUE FOR IND1'LAST");
242 END IF;
243
244 IF INDOBJ1'LAST /= IDENT_INT(50) THEN
245 FAILED ("IMPROPER VALUE FOR INDOBJ1'LAST");
246 END IF;
247
248 IF DIS_VAL1.DISC1 /= IDENT_T(50) THEN
249 FAILED ("IMPROPER VALUE FOR DIS_VAL1.DISC1");
250 END IF;
251
252 IF REN1 /= IDENT_T(50) THEN
253 FAILED ("IMPROPER VALUE FOR REN1");
254 END IF;
255
256 FUNCVAR := F(C);
257
258 IF FUNCVAR /= IDENT_T(50) THEN
259 FAILED ("IMPROPER VALUE FOR FUNCVAR");
260 END IF;
261
262 RESULT;
263 END P;
264
265 BEGIN
266 DECLARE
267 TYPE ARR IS ARRAY(1..2) OF T;
268
269 VAL1 : T := C;
270
271 VAL2 : ARR := (C, C);
272
273 VAL3 : T RENAMES C;
274 BEGIN
275 NULL;
276 END;
277
278 NULL;
279 END C74306A;