|
111
|
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;
|
