1-- C38107B.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--     IF A DISCRIMINANT CONSTRAINT IS APPLIED TO AN ACCESS TYPE WHICH
27--     DESIGNATES AN INCOMPLETE TYPE WHICH WAS DECLARED IN THE VISIBLE
28--     OR PRIVATE PART OF A PACKAGE SPECIFICATION, OR IN A DECLARATIVE
29--     PART, CONSTRAINT_ERROR IS RAISED IF ONE OF THE
30--     DISCRIMINANT'S VALUES DOES NOT BELONG TO THE CORRESPONDING
31--     DISCRIMINANT'S SUBTYPE.
32
33-- HISTORY:
34--     DHH 08/05/88 CREATED ORIGINAL TEST.
35
36WITH REPORT; USE REPORT;
37PROCEDURE C38107B IS
38
39BEGIN
40     TEST("C38107B", "IF A DISCRIMINANT CONSTRAINT IS APPLIED TO AN " &
41                     "ACCESS TYPE WHICH DESIGNATES AN INCOMPLETE " &
42                     "TYPE WHICH WAS DECLARED IN THE VISIBLE OR " &
43                     "PRIVATE PART OF A PACKAGE SPECIFICATION, OR IN " &
44                     "A DECLARATIVE PART, CONSTRAINT_ERROR IS " &
45                     "RAISED IF ONE OF THE DISCRIMINANT'S VALUES " &
46                     "DOES NOT BELONG TO THE CORRESPONDING " &
47                     "DISCRIMINANT'S SUBTYPE");
48
49------------------------------ VISIBLE ------------------------------
50     BEGIN
51          DECLARE
52               PACKAGE PACK IS
53                    SUBTYPE SMALLER IS INTEGER RANGE 1 .. 5;
54
55                    TYPE INCOMPLETE(A : SMALLER);
56
57                    TYPE ACC_INC IS ACCESS INCOMPLETE;
58                    SUBTYPE SUB_ACC IS ACC_INC(IDENT_INT(6));
59
60                    TYPE INCOMPLETE(A : SMALLER) IS
61                         RECORD
62                              T : INTEGER := A;
63                         END RECORD;
64
65               END PACK;
66
67               PACKAGE BODY PACK IS
68               BEGIN
69                    FAILED("CONSTRAINT_ERROR NOT RAISED - VISIBLE");
70                    DECLARE
71                         Z : SUB_ACC := NEW INCOMPLETE(IDENT_INT(6));
72                    BEGIN
73                         IF IDENT_INT(Z.T) = IDENT_INT(6) THEN
74                              COMMENT("THIS LINE SHOULD NOT PRINT");
75                         END IF;
76                    END;
77               EXCEPTION
78                    WHEN CONSTRAINT_ERROR =>
79                         FAILED("CONSTRAINT_ERROR RAISED LATE " &
80                                "- VISIBLE");
81                    WHEN OTHERS =>
82                         FAILED("UNEXPECTED EXCEPTION RAISED " &
83                                "LATE - VISIBLE");
84               END PACK;
85          BEGIN
86               NULL;
87          END;
88     EXCEPTION
89          WHEN CONSTRAINT_ERROR =>
90               NULL;
91          WHEN OTHERS =>
92               FAILED("UNEXPECTED EXCEPTION RAISED " &
93                      "- VISIBLE");
94     END;
95
96------------------------------ PRIVATE ------------------------------
97     BEGIN
98          DECLARE
99               PACKAGE PACK2 IS
100                    SUBTYPE SMALLER IS INTEGER RANGE 1 .. 5;
101
102                    TYPE PRIV IS PRIVATE;
103
104               PRIVATE
105                    TYPE PRIV IS
106                         RECORD
107                              V : INTEGER;
108                         END RECORD;
109
110                    TYPE INCOMPLETE(A : SMALLER);
111
112                    TYPE ACC_INC IS ACCESS INCOMPLETE;
113                    SUBTYPE SUB_ACC IS ACC_INC(IDENT_INT(0));
114
115                    TYPE INCOMPLETE(A : SMALLER) IS
116                         RECORD
117                              T : INTEGER := A;
118                              U : PRIV := (V => A ** IDENT_INT(2));
119                         END RECORD;
120
121               END PACK2;
122
123               PACKAGE BODY PACK2 IS
124               BEGIN
125                    FAILED("CONSTRAINT_ERROR NOT RAISED - PRIVATE");
126                    DECLARE
127                         Z : SUB_ACC := NEW INCOMPLETE(IDENT_INT(0));
128                    BEGIN
129                         IF IDENT_INT(Z.T) = IDENT_INT(0) THEN
130                              COMMENT("THIS LINE SHOULD NOT PRINT");
131                         END IF;
132                    END;
133               EXCEPTION
134                    WHEN CONSTRAINT_ERROR =>
135                         FAILED("CONSTRAINT_ERROR RAISED TOO LATE " &
136                                "- PRIVATE");
137                    WHEN OTHERS =>
138                         FAILED("UNEXPECTED EXCEPTION RAISED LATE" &
139                                "- PRIVATE");
140               END PACK2;
141          BEGIN
142               NULL;
143          END;
144     EXCEPTION
145          WHEN CONSTRAINT_ERROR =>
146               NULL;
147          WHEN OTHERS =>
148                         FAILED("UNEXPECTED EXCEPTION RAISED " &
149                                "- PRIVATE");
150     END;
151
152-------------------------- DECLARATIVE PART --------------------------
153     BEGIN
154          DECLARE
155               SUBTYPE SMALLER IS INTEGER RANGE 1 .. 5;
156
157               TYPE INCOMPLETE(A : SMALLER);
158
159               TYPE ACC_INC IS ACCESS INCOMPLETE;
160               SUBTYPE SUB_ACC IS ACC_INC(IDENT_INT(6));
161
162               TYPE INCOMPLETE(A : SMALLER) IS
163                    RECORD
164                         T : INTEGER := INTEGER'(A);
165                    END RECORD;
166
167          BEGIN
168               FAILED("CONSTRAINT_ERROR NOT RAISED - BLOCK " &
169                      "STATEMENT");
170               DECLARE
171                    Z : SUB_ACC := NEW INCOMPLETE(IDENT_INT(6));
172               BEGIN
173                    IF IDENT_INT(Z.T) = IDENT_INT(6) THEN
174                         COMMENT("THIS LINE SHOULD NOT PRINT");
175                    END IF;
176               END;
177          EXCEPTION
178               WHEN CONSTRAINT_ERROR =>
179                    FAILED("CONSTRAINT_ERROR RAISED TOO LATE " &
180                           "- BLOCK STATEMENT");
181               WHEN OTHERS =>
182                    FAILED("UNEXPECTED EXCEPTION RAISED LATE" &
183                           "- BLOCK STATEMENT");
184          END;
185     EXCEPTION
186          WHEN CONSTRAINT_ERROR =>
187               NULL;
188          WHEN OTHERS =>
189                         FAILED("UNEXPECTED EXCEPTION RAISED " &
190                                "- BLOCK STATEMENT");
191     END;
192
193     RESULT;
194END C38107B;
195