1-- CC3126A.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 IF AND ONLY IF THE ACTUAL
27--     PARAMETER DOES NOT HAVE THE SAME NUMBER OF COMPONENTS
28--     (PER DIMENSION) AS THE FORMAL PARAMETER. ALSO THAT FOR NULL
29--     ARRAYS NO ERROR IS RAISED.
30
31-- HISTORY:
32--     LB  12/02/86
33--     DWC 08/11/87  CHANGED HEADING FORMAT.
34--     RJW 10/26/89  INITIALIZED VARIABLE H.
35
36WITH REPORT; USE REPORT;
37
38PROCEDURE  CC3126A  IS
39
40BEGIN
41     TEST ("CC3126A","GENERIC ACTUAL PARAMETER MUST HAVE THE SAME "&
42                     "NUMBER OF COMPONENTS (PER DIMENSION) AS THE "&
43                     "GENERIC FORMAL PARMETER");
44     BEGIN
45          DECLARE
46               TYPE ARRY1 IS ARRAY (INTEGER RANGE <>) OF INTEGER;
47               SUBTYPE ARR IS ARRY1 (1 .. 10);
48
49               GENERIC
50                    GARR : IN ARR;
51               PACKAGE P IS
52                    NARR : ARR := GARR;
53               END P;
54
55          BEGIN
56               BEGIN
57                    DECLARE
58                         X : ARRY1 (2 .. 11) := (2 .. 11 => 0);
59                         PACKAGE Q IS NEW P(X);
60                    BEGIN
61                         Q.NARR(2) := 1;
62                    END;
63               EXCEPTION
64                    WHEN OTHERS =>
65                         FAILED ("EXCEPTION RAISED 1");
66               END;
67
68               BEGIN
69                    DECLARE
70                         S : ARRY1 (1 .. 11) := (1 .. 11 => 0);
71                         PACKAGE R IS NEW P(S);
72                    BEGIN
73                         FAILED ("EXCEPTION NOT RAISED 2");
74                         R.NARR(1) := IDENT_INT(R.NARR(1));
75                    END;
76               EXCEPTION
77                    WHEN CONSTRAINT_ERROR =>
78                         NULL;
79                    WHEN OTHERS =>
80                         FAILED ("WRONG EXCEPTION RAISED 2");
81               END;
82
83               BEGIN
84                    DECLARE
85                         G : ARRY1 (1 .. 9) := (1 .. 9 => 0);
86                         PACKAGE K IS NEW P(G);
87                    BEGIN
88                         FAILED ("EXCEPTION NOT RAISED 3");
89                         IF EQUAL(3,3) THEN
90                              K.NARR(1) := IDENT_INT(K.NARR(1));
91                         END IF;
92                    END;
93               EXCEPTION
94                    WHEN CONSTRAINT_ERROR =>
95                         NULL;
96                    WHEN OTHERS =>
97                         FAILED ("WRONG EXCEPTION RAISED 3");
98               END;
99
100               BEGIN
101                    DECLARE
102                         S : ARRY1 (1 .. 11) := (1 .. 11 => 0);
103                         PACKAGE F IS NEW P(S(2 .. 11));
104                    BEGIN
105                         F.NARR(2) := IDENT_INT(F.NARR(2));
106                    END;
107               EXCEPTION
108                    WHEN OTHERS =>
109                         FAILED ("EXCEPTION RAISED 4");
110               END;
111          END;
112
113          DECLARE
114               SUBTYPE STR IS STRING(1 .. 20);
115
116               GENERIC
117                    GVAR : IN STR;
118               PACKAGE M IS
119                    NVAR : STR := GVAR;
120               END M;
121
122          BEGIN
123               BEGIN
124                    DECLARE
125                         L : STRING (2 .. 15);
126                         PACKAGE U IS NEW M(L);
127                    BEGIN
128                         FAILED ("EXCEPTION NOT RAISED 5");
129                         U.NVAR(2) := IDENT_CHAR(U.NVAR(2));
130                    END;
131               EXCEPTION
132                    WHEN CONSTRAINT_ERROR =>
133                         NULL;
134                    WHEN OTHERS =>
135                         FAILED ("WRONG EXCEPTION RAISED 5");
136               END;
137
138               BEGIN
139                    DECLARE
140                         H : STRING (1 .. 20) := (OTHERS => 'R');
141                         PACKAGE J IS NEW M(H);
142                    BEGIN
143                         IF EQUAL(3,3) THEN
144                              J.NVAR(2) := IDENT_CHAR(J.NVAR(2));
145                         END IF;
146                    END;
147               EXCEPTION
148                    WHEN OTHERS =>
149                         FAILED ("EXCEPTION RAISED 6");
150               END;
151          EXCEPTION
152               WHEN OTHERS =>
153                    FAILED ("UNEXPECTED ERROR RAISED STRINGS");
154          END;
155
156          DECLARE
157               TYPE NARRY IS ARRAY (INTEGER RANGE <>) OF INTEGER;
158               SUBTYPE SNARRY IS NARRY (2 .. 0);
159
160               GENERIC
161                    RD : IN SNARRY;
162               PACKAGE JA IS
163                    CD : SNARRY := RD;
164               END JA;
165          BEGIN
166               BEGIN
167                    DECLARE
168                         AD : NARRY(1 .. 0);
169                         PACKAGE PA IS NEW JA(AD);
170                    BEGIN
171                         IF NOT EQUAL(0,PA.CD'LAST) THEN
172                              FAILED ("PARAMETER ATTRIBUTE INCORRECT");
173                         END IF;
174                    END;
175               EXCEPTION
176                    WHEN OTHERS =>
177                         FAILED ("EXCEPTION RAISED 7");
178               END;
179          EXCEPTION
180               WHEN OTHERS =>
181                    FAILED ("UNEXPECTED EXCEPTION RAISED FOR ARRAYS "&
182                            "WITH NULL RANGES");
183          END;
184     END;
185
186     RESULT;
187
188END CC3126A;
189