1-- CC3007A.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 NAMES IN A GENERIC DECLARATIONS ARE STATICALLY BOUND.
26
27-- DAT 9/18/81
28-- SPS 2/7/83
29
30WITH REPORT; USE REPORT;
31
32PROCEDURE CC3007A IS
33BEGIN
34     TEST ("CC3007A", "NAMES IN GENERICS ARE STATICALLY BOUND");
35
36     DECLARE
37          I : INTEGER := 1;
38          EX : EXCEPTION;
39          IA : INTEGER := I'SIZE;
40
41          FUNCTION F (X : INTEGER) RETURN INTEGER;
42
43          PACKAGE P IS
44               Q : INTEGER := 1;
45          END P;
46
47          GENERIC
48               J : IN OUT INTEGER;
49               WITH FUNCTION FP (X : INTEGER) RETURN INTEGER IS F;
50          PACKAGE GP IS
51               V1 : INTEGER := F(I);
52               V2 : INTEGER := FP(I);
53          END GP;
54
55          GENERIC
56               TYPE T IS RANGE <> ;
57               WITH FUNCTION F1 (X : INTEGER) RETURN INTEGER IS F;
58               INP : IN T := T (I'SIZE);
59          FUNCTION F1 (X : T) RETURN T;
60
61          FUNCTION F1 (X : T) RETURN T IS
62          BEGIN
63               IF INP /= T(IA) THEN
64                    FAILED ("INCORRECT GENERIC BINDING 2");
65               END IF;
66               I := I + 1;
67               RETURN 2 * T (F1 (F (INTEGER (X) + I + P.Q)));
68          END F1;
69
70          PACKAGE BODY GP IS
71               PACKAGE P IS
72                    Q : INTEGER := I + 1;
73               END P;
74               I : INTEGER := 1000;
75               FUNCTION F IS NEW F1 (INTEGER);
76               FUNCTION F2 IS NEW F1 (INTEGER);
77          BEGIN
78               P.Q := F2 (J + P.Q + V1 + 2 * V2);
79               J := P.Q;
80               RAISE EX;
81          END GP;
82
83          FUNCTION F (X : INTEGER) RETURN INTEGER IS
84          BEGIN
85               I := I + 2;
86               RETURN X + I;
87          END;
88     BEGIN
89          DECLARE
90               I : INTEGER := 1000;
91               EX : EXCEPTION;
92               FUNCTION F IS NEW F1 (INTEGER);
93               V : INTEGER := F (3);
94          BEGIN
95               BEGIN
96                    DECLARE
97                         PACKAGE P IS NEW GP (V);
98                    BEGIN
99                         FAILED ("EX NOT RAISED");
100                    END;
101               EXCEPTION
102                    WHEN EX =>
103                         FAILED ("WRONG EXCEPTION RAISED");
104                    WHEN OTHERS =>
105                         IF V /= 266 THEN
106                              FAILED ("WRONG BINDING IN GENERICS");
107                         END IF;
108                         RAISE;
109               END;
110
111          END;
112     EXCEPTION
113          WHEN EX => NULL;
114          WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED 2");
115     END;
116
117     RESULT;
118END CC3007A;
119