|
111
|
1 -- C37213H.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 -- CHECK, WHERE AN INDEX CONSTRAINT DEPENDS ON A RECORD
|
|
|
27 -- DISCRIMINANT WITH A DEFAULT VALUE AND THE RECORD TYPE IS NOT
|
|
|
28 -- EXPLICITLY CONSTRAINED, THAT THE NON-DISCRIMINANT EXPRESSIONS
|
|
|
29 -- IN THE INDEX CONSTRAINT ARE:
|
|
|
30 -- 1) EVALUATED WHEN THE RECORD COMPONENT SUBTYPE DEFINITION
|
|
|
31 -- IS ELABORATED,
|
|
|
32 -- 2) PROPERLY CHECKED FOR COMPATIBILITY ONLY IN AN ALLOCATION
|
|
|
33 -- OR OBJECT DECLARATION AND ONLY IF THE DISCRIMINANT-
|
|
|
34 -- DEPENDENT COMPONENT IS PRESENT IN THE SUBTYPE.
|
|
|
35
|
|
|
36 -- HISTORY:
|
|
|
37 -- JBG 10/17/86 CREATED ORIGINAL TEST.
|
|
|
38 -- VCL 10/23/87 MODIFIED THIS HEADER; MODIFIED THE CHECK OF
|
|
|
39 -- SUBTYPE 'SCONS', IN BOTH SUBPARTS OF THE TEST,
|
|
|
40 -- TO INDICATE FAILURE IF CONSTRAINT_ERROR IS RAISED
|
|
|
41 -- FOR THE SUBTYPE DECLARATION AND FAILURE IF
|
|
|
42 -- CONSTRAINT_ERROR IS NOT RAISED FOR AN OBJECT
|
|
|
43 -- DECLARATION OF THIS SUBTYPE; RELOCATED THE CALL TO
|
|
|
44 -- REPORT.TEST SO THAT IT COMES BEFORE ANY
|
|
|
45 -- DECLARATIONS; ADDED 'SEQUENCE_NUMBER' TO IDENTIFY
|
|
|
46 -- THE CURRENT SUBTEST (FOR EXCEPTIONS); CHANGE THE
|
|
|
47 -- TYPE OF THE DISCRIMINANT IN THE RECORD 'CONS'
|
|
|
48 -- TO AN INTEGER SUBTYPE.
|
|
|
49 -- VCL 03/30/88 MODIFIED HEADER AND MESSAGES OUTPUT BY REPORT
|
|
|
50 -- PACKAGE.
|
|
|
51
|
|
|
52 WITH REPORT; USE REPORT;
|
|
|
53 PROCEDURE C37213H IS
|
|
|
54 BEGIN
|
|
|
55 TEST ("C37213H", "THE NON-DISCRIMINANT EXPRESSIONS OF AN " &
|
|
|
56 "INDEX CONSTRAINT THAT DEPEND ON A " &
|
|
|
57 "DISCRIMINANT WITH A DEFAULT VALUE ARE " &
|
|
|
58 "PROPERLY EVALUATED AND CHECKED WHEN THE " &
|
|
|
59 "RECORD TYPE IS NOT EXPLICITLY CONSTRAINED AND " &
|
|
|
60 "THE COMPONENT IS AND IS NOT PRESENT IN THE " &
|
|
|
61 "SUBTYPE");
|
|
|
62
|
|
|
63 DECLARE
|
|
|
64 SEQUENCE_NUMBER : INTEGER;
|
|
|
65
|
|
|
66 SUBTYPE DISCR IS INTEGER RANGE -50..50;
|
|
|
67 SUBTYPE SM IS INTEGER RANGE 1..10;
|
|
|
68 TYPE MY_ARR IS ARRAY (SM RANGE <>) OF INTEGER;
|
|
|
69
|
|
|
70 F1_CONS : INTEGER := 2;
|
|
|
71
|
|
|
72 FUNCTION CHK (
|
|
|
73 CONS : INTEGER;
|
|
|
74 VALUE : INTEGER;
|
|
|
75 MESSAGE : STRING) RETURN BOOLEAN IS
|
|
|
76 BEGIN
|
|
|
77 IF CONS /= VALUE THEN
|
|
|
78 FAILED (MESSAGE & ": F1_CONS IS " &
|
|
|
79 INTEGER'IMAGE(F1_CONS));
|
|
|
80 END IF;
|
|
|
81 RETURN TRUE;
|
|
|
82 END CHK;
|
|
|
83
|
|
|
84 FUNCTION F1 RETURN INTEGER IS
|
|
|
85 BEGIN
|
|
|
86 F1_CONS := F1_CONS - IDENT_INT(1);
|
|
|
87 RETURN F1_CONS;
|
|
|
88 END F1;
|
|
|
89 BEGIN
|
|
|
90
|
|
|
91
|
|
|
92 -- CASE 1: DISCRIMINANT-DEPENDENT COMPONENT IS PRESENT.
|
|
|
93
|
|
|
94 SEQUENCE_NUMBER :=1;
|
|
|
95 DECLARE
|
|
|
96 TYPE CONS (D3 : DISCR := IDENT_INT(1)) IS
|
|
|
97 RECORD
|
|
|
98 CASE D3 IS
|
|
|
99 WHEN -5..10 =>
|
|
|
100 C1 : MY_ARR(F1..D3); -- F1 EVALUATED.
|
|
|
101 WHEN OTHERS =>
|
|
|
102 C2 : INTEGER := IDENT_INT(0);
|
|
|
103 END CASE;
|
|
|
104 END RECORD;
|
|
|
105
|
|
|
106 CHK1 : BOOLEAN := CHK (F1_CONS, 1, "F1 NOT EVALUATED");
|
|
|
107
|
|
|
108 X : CONS; -- F1 NOT EVALUATED AGAIN.
|
|
|
109 Y : CONS; -- F1 NOT EVALUATED AGAIN.
|
|
|
110
|
|
|
111 CHK2 : BOOLEAN := CHK (F1_CONS, 1, "F1 EVALUATED");
|
|
|
112 BEGIN
|
|
|
113 IF X.C1'FIRST /= 1 OR Y.C1'LAST /= 1 THEN
|
|
|
114 FAILED ("VALUES NOT CORRECT");
|
|
|
115 END IF;
|
|
|
116 END;
|
|
|
117
|
|
|
118
|
|
|
119 F1_CONS := 12;
|
|
|
120
|
|
|
121 SEQUENCE_NUMBER := 2;
|
|
|
122 DECLARE
|
|
|
123 TYPE CONS (D3 : DISCR := IDENT_INT(1)) IS
|
|
|
124 RECORD
|
|
|
125 CASE D3 IS
|
|
|
126 WHEN -5..10 =>
|
|
|
127 C1 : MY_ARR(D3..F1);
|
|
|
128 WHEN OTHERS =>
|
|
|
129 C2 : INTEGER := IDENT_INT(0);
|
|
|
130 END CASE;
|
|
|
131 END RECORD;
|
|
|
132 BEGIN
|
|
|
133 BEGIN
|
|
|
134 DECLARE
|
|
|
135 X : CONS;
|
|
|
136 BEGIN
|
|
|
137 FAILED ("INDEX CHECK NOT PERFORMED - 1");
|
|
|
138 IF X /= (1, (1, 1)) THEN
|
|
|
139 COMMENT ("INCORRECT VALUES FOR X - 1");
|
|
|
140 END IF;
|
|
|
141 END;
|
|
|
142 EXCEPTION
|
|
|
143 WHEN CONSTRAINT_ERROR =>
|
|
|
144 NULL;
|
|
|
145 WHEN OTHERS =>
|
|
|
146 FAILED ("UNEXPECTED EXCEPTION RAISED - 1");
|
|
|
147 END;
|
|
|
148
|
|
|
149 BEGIN
|
|
|
150 DECLARE
|
|
|
151 SUBTYPE SCONS IS CONS;
|
|
|
152 BEGIN
|
|
|
153 DECLARE
|
|
|
154 X : SCONS;
|
|
|
155 BEGIN
|
|
|
156 FAILED ("INDEX CHECK NOT PERFORMED - 2");
|
|
|
157 IF X /= (1, (1, 1)) THEN
|
|
|
158 COMMENT ("INCORRECT VALUES FOR X " &
|
|
|
159 "- 2");
|
|
|
160 END IF;
|
|
|
161 END;
|
|
|
162 EXCEPTION
|
|
|
163 WHEN CONSTRAINT_ERROR =>
|
|
|
164 NULL;
|
|
|
165 WHEN OTHERS =>
|
|
|
166 FAILED ("UNEXPECTED EXCEPTION RAISED " &
|
|
|
167 "- 2A");
|
|
|
168 END;
|
|
|
169 EXCEPTION
|
|
|
170 WHEN OTHERS =>
|
|
|
171 FAILED ("UNEXPECTED EXCEPTION RAISED - 2B");
|
|
|
172 END;
|
|
|
173
|
|
|
174 BEGIN
|
|
|
175 DECLARE
|
|
|
176 TYPE ARR IS ARRAY (1..5) OF CONS;
|
|
|
177 BEGIN
|
|
|
178 DECLARE
|
|
|
179 X : ARR;
|
|
|
180 BEGIN
|
|
|
181 FAILED ("INDEX CHECK NOT PERFORMED - 3");
|
|
|
182 IF X /= (1..5 => (1, (1, 1))) THEN
|
|
|
183 COMMENT ("INCORRECT VALUES FOR X " &
|
|
|
184 "- 3");
|
|
|
185 END IF;
|
|
|
186 END;
|
|
|
187 EXCEPTION
|
|
|
188 WHEN CONSTRAINT_ERROR =>
|
|
|
189 NULL;
|
|
|
190 WHEN OTHERS =>
|
|
|
191 FAILED ("UNEXPECTED EXCEPTION RAISED " &
|
|
|
192 "- 3A");
|
|
|
193 END;
|
|
|
194 EXCEPTION
|
|
|
195 WHEN OTHERS =>
|
|
|
196 FAILED ("UNEXPECTED EXCEPTION RAISED - 3B");
|
|
|
197 END;
|
|
|
198
|
|
|
199 BEGIN
|
|
|
200 DECLARE
|
|
|
201 TYPE NREC IS
|
|
|
202 RECORD
|
|
|
203 C1 : CONS;
|
|
|
204 END RECORD;
|
|
|
205 BEGIN
|
|
|
206 DECLARE
|
|
|
207 X : NREC;
|
|
|
208 BEGIN
|
|
|
209 FAILED ("INDEX CHECK NOT PERFORMED - 4");
|
|
|
210 IF X /= (C1 => (1, (1, 1))) THEN
|
|
|
211 COMMENT ("INCORRECT VALUES FOR X " &
|
|
|
212 "- 4");
|
|
|
213 END IF;
|
|
|
214 END;
|
|
|
215 EXCEPTION
|
|
|
216 WHEN CONSTRAINT_ERROR =>
|
|
|
217 NULL;
|
|
|
218 WHEN OTHERS =>
|
|
|
219 FAILED ("UNEXPECTED EXCEPTION RAISED " &
|
|
|
220 "- 4A");
|
|
|
221 END;
|
|
|
222 EXCEPTION
|
|
|
223 WHEN OTHERS =>
|
|
|
224 FAILED ("UNEXPECTED EXCEPTION RAISED - 4B");
|
|
|
225 END;
|
|
|
226
|
|
|
227 BEGIN
|
|
|
228 DECLARE
|
|
|
229 TYPE NREC IS NEW CONS;
|
|
|
230 BEGIN
|
|
|
231 DECLARE
|
|
|
232 X : NREC;
|
|
|
233 BEGIN
|
|
|
234 FAILED ("INDEX CHECK NOT PERFORMED - 5");
|
|
|
235 IF X /= (1, (1, 1)) THEN
|
|
|
236 COMMENT ("INCORRECT VALUES FOR X " &
|
|
|
237 "- 5");
|
|
|
238 END IF;
|
|
|
239 END;
|
|
|
240 EXCEPTION
|
|
|
241 WHEN CONSTRAINT_ERROR =>
|
|
|
242 NULL;
|
|
|
243 WHEN OTHERS =>
|
|
|
244 FAILED ("UNEXPECTED EXCEPTION RAISED " &
|
|
|
245 "- 5A");
|
|
|
246 END;
|
|
|
247 EXCEPTION
|
|
|
248 WHEN OTHERS =>
|
|
|
249 FAILED ("UNEXPECTED EXCEPTION RAISED - 5B");
|
|
|
250 END;
|
|
|
251
|
|
|
252 BEGIN
|
|
|
253 DECLARE
|
|
|
254 TYPE ACC_CONS IS ACCESS CONS;
|
|
|
255 BEGIN
|
|
|
256 DECLARE
|
|
|
257 X : ACC_CONS;
|
|
|
258 BEGIN
|
|
|
259 X := NEW CONS;
|
|
|
260 FAILED ("INDEX CHECK NOT PERFORMED - 6");
|
|
|
261 IF X.ALL /= (1, (1, 1)) THEN
|
|
|
262 COMMENT ("INCORRECT VALUES FOR X " &
|
|
|
263 "- 6");
|
|
|
264 END IF;
|
|
|
265 EXCEPTION
|
|
|
266 WHEN CONSTRAINT_ERROR =>
|
|
|
267 NULL;
|
|
|
268 WHEN OTHERS =>
|
|
|
269 COMMENT ("UNEXPECTED EXCEPTION " &
|
|
|
270 "RAISED - 6A");
|
|
|
271 END;
|
|
|
272 EXCEPTION
|
|
|
273 WHEN OTHERS =>
|
|
|
274 COMMENT ("UNEXPECTED EXCEPTION RAISED " &
|
|
|
275 "- 6B");
|
|
|
276 END;
|
|
|
277 EXCEPTION
|
|
|
278 WHEN OTHERS =>
|
|
|
279 FAILED ("UNEXPECTED EXCEPTION RAISED - 6C");
|
|
|
280 END;
|
|
|
281 END;
|
|
|
282
|
|
|
283
|
|
|
284 -- CASE D2: DISCRIMINANT-DEPENDENT COMPONENT IS ABSENT.
|
|
|
285
|
|
|
286 F1_CONS := 2;
|
|
|
287
|
|
|
288 SEQUENCE_NUMBER := 3;
|
|
|
289 DECLARE
|
|
|
290 TYPE CONS (D3 : DISCR := IDENT_INT(-6)) IS
|
|
|
291 RECORD
|
|
|
292 CASE D3 IS
|
|
|
293 WHEN -5..10 =>
|
|
|
294 C1 : MY_ARR(D3..F1); -- F1 EVALUATED.
|
|
|
295 WHEN OTHERS =>
|
|
|
296 C2 : INTEGER := IDENT_INT(0);
|
|
|
297 END CASE;
|
|
|
298 END RECORD;
|
|
|
299 CHK1 : BOOLEAN := CHK (F1_CONS, 1, "F1 NOT EVALUATED");
|
|
|
300
|
|
|
301 X : CONS; -- F1 NOT EVALUATED AGAIN.
|
|
|
302 Y : CONS; -- F1 NOT EVALUATED AGAIN.
|
|
|
303
|
|
|
304 CHK2 : BOOLEAN := CHK (F1_CONS, 1, "F1 EVALUATED");
|
|
|
305 BEGIN
|
|
|
306 IF X /= (-6, 0) OR Y /= (-6, 0) THEN
|
|
|
307 FAILED ("VALUES NOT CORRECT");
|
|
|
308 END IF;
|
|
|
309 END;
|
|
|
310
|
|
|
311 F1_CONS := 12;
|
|
|
312
|
|
|
313 SEQUENCE_NUMBER := 4;
|
|
|
314 DECLARE
|
|
|
315 TYPE CONS (D3 : DISCR := IDENT_INT(11)) IS
|
|
|
316 RECORD
|
|
|
317 CASE D3 IS
|
|
|
318 WHEN -5..10 =>
|
|
|
319 C1 : MY_ARR(D3..F1);
|
|
|
320 WHEN OTHERS =>
|
|
|
321 C2 : INTEGER := IDENT_INT(0);
|
|
|
322 END CASE;
|
|
|
323 END RECORD;
|
|
|
324 BEGIN
|
|
|
325 BEGIN
|
|
|
326 DECLARE
|
|
|
327 X : CONS;
|
|
|
328 BEGIN
|
|
|
329 IF X /= (11, 0) THEN
|
|
|
330 FAILED ("X VALUE IS INCORRECT - 11");
|
|
|
331 END IF;
|
|
|
332 END;
|
|
|
333 EXCEPTION
|
|
|
334 WHEN OTHERS =>
|
|
|
335 FAILED ("UNEXPECTED EXCEPTION RAISED - 11");
|
|
|
336 END;
|
|
|
337
|
|
|
338 BEGIN
|
|
|
339 DECLARE
|
|
|
340 SUBTYPE SCONS IS CONS;
|
|
|
341 BEGIN
|
|
|
342 DECLARE
|
|
|
343 X : SCONS;
|
|
|
344 BEGIN
|
|
|
345 IF X /= (11, 0) THEN
|
|
|
346 FAILED ("X VALUE INCORRECT - 12");
|
|
|
347 END IF;
|
|
|
348 END;
|
|
|
349 EXCEPTION
|
|
|
350 WHEN OTHERS =>
|
|
|
351 FAILED ("UNEXPECTED EXCEPTION RAISED - " &
|
|
|
352 "12A");
|
|
|
353 END;
|
|
|
354 EXCEPTION
|
|
|
355 WHEN OTHERS =>
|
|
|
356 FAILED ("UNEXPECTED EXCEPTION RAISED - 12B");
|
|
|
357 END;
|
|
|
358
|
|
|
359 BEGIN
|
|
|
360 DECLARE
|
|
|
361 TYPE ARR IS ARRAY (1..5) OF CONS;
|
|
|
362 BEGIN
|
|
|
363 DECLARE
|
|
|
364 X : ARR;
|
|
|
365 BEGIN
|
|
|
366 IF X /= (1..5 => (11, 0)) THEN
|
|
|
367 FAILED ("X VALUE INCORRECT - 13");
|
|
|
368 END IF;
|
|
|
369 END;
|
|
|
370 EXCEPTION
|
|
|
371 WHEN OTHERS =>
|
|
|
372 FAILED ("UNEXPECTED EXCEPTION RAISED - " &
|
|
|
373 "13A");
|
|
|
374 END;
|
|
|
375 EXCEPTION
|
|
|
376 WHEN OTHERS =>
|
|
|
377 FAILED ("UNEXPECTED EXCEPTION RAISED - 13B");
|
|
|
378 END;
|
|
|
379
|
|
|
380 BEGIN
|
|
|
381 DECLARE
|
|
|
382 TYPE NREC IS
|
|
|
383 RECORD
|
|
|
384 C1 : CONS;
|
|
|
385 END RECORD;
|
|
|
386 BEGIN
|
|
|
387 DECLARE
|
|
|
388 X : NREC;
|
|
|
389 BEGIN
|
|
|
390 IF X /= (C1 => (11, 0)) THEN
|
|
|
391 FAILED ("X VALUE INCORRECT - 14");
|
|
|
392 END IF;
|
|
|
393 END;
|
|
|
394 EXCEPTION
|
|
|
395 WHEN OTHERS =>
|
|
|
396 FAILED ("UNEXPECTED EXCEPTION RAISED - " &
|
|
|
397 "14A");
|
|
|
398 END;
|
|
|
399 EXCEPTION
|
|
|
400 WHEN OTHERS =>
|
|
|
401 FAILED ("UNEXPECTED EXCEPTION RAISED - 14B");
|
|
|
402 END;
|
|
|
403
|
|
|
404 BEGIN
|
|
|
405 DECLARE
|
|
|
406 TYPE NREC IS NEW CONS;
|
|
|
407 BEGIN
|
|
|
408 DECLARE
|
|
|
409 X : NREC;
|
|
|
410 BEGIN
|
|
|
411 IF X /= (11, 0) THEN
|
|
|
412 FAILED ("X VALUE INCORRECT - 15");
|
|
|
413 END IF;
|
|
|
414 END;
|
|
|
415 EXCEPTION
|
|
|
416 WHEN CONSTRAINT_ERROR =>
|
|
|
417 NULL;
|
|
|
418 WHEN OTHERS =>
|
|
|
419 FAILED ("UNEXPECTED EXCEPTION RAISED - " &
|
|
|
420 "15A");
|
|
|
421 END;
|
|
|
422 EXCEPTION
|
|
|
423 WHEN OTHERS =>
|
|
|
424 FAILED ("UNEXPECTED EXCEPTION RAISED - 15B");
|
|
|
425 END;
|
|
|
426
|
|
|
427 BEGIN
|
|
|
428 DECLARE
|
|
|
429 TYPE ACC_CONS IS ACCESS CONS;
|
|
|
430 X : ACC_CONS;
|
|
|
431 BEGIN
|
|
|
432 X := NEW CONS;
|
|
|
433 IF X.ALL /= (11, 0) THEN
|
|
|
434 FAILED ("X VALUE INCORRECT - 17");
|
|
|
435 END IF;
|
|
|
436 EXCEPTION
|
|
|
437 WHEN OTHERS =>
|
|
|
438 FAILED ("UNEXPECTED EXCEPTION RAISED - " &
|
|
|
439 "17A");
|
|
|
440 END;
|
|
|
441 EXCEPTION
|
|
|
442 WHEN OTHERS =>
|
|
|
443 FAILED ("UNEXPECTED EXCEPTION RAISED - 17B");
|
|
|
444 END;
|
|
|
445 END;
|
|
|
446
|
|
|
447 EXCEPTION
|
|
|
448 WHEN CONSTRAINT_ERROR =>
|
|
|
449 FAILED ("INDEX VALUES IMPROPERLY CHECKED - " &
|
|
|
450 INTEGER'IMAGE (SEQUENCE_NUMBER));
|
|
|
451 WHEN OTHERS =>
|
|
|
452 FAILED ("UNEXPECTED EXCEPTION RAISED " &
|
|
|
453 INTEGER'IMAGE (SEQUENCE_NUMBER));
|
|
|
454 END;
|
|
|
455
|
|
|
456 RESULT;
|
|
|
457 END C37213H;
|
