1-- C61008A.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 CONSTRAINT_ERROR IS NOT RAISED IF THE DEFAULT VALUE
26-- FOR A FORMAL PARAMETER DOES NOT SATISFY THE CONSTRAINTS OF THE
27-- SUBTYPE_INDICATION WHEN THE DECLARATION IS ELABORATED, ONLY WHEN
28-- THE DEFAULT IS USED.
29
30--   SUBTESTS ARE:
31--        (A) ARRAY PARAMETERS CONSTRAINED WITH NONSTATIC BOUNDS AND
32--            INITIALIZED WITH A STATIC AGGREGATE.
33--        (B) A SCALAR PARAMETER WITH NON-STATIC RANGE CONSTRAINTS
34--            INITIALIZED WITH A STATIC VALUE.
35--        (C) A RECORD PARAMETER WHOSE COMPONENTS HAVE NON-STATIC
36--            CONSTRAINTS INITIALIZED WITH A STATIC AGGREGATE.
37--        (D) AN ARRAY PARAMETER CONSTRAINED WITH STATIC BOUNDS ON SUB-
38--            SCRIPTS AND NON-STATIC BOUNDS ON COMPONENTS, INITIALIZED
39--            WITH A STATIC AGGREGATE.
40--        (E) A RECORD PARAMETER WITH A NON-STATIC CONSTRAINT
41--            INITIALIZED WITH A STATIC AGGREGATE.
42
43-- DAS  1/20/81
44-- SPS 10/26/82
45-- VKG 1/13/83
46-- SPS 2/9/83
47-- BHS 7/9/84
48
49WITH REPORT;
50PROCEDURE C61008A IS
51
52     USE REPORT;
53
54BEGIN
55
56     TEST ("C61008A", "CHECK THAT CONSTRAINT_ERROR IS NOT RAISED IF " &
57                      "AN INITIALIZATION VALUE DOES NOT SATISFY " &
58                      "CONSTRAINTS ON A FORMAL PARAMETER");
59
60     --------------------------------------------------
61
62     DECLARE -- (A)
63
64          PROCEDURE PA (I1, I2 : INTEGER) IS
65
66               TYPE A1 IS ARRAY (1..I1,1..I2) OF INTEGER;
67
68               PROCEDURE PA1 (A : A1 := ((1,0),(0,1))) IS
69               BEGIN
70                    FAILED ("BODY OF PA1 EXECUTED");
71               EXCEPTION
72                    WHEN OTHERS =>
73                         FAILED ("EXCEPTION RAISED IN PA1");
74               END PA1;
75
76          BEGIN
77               PA1;
78          EXCEPTION
79               WHEN CONSTRAINT_ERROR =>
80                    NULL;
81               WHEN OTHERS =>
82                    FAILED ("WRONG EXCEPTION RAISED - PA1");
83          END PA;
84
85     BEGIN   -- (A)
86          PA (IDENT_INT(1), IDENT_INT(10));
87     EXCEPTION
88          WHEN OTHERS =>
89               FAILED ("EXCEPTION RAISED IN CALL TO PA");
90     END;    -- (A)
91
92     --------------------------------------------------
93
94     DECLARE -- (B)
95
96          PROCEDURE PB (I1, I2 : INTEGER) IS
97
98               SUBTYPE INT IS INTEGER RANGE I1..I2;
99
100               PROCEDURE PB1 (I : INT := -1) IS
101               BEGIN
102                    FAILED ("BODY OF PB1 EXECUTED");
103               EXCEPTION
104                    WHEN OTHERS =>
105                         FAILED ("EXCEPTION RAISED IN PB1");
106               END PB1;
107
108          BEGIN
109               PB1;
110          EXCEPTION
111               WHEN CONSTRAINT_ERROR =>
112                    NULL;
113               WHEN OTHERS =>
114                    FAILED ("WRONG EXCEPTION RAISED - PB1");
115          END PB;
116
117     BEGIN   -- (B)
118          PB (IDENT_INT(0), IDENT_INT(63));
119     EXCEPTION
120          WHEN OTHERS =>
121               FAILED ("EXCEPTION RAISED IN CALL TO PB");
122     END;    -- (B)
123
124     --------------------------------------------------
125
126     DECLARE -- (C)
127
128          PROCEDURE PC (I1, I2 : INTEGER) IS
129               TYPE AR1 IS ARRAY (1..3) OF INTEGER RANGE I1..I2;
130               TYPE REC IS
131                    RECORD
132                         I : INTEGER RANGE I1..I2;
133                         A : AR1 ;
134                    END RECORD;
135
136               PROCEDURE PC1 (R : REC := (-3,(0,2,3))) IS
137               BEGIN
138                    FAILED ("BODY OF PC1 EXECUTED");
139               EXCEPTION
140                    WHEN OTHERS =>
141                         FAILED ("EXCEPTION RAISED IN PC1");
142               END PC1;
143
144          BEGIN
145               PC1;
146          EXCEPTION
147               WHEN CONSTRAINT_ERROR =>
148                    NULL;
149               WHEN OTHERS =>
150                    FAILED ("WRONG EXCEPTION RAISED - PC1");
151          END PC;
152
153     BEGIN   -- (C)
154          PC (IDENT_INT(1), IDENT_INT(3));
155     EXCEPTION
156          WHEN OTHERS =>
157               FAILED ("EXCEPTION RAISED IN CALL TO PC");
158     END;    -- (C)
159
160     --------------------------------------------------
161
162     DECLARE -- (D1)
163
164          PROCEDURE P1D (I1, I2 : INTEGER) IS
165
166               TYPE A1 IS ARRAY (1..2,1..2) OF INTEGER RANGE I1..I2;
167
168               PROCEDURE P1D1 (A : A1 := ((1,-1),(1,2))) IS
169               BEGIN
170                    FAILED ("BODY OF P1D1 EXECUTED");
171               EXCEPTION
172                    WHEN OTHERS =>
173                         FAILED ("EXCEPTION RAISED IN P1D1");
174               END P1D1;
175
176          BEGIN
177               P1D1;
178          EXCEPTION
179               WHEN CONSTRAINT_ERROR =>
180                    NULL;
181               WHEN OTHERS =>
182                    FAILED ("WRONG EXCEPTION RAISED - P1D1");
183          END P1D;
184
185     BEGIN   -- (D1)
186          P1D (IDENT_INT(1), IDENT_INT(2));
187     EXCEPTION
188          WHEN OTHERS =>
189               FAILED ("EXCEPTION RAISED IN CALL TO P1D");
190     END;    -- (D1)
191
192     --------------------------------------------------
193
194     DECLARE -- (D2)
195
196          PROCEDURE P2D (I1, I2 : INTEGER) IS
197
198               TYPE A1 IS ARRAY (1..2,1..2) OF INTEGER RANGE I1..I2;
199
200               PROCEDURE P2D1 (A : A1 := (3..4 => (1,2))) IS
201               BEGIN
202                    FAILED ("BODY OF P2D1 EXECUTED");
203               EXCEPTION
204                    WHEN OTHERS =>
205                         FAILED ("EXCEPTION RAISED IN P2D1");
206               END P2D1;
207
208          BEGIN
209               P2D1;
210          EXCEPTION
211               WHEN CONSTRAINT_ERROR =>
212                    NULL;
213               WHEN OTHERS =>
214                    FAILED ("WRONG EXCEPTION RAISED - P2D1");
215          END P2D;
216
217     BEGIN  -- (D2)
218          P2D (IDENT_INT(1), IDENT_INT(2));
219     EXCEPTION
220          WHEN OTHERS =>
221               FAILED ("EXCEPTION RAISED IN CALL TO P2D");
222     END;   -- (D2)
223
224     --------------------------------------------------
225
226     DECLARE -- (E)
227
228          PROCEDURE PE (I1, I2 : INTEGER) IS
229               SUBTYPE INT IS INTEGER RANGE 0..10;
230               TYPE ARR IS ARRAY (1..3) OF INT;
231               TYPE REC (I : INT) IS
232                    RECORD
233                         A : ARR;
234                    END RECORD;
235
236               SUBTYPE REC4 IS REC(I1);
237
238               PROCEDURE PE1 (R : REC4 := (3,(1,2,3))) IS
239               BEGIN
240                    FAILED ("BODY OF PE1 EXECUTED");
241               EXCEPTION
242                    WHEN OTHERS =>
243                         FAILED ("EXCEPTION RAISED IN PE1");
244               END PE1;
245
246          BEGIN
247               PE1;
248          EXCEPTION
249               WHEN CONSTRAINT_ERROR =>
250                    NULL;
251               WHEN OTHERS =>
252                    FAILED ("WRONG EXCEPTION RAISED - PE1");
253          END PE;
254
255     BEGIN   -- (E)
256          PE (IDENT_INT(4), IDENT_INT(10));
257     EXCEPTION
258          WHEN OTHERS =>
259               FAILED ("EXCEPTION RAISED IN CALL TO PE");
260     END;    -- (E)
261
262     --------------------------------------------------
263
264     RESULT;
265
266END C61008A;
267