1-- CC3017B.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 AN INSTANCE OF A GENERIC PROCEDURE MUST DECLARE A
26-- PROCEDURE AND THAT AN INSTANCE OF A GENERIC FUNCTION MUST
27-- DECLARE A FUNCTION. CHECK THAT CONSTRAINT_ERROR IS NOT RAISED
28-- IF THE DEFAULT VALUE FOR A FORMAL PARAMETER DOES NOT SATISFY
29-- THE CONSTRAINTS OF THE SUBTYPE_INDICATION WHEN THE
30-- DECLARATION IS ELABORATED, ONLY WHEN THE DEFAULT IS USED.
31
32--   SUBTESTS ARE:
33--        (A) ARRAY PARAMETERS CONSTRAINED WITH NONSTATIC BOUNDS AND
34--            INITIALIZED WITH A STATIC AGGREGATE.
35--        (B) A SCALAR PARAMETER WITH NON-STATIC RANGE CONSTRAINTS
36--            INITIALIZED WITH A STATIC VALUE.
37--        (C) A RECORD PARAMETER WHOSE COMPONENTS HAVE NON-STATIC
38--            CONSTRAINTS INITIALIZED WITH A STATIC AGGREGATE.
39--        (D) AN ARRAY PARAMETER CONSTRAINED WITH STATIC BOUNDS ON SUB-
40--            SCRIPTS AND NON-STATIC BOUNDS ON COMPONENTS, INITIALIZED
41--            WITH A STATIC AGGREGATE.
42--        (E) A RECORD PARAMETER WITH A NON-STATIC CONSTRAINT
43--            INITIALIZED WITH A STATIC AGGREGATE.
44
45-- EDWARD V. BERARD, 7 AUGUST 1990
46
47WITH REPORT;
48
49PROCEDURE CC3017B IS
50
51BEGIN
52
53     REPORT.TEST ("CC3017B", "CHECK THAT AN INSTANCE OF A GENERIC " &
54                  "PROCEDURE MUST DECLARE A PROCEDURE AND THAT AN " &
55                  "INSTANCE OF A GENERIC FUNCTION MUST DECLARE A " &
56                  "FUNCTION. CHECK THAT CONSTRAINT_ERROR IS NOT " &
57                  "RAISED IF AN INITIALIZATION VALUE DOES NOT SATISFY " &
58                  "CONSTRAINTS ON A FORMAL PARAMETER");
59
60     --------------------------------------------------
61
62     NONSTAT_ARRAY_PARMS:
63
64     DECLARE
65
66--        (A) ARRAY PARAMETERS CONSTRAINED WITH NONSTATIC BOUNDS AND
67--            INITIALIZED WITH A STATIC AGGREGATE.
68
69          TYPE NUMBER IS RANGE 1 .. 100 ;
70
71          GENERIC
72
73            TYPE INTEGER_TYPE IS RANGE <> ;
74            LOWER : IN INTEGER_TYPE ;
75            UPPER : IN INTEGER_TYPE ;
76
77          PROCEDURE PA (FIRST  : IN INTEGER_TYPE ;
78                        SECOND : IN INTEGER_TYPE) ;
79
80          PROCEDURE PA (FIRST  : IN INTEGER_TYPE ;
81                        SECOND : IN INTEGER_TYPE) IS
82
83               TYPE A1 IS ARRAY (INTEGER_TYPE RANGE LOWER .. FIRST,
84                                 INTEGER_TYPE RANGE LOWER .. SECOND)
85                                         OF INTEGER_TYPE;
86
87               PROCEDURE PA1 (A : A1 := ((LOWER,UPPER),(UPPER,UPPER)))
88                    IS
89               BEGIN
90                    REPORT.FAILED ("BODY OF PA1 EXECUTED");
91               EXCEPTION
92                    WHEN OTHERS =>
93                         REPORT.FAILED ("EXCEPTION RAISED IN PA1");
94               END PA1;
95
96          BEGIN  -- PA
97               PA1;
98          EXCEPTION
99               WHEN CONSTRAINT_ERROR =>
100                    NULL;
101               WHEN OTHERS =>
102                    REPORT.FAILED ("WRONG EXCEPTION RAISED - PA1");
103          END PA;
104
105          PROCEDURE NEW_PA IS NEW PA (INTEGER_TYPE => NUMBER,
106                                      LOWER        => 1,
107                                      UPPER        => 50) ;
108
109     BEGIN   -- NONSTAT_ARRAY_PARMS
110
111          NEW_PA (FIRST  => NUMBER (25),
112                  SECOND => NUMBER (75));
113
114     EXCEPTION
115          WHEN OTHERS =>
116               REPORT.FAILED ("EXCEPTION RAISED IN CALL TO NEW_PA");
117
118     END NONSTAT_ARRAY_PARMS ;
119
120     --------------------------------------------------
121
122     SCALAR_NON_STATIC:
123
124     DECLARE
125
126--        (B) A SCALAR PARAMETER WITH NON-STATIC RANGE CONSTRAINTS
127--            INITIALIZED WITH A STATIC VALUE.
128
129          TYPE NUMBER IS RANGE 1 .. 100 ;
130
131          GENERIC
132
133            TYPE INTEGER_TYPE IS RANGE <> ;
134            STATIC_VALUE : IN INTEGER_TYPE ;
135
136          PROCEDURE PB (LOWER  : IN INTEGER_TYPE ;
137                        UPPER  : IN INTEGER_TYPE) ;
138
139          PROCEDURE PB (LOWER  : IN INTEGER_TYPE ;
140                        UPPER  : IN INTEGER_TYPE) IS
141
142               SUBTYPE INT IS INTEGER_TYPE RANGE LOWER .. UPPER ;
143
144               PROCEDURE PB1 (I : INT := STATIC_VALUE) IS
145               BEGIN  -- PB1
146                    REPORT.FAILED ("BODY OF PB1 EXECUTED");
147               EXCEPTION
148                    WHEN OTHERS =>
149                         REPORT.FAILED ("EXCEPTION RAISED IN PB1");
150               END PB1;
151
152          BEGIN  -- PB
153               PB1;
154          EXCEPTION
155               WHEN CONSTRAINT_ERROR =>
156                    NULL;
157               WHEN OTHERS =>
158                    REPORT.FAILED ("WRONG EXCEPTION RAISED - PB1");
159          END PB;
160
161          PROCEDURE NEW_PB IS NEW PB (INTEGER_TYPE => NUMBER,
162                                      STATIC_VALUE => 20) ;
163
164     BEGIN   -- SCALAR_NON_STATIC
165
166          NEW_PB (LOWER  => NUMBER (25),
167                  UPPER  => NUMBER (75));
168
169     EXCEPTION
170          WHEN OTHERS =>
171               REPORT.FAILED ("EXCEPTION RAISED IN CALL TO NEW_PB");
172     END SCALAR_NON_STATIC ;
173
174     --------------------------------------------------
175
176     REC_NON_STAT_COMPS:
177
178     DECLARE
179
180--        (C) A RECORD PARAMETER WHOSE COMPONENTS HAVE NON-STATIC
181--            CONSTRAINTS INITIALIZED WITH A STATIC AGGREGATE.
182
183          TYPE NUMBER IS RANGE 1 .. 100 ;
184
185          GENERIC
186
187            TYPE INTEGER_TYPE IS RANGE <> ;
188            F_STATIC_VALUE : IN INTEGER_TYPE ;
189            S_STATIC_VALUE : IN INTEGER_TYPE ;
190            T_STATIC_VALUE : IN INTEGER_TYPE ;
191            L_STATIC_VALUE : IN INTEGER_TYPE ;
192
193          PROCEDURE PC (LOWER  : IN INTEGER_TYPE ;
194                        UPPER  : IN INTEGER_TYPE) ;
195
196          PROCEDURE PC (LOWER  : IN INTEGER_TYPE ;
197                        UPPER  : IN INTEGER_TYPE) IS
198
199               SUBTYPE SUBINTEGER_TYPE IS INTEGER_TYPE
200                       RANGE LOWER .. UPPER ;
201               TYPE AR1 IS ARRAY (INTEGER RANGE 1..3) OF
202                     SUBINTEGER_TYPE ;
203               TYPE REC IS
204                    RECORD
205                         FIRST  : SUBINTEGER_TYPE ;
206                         SECOND : AR1 ;
207                    END RECORD;
208
209               PROCEDURE PC1 (R : REC := (F_STATIC_VALUE,
210                                         (S_STATIC_VALUE,
211                                          T_STATIC_VALUE,
212                                          L_STATIC_VALUE))) IS
213               BEGIN  -- PC1
214                    REPORT.FAILED ("BODY OF PC1 EXECUTED");
215               EXCEPTION
216                    WHEN OTHERS =>
217                         REPORT.FAILED ("EXCEPTION RAISED IN PC1");
218               END PC1;
219
220          BEGIN  -- PC
221               PC1;
222          EXCEPTION
223               WHEN CONSTRAINT_ERROR =>
224                    NULL;
225               WHEN OTHERS =>
226                    REPORT.FAILED ("WRONG EXCEPTION RAISED - PC1");
227          END PC;
228
229          PROCEDURE NEW_PC IS NEW PC (INTEGER_TYPE => NUMBER,
230                                      F_STATIC_VALUE => 15,
231                                      S_STATIC_VALUE => 19,
232                                      T_STATIC_VALUE => 85,
233                                      L_STATIC_VALUE => 99) ;
234
235     BEGIN   -- REC_NON_STAT_COMPS
236          NEW_PC (LOWER => 20,
237                  UPPER => 80);
238     EXCEPTION
239          WHEN OTHERS =>
240               REPORT.FAILED ("EXCEPTION RAISED IN CALL TO NEW_PC");
241     END REC_NON_STAT_COMPS ;
242
243     --------------------------------------------------
244
245     FIRST_STATIC_ARRAY:
246
247     DECLARE
248
249--        (D) AN ARRAY PARAMETER CONSTRAINED WITH STATIC BOUNDS ON SUB-
250--            SCRIPTS AND NON-STATIC BOUNDS ON COMPONENTS, INITIALIZED
251--            WITH A STATIC AGGREGATE.
252
253          TYPE NUMBER IS RANGE 1 .. 100 ;
254
255          GENERIC
256
257            TYPE INTEGER_TYPE IS RANGE <> ;
258            F_STATIC_VALUE : IN INTEGER_TYPE ;
259            S_STATIC_VALUE : IN INTEGER_TYPE ;
260            T_STATIC_VALUE : IN INTEGER_TYPE ;
261            L_STATIC_VALUE : IN INTEGER_TYPE ;
262            A_STATIC_VALUE : IN INTEGER_TYPE ;
263            B_STATIC_VALUE : IN INTEGER_TYPE ;
264            C_STATIC_VALUE : IN INTEGER_TYPE ;
265            D_STATIC_VALUE : IN INTEGER_TYPE ;
266
267          PROCEDURE P1D (LOWER  : IN INTEGER_TYPE ;
268                         UPPER  : IN INTEGER_TYPE) ;
269
270          PROCEDURE P1D (LOWER  : IN INTEGER_TYPE ;
271                         UPPER  : IN INTEGER_TYPE) IS
272
273               SUBTYPE SUBINTEGER_TYPE IS INTEGER_TYPE
274                       RANGE LOWER .. UPPER ;
275
276               TYPE A1 IS ARRAY (INTEGER_TYPE RANGE
277                                       F_STATIC_VALUE .. S_STATIC_VALUE,
278                                 INTEGER_TYPE RANGE
279                                       T_STATIC_VALUE .. L_STATIC_VALUE)
280                       OF SUBINTEGER_TYPE ;
281
282               PROCEDURE P1D1 (A : A1 :=
283                           ((A_STATIC_VALUE, B_STATIC_VALUE),
284                           (C_STATIC_VALUE, D_STATIC_VALUE))) IS
285               BEGIN  -- P1D1
286                    REPORT.FAILED ("BODY OF P1D1 EXECUTED");
287               EXCEPTION
288                    WHEN OTHERS =>
289                         REPORT.FAILED ("EXCEPTION RAISED IN P1D1");
290               END P1D1;
291
292          BEGIN  -- P1D
293               P1D1 ;
294          EXCEPTION
295               WHEN CONSTRAINT_ERROR =>
296                    NULL;
297               WHEN OTHERS =>
298                    REPORT.FAILED ("WRONG EXCEPTION RAISED - P1D1");
299          END P1D;
300
301          PROCEDURE NEW_P1D IS NEW P1D (INTEGER_TYPE => NUMBER,
302                                        F_STATIC_VALUE => 21,
303                                        S_STATIC_VALUE => 37,
304                                        T_STATIC_VALUE => 67,
305                                        L_STATIC_VALUE => 79,
306                                        A_STATIC_VALUE => 11,
307                                        B_STATIC_VALUE => 88,
308                                        C_STATIC_VALUE => 87,
309                                        D_STATIC_VALUE => 13) ;
310
311     BEGIN  -- FIRST_STATIC_ARRAY
312          NEW_P1D (LOWER => 10,
313                     UPPER => 90);
314     EXCEPTION
315          WHEN OTHERS =>
316               REPORT.FAILED ("EXCEPTION RAISED IN CALL TO NEW_P1D");
317     END FIRST_STATIC_ARRAY ;
318
319     --------------------------------------------------
320
321     SECOND_STATIC_ARRAY:
322
323     DECLARE
324
325--        (D) AN ARRAY PARAMETER CONSTRAINED WITH STATIC BOUNDS ON SUB-
326--            SCRIPTS AND NON-STATIC BOUNDS ON COMPONENTS, INITIALIZED
327--            WITH A STATIC AGGREGATE.
328
329          TYPE NUMBER IS RANGE 1 .. 100 ;
330
331          GENERIC
332
333            TYPE INTEGER_TYPE IS RANGE <> ;
334            F_STATIC_VALUE : IN INTEGER_TYPE ;
335            S_STATIC_VALUE : IN INTEGER_TYPE ;
336            T_STATIC_VALUE : IN INTEGER_TYPE ;
337            L_STATIC_VALUE : IN INTEGER_TYPE ;
338            A_STATIC_VALUE : IN INTEGER_TYPE ;
339            B_STATIC_VALUE : IN INTEGER_TYPE ;
340
341          PROCEDURE P2D (LOWER  : IN INTEGER_TYPE ;
342                         UPPER  : IN INTEGER_TYPE) ;
343
344          PROCEDURE P2D (LOWER  : IN INTEGER_TYPE ;
345                         UPPER  : IN INTEGER_TYPE) IS
346
347               SUBTYPE SUBINTEGER_TYPE IS INTEGER_TYPE
348                       RANGE LOWER .. UPPER ;
349
350               TYPE A1 IS ARRAY (INTEGER_TYPE RANGE
351                                       F_STATIC_VALUE .. S_STATIC_VALUE,
352                                 INTEGER_TYPE RANGE
353                                       T_STATIC_VALUE .. L_STATIC_VALUE)
354                       OF SUBINTEGER_TYPE ;
355
356               PROCEDURE P2D1 (A : A1 :=
357                                   (F_STATIC_VALUE .. S_STATIC_VALUE =>
358                                   (A_STATIC_VALUE, B_STATIC_VALUE))) IS
359               BEGIN  -- P2D1
360                    REPORT.FAILED ("BODY OF P2D1 EXECUTED");
361               EXCEPTION
362                    WHEN OTHERS =>
363                         REPORT.FAILED ("EXCEPTION RAISED IN P2D1");
364               END P2D1;
365
366          BEGIN  -- P2D
367               P2D1;
368          EXCEPTION
369               WHEN CONSTRAINT_ERROR =>
370                    NULL;
371               WHEN OTHERS =>
372                    REPORT.FAILED ("WRONG EXCEPTION RAISED - P2D1");
373          END P2D;
374
375          PROCEDURE NEW_P2D IS NEW P2D (INTEGER_TYPE => NUMBER,
376                                        F_STATIC_VALUE => 21,
377                                        S_STATIC_VALUE => 37,
378                                        T_STATIC_VALUE => 67,
379                                        L_STATIC_VALUE => 79,
380                                        A_STATIC_VALUE => 7,
381                                        B_STATIC_VALUE => 93) ;
382
383     BEGIN  -- SECOND_STATIC_ARRAY
384          NEW_P2D (LOWER => 5,
385                   UPPER => 95);
386     EXCEPTION
387          WHEN OTHERS =>
388               REPORT.FAILED ("EXCEPTION RAISED IN CALL TO NEW_P2D");
389     END SECOND_STATIC_ARRAY ;
390
391     --------------------------------------------------
392
393     REC_NON_STATIC_CONS:
394
395     DECLARE
396
397--        (E) A RECORD PARAMETER WITH A NON-STATIC CONSTRAINT
398--            INITIALIZED WITH A STATIC AGGREGATE.
399
400          TYPE NUMBER IS RANGE 1 .. 100 ;
401
402          GENERIC
403
404            TYPE INTEGER_TYPE IS RANGE <> ;
405            F_STATIC_VALUE : IN INTEGER_TYPE ;
406            S_STATIC_VALUE : IN INTEGER_TYPE ;
407            T_STATIC_VALUE : IN INTEGER_TYPE ;
408            L_STATIC_VALUE : IN INTEGER_TYPE ;
409            D_STATIC_VALUE : IN INTEGER_TYPE ;
410
411          PROCEDURE PE (LOWER  : IN INTEGER_TYPE ;
412                        UPPER  : IN INTEGER_TYPE) ;
413
414          PROCEDURE PE (LOWER  : IN INTEGER_TYPE ;
415                        UPPER  : IN INTEGER_TYPE) IS
416
417               SUBTYPE SUBINTEGER_TYPE IS INTEGER_TYPE
418                       RANGE LOWER .. UPPER ;
419               TYPE AR1 IS ARRAY (INTEGER RANGE 1..3) OF
420                     SUBINTEGER_TYPE ;
421
422               TYPE REC (DISCRIM : SUBINTEGER_TYPE) IS
423                    RECORD
424                         FIRST  : SUBINTEGER_TYPE ;
425                         SECOND : AR1 ;
426                    END RECORD ;
427
428               SUBTYPE REC4 IS REC (LOWER) ;
429
430               PROCEDURE PE1 (R : REC4 := (D_STATIC_VALUE,
431                                           F_STATIC_VALUE,
432                                          (S_STATIC_VALUE,
433                                           T_STATIC_VALUE,
434                                           L_STATIC_VALUE))) IS
435               BEGIN  -- PE1
436                    REPORT.FAILED ("BODY OF PE1 EXECUTED");
437               EXCEPTION
438                    WHEN OTHERS =>
439                         REPORT.FAILED ("EXCEPTION RAISED IN PE1");
440               END PE1;
441
442          BEGIN  -- PE
443               PE1;
444          EXCEPTION
445               WHEN CONSTRAINT_ERROR =>
446                    NULL;
447               WHEN OTHERS =>
448                    REPORT.FAILED ("WRONG EXCEPTION RAISED - PE1");
449          END PE;
450
451          PROCEDURE NEW_PE IS NEW PE (INTEGER_TYPE => NUMBER,
452                                      F_STATIC_VALUE => 37,
453                                      S_STATIC_VALUE => 21,
454                                      T_STATIC_VALUE => 67,
455                                      L_STATIC_VALUE => 79,
456                                      D_STATIC_VALUE => 44) ;
457
458     BEGIN  -- REC_NON_STATIC_CONS
459          NEW_PE  (LOWER => 2,
460                   UPPER => 99);
461     EXCEPTION
462          WHEN OTHERS =>
463               REPORT.FAILED ("EXCEPTION RAISED IN CALL TO NEW_PE");
464     END REC_NON_STATIC_CONS ;
465
466     --------------------------------------------------
467
468     REPORT.RESULT;
469
470END CC3017B;
471