1-- C43214A.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-- FOR A MULTIDIMENSIONAL AGGREGATE OF THE FORM (F..G => ""), CHECK
26-- THAT CONSTRAINT_ERROR IS RAISED IF F..G IS NON-NULL AND
27-- F OR G DO NOT BELONG TO THE INDEX SUBTYPE.
28
29-- EG  02/10/1984
30-- JBG 12/6/84
31-- EDS 07/15/98     AVOID OPTIMIZATION
32
33WITH REPORT;
34
35PROCEDURE C43214A IS
36
37     USE REPORT;
38
39BEGIN
40
41     TEST("C43214A", "FOR A MULTIDIMENSIONAL AGGREGATE OF THE FORM " &
42                     "(F..G => """"), CHECK THAT CONSTRAINT ERROR "  &
43                     "IS RAISED IF F..G IS NON-NULL AND NOT IN THE " &
44                     "INDEX SUBTYPE");
45
46     DECLARE
47
48          SUBTYPE STA IS INTEGER RANGE 4 .. 7;
49          TYPE TA IS ARRAY(STA RANGE 5 .. 6,
50                           STA RANGE 6 .. IDENT_INT(4)) OF CHARACTER;
51
52          A : TA := (5 .. 6 => "");
53
54     BEGIN
55
56CASE_A :  BEGIN
57
58               IF (6 .. IDENT_INT(8) => "") = A THEN
59                    FAILED ("CASE A : CONSTRAINT_ERROR NOT RAISED");
60               END IF;
61               FAILED ("CASE A : CONSTRAINT_ERROR NOT RAISED - 2");
62
63          EXCEPTION
64
65               WHEN CONSTRAINT_ERROR =>
66                    NULL;
67
68               WHEN OTHERS =>
69                    FAILED ("CASE A : WRONG EXCEPTION RAISED");
70
71          END CASE_A;
72
73CASE_B :  BEGIN
74
75               A := (IDENT_INT(3) .. 4 => "");
76               FAILED ("CASE B : CONSTRAINT_ERROR NOT RAISED");
77               BEGIN
78                  FAILED("ATTEMPT TO USE A " &
79                         CHARACTER'VAL(IDENT_INT(CHARACTER'POS(
80                            A(A'FIRST(1), A'FIRST(2)) ))) );
81               EXCEPTION
82                  WHEN OTHERS =>
83                     FAILED("CONSTRAINT_ERROR NOT RAISED AT PROPER PLACE");
84               END;
85
86          EXCEPTION
87
88               WHEN CONSTRAINT_ERROR =>
89                    NULL;
90
91               WHEN OTHERS =>
92                    FAILED ("CASE B : WRONG EXCEPTION RAISED");
93
94          END CASE_B;
95
96     END;
97
98     RESULT;
99
100END C43214A;
101