1-- C35003B.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 THAT CONSTRAINT_ERROR IS RAISED FOR A SUBTYPE INDICATION
27--     OF A DISCRETE GENERIC FORMAL TYPE WHEN THE LOWER OR UPPER BOUND
28--     OF A NON-NULL RANGE LIES OUTSIDE THE RANGE OF THE TYPE MARK.
29
30-- HISTORY:
31--     JET 07/08/88  CREATED ORIGINAL TEST.
32
33WITH REPORT; USE REPORT;
34
35PROCEDURE C35003B IS
36
37     TYPE ENUM IS (WE, LOVE, WRITING, TESTS);
38     TYPE INT IS RANGE -10..10;
39
40     GENERIC
41          TYPE GEN_ENUM IS (<>);
42          TYPE GEN_INT IS RANGE <>;
43     PACKAGE GEN_PACK IS
44          SUBTYPE SUBENUM IS GEN_ENUM RANGE
45               GEN_ENUM'SUCC(GEN_ENUM'FIRST) ..
46               GEN_ENUM'PRED(GEN_ENUM'LAST);
47          SUBTYPE SUBINT IS GEN_INT RANGE
48               GEN_INT'SUCC(GEN_INT'FIRST) ..
49               GEN_INT'PRED(GEN_INT'LAST);
50          TYPE A1 IS ARRAY (0..GEN_INT'LAST) OF INTEGER;
51          TYPE A2 IS ARRAY (GEN_INT RANGE GEN_INT'FIRST..0) OF INTEGER;
52     END GEN_PACK;
53
54     PACKAGE BODY GEN_PACK IS
55     BEGIN
56          TEST ("C35003B", "CHECK THAT CONSTRAINT_ERROR IS RAISED " &
57                           "FOR A SUBTYPE INDICATION OF A DISCRETE " &
58                           "GENERIC FORMAL TYPE WHEN THE LOWER OR " &
59                           "UPPER BOUND OF A NON-NULL RANGE LIES " &
60                           "OUTSIDE THE RANGE OF THE TYPE MARK");
61          BEGIN
62               DECLARE
63                    SUBTYPE SUBSUBENUM IS SUBENUM RANGE
64                         GEN_ENUM'FIRST..SUBENUM'LAST;
65               BEGIN
66                    FAILED ("NO EXCEPTION RAISED (E1)");
67                    DECLARE
68                         Z : SUBSUBENUM := SUBENUM'FIRST;
69                    BEGIN
70                         IF NOT EQUAL(SUBSUBENUM'POS(Z),
71                                      SUBSUBENUM'POS(Z)) THEN
72                              COMMENT ("DON'T OPTIMIZE Z");
73                         END IF;
74                    END;
75               EXCEPTION
76                    WHEN OTHERS =>
77                         FAILED ("EXCEPTION RAISED IN WRONG " &
78                                 "PLACE (E1)");
79               END;
80          EXCEPTION
81               WHEN CONSTRAINT_ERROR =>
82                    NULL;
83               WHEN OTHERS =>
84                    FAILED ("WRONG EXCEPTION RAISED (E1)");
85          END;
86
87          BEGIN
88               DECLARE
89                    TYPE A IS ARRAY (SUBENUM RANGE SUBENUM'FIRST ..
90                         GEN_ENUM'LAST) OF INTEGER;
91               BEGIN
92                    FAILED ("NO EXCEPTION RAISED (E2)");
93                    DECLARE
94                         Z : A := (OTHERS => 0);
95                    BEGIN
96                         IF NOT EQUAL(Z(SUBENUM'FIRST),
97                                      Z(SUBENUM'FIRST)) THEN
98                              COMMENT ("DON'T OPTIMIZE Z");
99                         END IF;
100                    END;
101               EXCEPTION
102                    WHEN OTHERS =>
103                         FAILED ("EXCEPTION RAISED IN WRONG PLACE " &
104                                 "(E2)");
105               END;
106          EXCEPTION
107               WHEN CONSTRAINT_ERROR =>
108                    NULL;
109               WHEN OTHERS =>
110                    FAILED ("WRONG EXCEPTION RAISED (E2)");
111          END;
112
113          BEGIN
114               DECLARE
115                    TYPE I IS ACCESS SUBINT RANGE
116                         GEN_INT'FIRST..SUBINT'LAST;
117               BEGIN
118                    FAILED ("NO EXCEPTION RAISED (I1)");
119                    DECLARE
120                         Z : I := NEW SUBINT'(SUBINT'FIRST);
121                    BEGIN
122                         IF NOT EQUAL(INTEGER(Z.ALL),INTEGER(Z.ALL))
123                         THEN
124                              COMMENT ("DON'T OPTIMIZE Z");
125                         END IF;
126                    END;
127               EXCEPTION
128                    WHEN OTHERS =>
129                         FAILED ("EXCEPTION RAISED IN WRONG PLACE " &
130                                 "(I1)");
131               END;
132          EXCEPTION
133               WHEN CONSTRAINT_ERROR =>
134                    NULL;
135               WHEN OTHERS =>
136                    FAILED ("WRONG EXCEPTION RAISED (I1)");
137          END;
138
139          BEGIN
140               DECLARE
141                    TYPE I IS NEW
142                         SUBINT RANGE SUBINT'FIRST..GEN_INT'LAST;
143               BEGIN
144                    FAILED ("NO EXCEPTION RAISED (I2)");
145                    DECLARE
146                         Z : I := I'FIRST;
147                    BEGIN
148                         IF NOT EQUAL(INTEGER(Z),INTEGER(Z)) THEN
149                              COMMENT ("DON'T OPTIMIZE Z");
150                         END IF;
151                    END;
152               EXCEPTION
153                    WHEN OTHERS =>
154                         FAILED ("EXCEPTION RAISED IN WRONG PLACE " &
155                                 "(I2)");
156               END;
157          EXCEPTION
158               WHEN CONSTRAINT_ERROR =>
159                    NULL;
160               WHEN OTHERS =>
161                    FAILED ("WRONG EXCEPTION RAISED (I2)");
162          END;
163
164          BEGIN
165               DECLARE
166                    SUBTYPE I IS SUBINT RANGE A1'RANGE;
167               BEGIN
168                    FAILED ("NO EXCEPTION RAISED (R1)");
169                    DECLARE
170                         Z : I := SUBINT'FIRST;
171                    BEGIN
172                         IF NOT EQUAL(INTEGER(Z),INTEGER(Z)) THEN
173                              COMMENT ("DON'T OPTIMIZE Z");
174                         END IF;
175                    END;
176               EXCEPTION
177                    WHEN OTHERS =>
178                         FAILED ("EXCEPTION RAISED IN WRONG PLACE " &
179                                 "(R1)");
180               END;
181          EXCEPTION
182               WHEN CONSTRAINT_ERROR =>
183                    NULL;
184               WHEN OTHERS =>
185                    FAILED ("WRONG EXCEPTION RAISED (R1)");
186          END;
187
188          BEGIN
189               DECLARE
190                    SUBTYPE I IS SUBINT RANGE A2'RANGE;
191               BEGIN
192                    FAILED ("NO EXCEPTION RAISED (R2)");
193                    DECLARE
194                         Z : I := 1;
195                    BEGIN
196                         IF NOT EQUAL(INTEGER(Z),INTEGER(Z)) THEN
197                              COMMENT ("DON'T OPTIMIZE Z");
198                         END IF;
199                    END;
200               EXCEPTION
201                    WHEN OTHERS =>
202                         FAILED ("EXCEPTION RAISED IN WRONG PLACE " &
203                                 "(R2)");
204               END;
205          EXCEPTION
206               WHEN CONSTRAINT_ERROR =>
207                    NULL;
208               WHEN OTHERS =>
209                    FAILED ("WRONG EXCEPTION RAISED (R2)");
210          END;
211     END GEN_PACK;
212
213     PACKAGE ENUM_PACK IS NEW GEN_PACK(ENUM, INT);
214
215BEGIN
216     RESULT;
217END C35003B;
218