1-- C37215D.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 IF
26--        AN INDEX CONSTRAINT
27-- DEPENDS ON A DISCRIMINANT, THE DISCRIMINANT VALUE IS CHECKED FOR
28-- COMPATIBILITY WHEN THE RECORD TYPE IS:
29--
30--   CASE B: USED WITHOUT A CONSTRAINT ONLY IN AN ALLOCATOR OR OBJECT
31--      DECLARATION.
32
33-- JBG 10/17/86
34
35WITH REPORT; USE REPORT;
36PROCEDURE C37215D IS
37
38     SUBTYPE SM IS INTEGER RANGE 1..10;
39
40     TYPE MY_ARR IS ARRAY (SM RANGE <>) OF INTEGER;
41
42BEGIN
43     TEST ("C37215D", "CHECK COMPATIBILITY OF INDEX BOUNDS " &
44                      "WHEN CONSTRAINT DEPENDS ON DISCRIMINANT, " &
45                      "AND DISCRIMINANTS HAVE DEFAULTS");
46
47-- CASE B
48
49     DECLARE
50          TYPE CONS (D3 : INTEGER := IDENT_INT(11)) IS
51               RECORD
52                    C1 : MY_ARR(2..D3);
53               END RECORD;
54     BEGIN
55          BEGIN
56               DECLARE
57                    X : CONS;
58               BEGIN
59                    FAILED ("INDEX CHECK NOT PERFORMED - 1");
60                    IF X /= (1, (1, 1)) THEN
61                         COMMENT ("SHOULDN'T GET HERE");
62                    END IF;
63               END;
64          EXCEPTION
65               WHEN CONSTRAINT_ERROR =>
66                    NULL;
67               WHEN OTHERS =>
68                    FAILED ("UNEXPECTED EXCEPTION - 1");
69          END;
70
71          BEGIN
72               DECLARE
73                    TYPE ACC_CONS IS ACCESS CONS;
74                    X : ACC_CONS;
75               BEGIN
76                    X := NEW CONS;
77                    FAILED ("INDEX CHECK NOT PERFORMED - 2");
78                    BEGIN
79                         IF X.ALL /= (1, (1 => 1)) THEN
80                              COMMENT ("IRRELEVANT");
81                         END IF;
82                    END;
83               EXCEPTION
84                    WHEN CONSTRAINT_ERROR =>
85                         NULL;
86                    WHEN OTHERS =>
87                         FAILED ("UNEXPECTED EXCEPTION RAISED - 2");
88               END;
89          EXCEPTION
90               WHEN OTHERS =>
91                    FAILED ("CONSTRAINT CHECKED TOO SOON - 2");
92          END;
93
94          BEGIN
95               DECLARE
96                    SUBTYPE SCONS IS CONS;
97               BEGIN
98                    DECLARE
99                         X : SCONS;
100                    BEGIN
101                         FAILED ("INDEX CHECK NOT " &
102                                 "PERFORMED - 3");
103                         IF X /= (1, (1 => 1)) THEN
104                              COMMENT ("IRRELEVANT");
105                         END IF;
106                    END;
107               EXCEPTION
108                    WHEN CONSTRAINT_ERROR =>
109                         NULL;
110                    WHEN OTHERS =>
111                         FAILED ("UNEXPECTED EXCEPTION RAISED - 3");
112               END;
113          EXCEPTION
114               WHEN OTHERS =>
115                    FAILED ("CONSTRAINT CHECKED TOO SOON - 3");
116          END;
117
118          BEGIN
119               DECLARE
120                    TYPE ARR IS ARRAY (1..5) OF CONS;
121               BEGIN
122                    DECLARE
123                         X : ARR;
124                    BEGIN
125                         FAILED ("INDEX CHECK NOT " &
126                                 "PERFORMED - 4");
127                         IF X /= (1..5 => (1, (1 => 1))) THEN
128                              COMMENT ("IRRELEVANT");
129                         END IF;
130                    END;
131               EXCEPTION
132                    WHEN CONSTRAINT_ERROR =>
133                         NULL;
134                    WHEN OTHERS =>
135                         FAILED ("UNEXPECTED EXCEPTION RAISED - 4");
136               END;
137          EXCEPTION
138               WHEN OTHERS =>
139                    FAILED ("CONSTRAINT CHECKED TOO SOON - 4");
140          END;
141
142          BEGIN
143               DECLARE
144                    TYPE NREC IS
145                         RECORD
146                              C1 : CONS;
147                         END RECORD;
148               BEGIN
149                    DECLARE
150                         X : NREC;
151                    BEGIN
152                         FAILED ("INDEX CHECK NOT " &
153                                 "PERFORMED - 5");
154                         IF X /= (C1 => (1, (1 => 1))) THEN
155                              COMMENT ("IRRELEVANT");
156                         END IF;
157                    END;
158               EXCEPTION
159                    WHEN CONSTRAINT_ERROR =>
160                         NULL;
161                    WHEN OTHERS =>
162                         FAILED ("UNEXPECTED EXCEPTION RAISED - 5");
163               END;
164          EXCEPTION
165               WHEN OTHERS =>
166                    FAILED ("CONSTRAINT CHECKED TOO SOON - 5");
167          END;
168
169          BEGIN
170               DECLARE
171                    TYPE DREC IS NEW CONS;
172               BEGIN
173                    DECLARE
174                         X : DREC;
175                    BEGIN
176                         FAILED ("INDEX CHECK NOT " &
177                                 "PERFORMED - 6");
178                         IF X /= (1, (1 => 1)) THEN
179                              COMMENT ("IRRELEVANT");
180                         END IF;
181                    END;
182               EXCEPTION
183                    WHEN CONSTRAINT_ERROR =>
184                         NULL;
185                    WHEN OTHERS =>
186                         FAILED ("UNEXPECTED EXCEPTION RAISED - 6");
187               END;
188          EXCEPTION
189               WHEN OTHERS =>
190                    FAILED ("CONSTRAINT CHECKED TOO SOON - 6");
191          END;
192
193     END;
194
195     RESULT;
196
197EXCEPTION
198     WHEN OTHERS =>
199          FAILED ("CONSTRAINT CHECK DONE TOO EARLY");
200          RESULT;
201
202END C37215D;
203