Mercurial > hg > CbC > CbC_gcc

comparison gcc/testsuite/ada/acats/tests/c6/c61008a.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 -- C61008A.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 CONSTRAINT_ERROR IS NOT RAISED IF THE DEFAULT VALUE
26 -- FOR A FORMAL PARAMETER DOES NOT SATISFY THE CONSTRAINTS OF THE
27 -- SUBTYPE_INDICATION WHEN THE DECLARATION IS ELABORATED, ONLY WHEN
28 -- THE DEFAULT IS USED.
29
30 -- SUBTESTS ARE:
31 -- (A) ARRAY PARAMETERS CONSTRAINED WITH NONSTATIC BOUNDS AND
32 -- INITIALIZED WITH A STATIC AGGREGATE.
33 -- (B) A SCALAR PARAMETER WITH NON-STATIC RANGE CONSTRAINTS
34 -- INITIALIZED WITH A STATIC VALUE.
35 -- (C) A RECORD PARAMETER WHOSE COMPONENTS HAVE NON-STATIC
36 -- CONSTRAINTS INITIALIZED WITH A STATIC AGGREGATE.
37 -- (D) AN ARRAY PARAMETER CONSTRAINED WITH STATIC BOUNDS ON SUB-
38 -- SCRIPTS AND NON-STATIC BOUNDS ON COMPONENTS, INITIALIZED
39 -- WITH A STATIC AGGREGATE.
40 -- (E) A RECORD PARAMETER WITH A NON-STATIC CONSTRAINT
41 -- INITIALIZED WITH A STATIC AGGREGATE.
42
43 -- DAS 1/20/81
44 -- SPS 10/26/82
45 -- VKG 1/13/83
46 -- SPS 2/9/83
47 -- BHS 7/9/84
48
49 WITH REPORT;
50 PROCEDURE C61008A IS
51
52 USE REPORT;
53
54 BEGIN
55
56 TEST ("C61008A", "CHECK THAT CONSTRAINT_ERROR IS NOT RAISED IF " &
57 "AN INITIALIZATION VALUE DOES NOT SATISFY " &
58 "CONSTRAINTS ON A FORMAL PARAMETER");
59
60 --------------------------------------------------
61
62 DECLARE -- (A)
63
64 PROCEDURE PA (I1, I2 : INTEGER) IS
65
66 TYPE A1 IS ARRAY (1..I1,1..I2) OF INTEGER;
67
68 PROCEDURE PA1 (A : A1 := ((1,0),(0,1))) IS
69 BEGIN
70 FAILED ("BODY OF PA1 EXECUTED");
71 EXCEPTION
72 WHEN OTHERS =>
73 FAILED ("EXCEPTION RAISED IN PA1");
74 END PA1;
75
76 BEGIN
77 PA1;
78 EXCEPTION
79 WHEN CONSTRAINT_ERROR =>
80 NULL;
81 WHEN OTHERS =>
82 FAILED ("WRONG EXCEPTION RAISED - PA1");
83 END PA;
84
85 BEGIN -- (A)
86 PA (IDENT_INT(1), IDENT_INT(10));
87 EXCEPTION
88 WHEN OTHERS =>
89 FAILED ("EXCEPTION RAISED IN CALL TO PA");
90 END; -- (A)
91
92 --------------------------------------------------
93
94 DECLARE -- (B)
95
96 PROCEDURE PB (I1, I2 : INTEGER) IS
97
98 SUBTYPE INT IS INTEGER RANGE I1..I2;
99
100 PROCEDURE PB1 (I : INT := -1) IS
101 BEGIN
102 FAILED ("BODY OF PB1 EXECUTED");
103 EXCEPTION
104 WHEN OTHERS =>
105 FAILED ("EXCEPTION RAISED IN PB1");
106 END PB1;
107
108 BEGIN
109 PB1;
110 EXCEPTION
111 WHEN CONSTRAINT_ERROR =>
112 NULL;
113 WHEN OTHERS =>
114 FAILED ("WRONG EXCEPTION RAISED - PB1");
115 END PB;
116
117 BEGIN -- (B)
118 PB (IDENT_INT(0), IDENT_INT(63));
119 EXCEPTION
120 WHEN OTHERS =>
121 FAILED ("EXCEPTION RAISED IN CALL TO PB");
122 END; -- (B)
123
124 --------------------------------------------------
125
126 DECLARE -- (C)
127
128 PROCEDURE PC (I1, I2 : INTEGER) IS
129 TYPE AR1 IS ARRAY (1..3) OF INTEGER RANGE I1..I2;
130 TYPE REC IS
131 RECORD
132 I : INTEGER RANGE I1..I2;
133 A : AR1 ;
134 END RECORD;
135
136 PROCEDURE PC1 (R : REC := (-3,(0,2,3))) IS
137 BEGIN
138 FAILED ("BODY OF PC1 EXECUTED");
139 EXCEPTION
140 WHEN OTHERS =>
141 FAILED ("EXCEPTION RAISED IN PC1");
142 END PC1;
143
144 BEGIN
145 PC1;
146 EXCEPTION
147 WHEN CONSTRAINT_ERROR =>
148 NULL;
149 WHEN OTHERS =>
150 FAILED ("WRONG EXCEPTION RAISED - PC1");
151 END PC;
152
153 BEGIN -- (C)
154 PC (IDENT_INT(1), IDENT_INT(3));
155 EXCEPTION
156 WHEN OTHERS =>
157 FAILED ("EXCEPTION RAISED IN CALL TO PC");
158 END; -- (C)
159
160 --------------------------------------------------
161
162 DECLARE -- (D1)
163
164 PROCEDURE P1D (I1, I2 : INTEGER) IS
165
166 TYPE A1 IS ARRAY (1..2,1..2) OF INTEGER RANGE I1..I2;
167
168 PROCEDURE P1D1 (A : A1 := ((1,-1),(1,2))) IS
169 BEGIN
170 FAILED ("BODY OF P1D1 EXECUTED");
171 EXCEPTION
172 WHEN OTHERS =>
173 FAILED ("EXCEPTION RAISED IN P1D1");
174 END P1D1;
175
176 BEGIN
177 P1D1;
178 EXCEPTION
179 WHEN CONSTRAINT_ERROR =>
180 NULL;
181 WHEN OTHERS =>
182 FAILED ("WRONG EXCEPTION RAISED - P1D1");
183 END P1D;
184
185 BEGIN -- (D1)
186 P1D (IDENT_INT(1), IDENT_INT(2));
187 EXCEPTION
188 WHEN OTHERS =>
189 FAILED ("EXCEPTION RAISED IN CALL TO P1D");
190 END; -- (D1)
191
192 --------------------------------------------------
193
194 DECLARE -- (D2)
195
196 PROCEDURE P2D (I1, I2 : INTEGER) IS
197
198 TYPE A1 IS ARRAY (1..2,1..2) OF INTEGER RANGE I1..I2;
199
200 PROCEDURE P2D1 (A : A1 := (3..4 => (1,2))) IS
201 BEGIN
202 FAILED ("BODY OF P2D1 EXECUTED");
203 EXCEPTION
204 WHEN OTHERS =>
205 FAILED ("EXCEPTION RAISED IN P2D1");
206 END P2D1;
207
208 BEGIN
209 P2D1;
210 EXCEPTION
211 WHEN CONSTRAINT_ERROR =>
212 NULL;
213 WHEN OTHERS =>
214 FAILED ("WRONG EXCEPTION RAISED - P2D1");
215 END P2D;
216
217 BEGIN -- (D2)
218 P2D (IDENT_INT(1), IDENT_INT(2));
219 EXCEPTION
220 WHEN OTHERS =>
221 FAILED ("EXCEPTION RAISED IN CALL TO P2D");
222 END; -- (D2)
223
224 --------------------------------------------------
225
226 DECLARE -- (E)
227
228 PROCEDURE PE (I1, I2 : INTEGER) IS
229 SUBTYPE INT IS INTEGER RANGE 0..10;
230 TYPE ARR IS ARRAY (1..3) OF INT;
231 TYPE REC (I : INT) IS
232 RECORD
233 A : ARR;
234 END RECORD;
235
236 SUBTYPE REC4 IS REC(I1);
237
238 PROCEDURE PE1 (R : REC4 := (3,(1,2,3))) IS
239 BEGIN
240 FAILED ("BODY OF PE1 EXECUTED");
241 EXCEPTION
242 WHEN OTHERS =>
243 FAILED ("EXCEPTION RAISED IN PE1");
244 END PE1;
245
246 BEGIN
247 PE1;
248 EXCEPTION
249 WHEN CONSTRAINT_ERROR =>
250 NULL;
251 WHEN OTHERS =>
252 FAILED ("WRONG EXCEPTION RAISED - PE1");
253 END PE;
254
255 BEGIN -- (E)
256 PE (IDENT_INT(4), IDENT_INT(10));
257 EXCEPTION
258 WHEN OTHERS =>
259 FAILED ("EXCEPTION RAISED IN CALL TO PE");
260 END; -- (E)
261
262 --------------------------------------------------
263
264 RESULT;
265
266 END C61008A;