1-- C39006B.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 PROGRAM_ERROR IS RAISED IF AN ATTEMPT IS MADE TO CALL A
26-- SUBPROGRAM WHOSE BODY HAS NOT YET BEEN ELABORATED.  CHECK THE
27-- FOLLOWING:
28--     B) THE SUBPROGRAM IS CALLED IN A PACKAGE BODY.
29--     C) THE SUBPROGRAM IS AN ACTUAL GENERIC PARAMETER CALLED DURING
30--        ELABORATION OF THE GENERIC INSTANTIATION.
31--     D) THE SUBPROGRAM IS CALLED DURING ELABORATION OF AN OPTIONAL
32--        PACKAGE BODY.
33
34-- TBN  8/19/86
35
36WITH REPORT; USE REPORT;
37PROCEDURE C39006B IS
38
39BEGIN
40     TEST ("C39006B", "CHECK THAT PROGRAM_ERROR IS RAISED IF AN " &
41                      "ATTEMPT IS MADE TO CALL A SUBPROGRAM WHOSE " &
42                      "BODY HAS NOT YET BEEN ELABORATED");
43     BEGIN
44          DECLARE
45               PACKAGE PACK IS
46                    FUNCTION FUN RETURN INTEGER;
47                    PROCEDURE PROC (A : IN OUT INTEGER);
48               END PACK;
49
50               PACKAGE BODY PACK IS
51
52                    VAR1 : INTEGER := 0;
53
54                    PROCEDURE PROC (A : IN OUT INTEGER) IS
55                    BEGIN
56                         IF A = IDENT_INT(1) THEN
57                              A := A + FUN;
58                              FAILED ("PROGRAM_ERROR NOT RAISED - 1");
59                         ELSE
60                              A := IDENT_INT(1);
61                         END IF;
62                    EXCEPTION
63                         WHEN PROGRAM_ERROR =>
64                              NULL;
65                         WHEN OTHERS =>
66                              FAILED ("UNEXPECTED EXCEPTION RAISED " &
67                                      "1");
68                    END PROC;
69
70                    PACKAGE INSIDE IS
71                    END INSIDE;
72
73                    PACKAGE BODY INSIDE IS
74                    BEGIN
75                         PROC (VAR1);
76                         PROC (VAR1);
77                    END INSIDE;
78
79                    FUNCTION FUN RETURN INTEGER IS
80                    BEGIN
81                         RETURN (IDENT_INT(1));
82                    END FUN;
83
84               BEGIN
85                    NULL;
86               END PACK;
87
88          BEGIN
89               NULL;
90          END;
91     END;
92
93     BEGIN
94          DECLARE
95               FUNCTION INIT_2 RETURN INTEGER;
96
97               GENERIC
98                    WITH FUNCTION FF RETURN INTEGER;
99               PACKAGE P IS
100                    Y : INTEGER;
101               END P;
102
103               GLOBAL_INT : INTEGER := IDENT_INT(1);
104
105               PACKAGE BODY P IS
106               BEGIN
107                    IF GLOBAL_INT = 1 THEN
108                         Y := FF;
109                    END IF;
110               END P;
111
112               PACKAGE N IS
113                    PACKAGE NEW_P IS NEW P(INIT_2);
114               END N;
115
116               FUNCTION INIT_2 RETURN INTEGER IS
117               BEGIN
118                    RETURN (IDENT_INT (1));
119               END INIT_2;
120
121          BEGIN
122               FAILED ("PROGRAM_ERROR NOT RAISED - 2");
123          END;
124
125     EXCEPTION
126          WHEN PROGRAM_ERROR =>
127               NULL;
128          WHEN OTHERS =>
129               FAILED ("UNEXPECTED EXCEPTION RAISED - 2");
130     END;
131
132     DECLARE
133
134          PROCEDURE ADD1 (A : IN OUT INTEGER);
135
136          PACKAGE P IS
137               VAR : INTEGER := IDENT_INT(1);
138          END P;
139
140          PACKAGE BODY P IS
141          BEGIN
142               IF VAR = 1 THEN
143                    ADD1 (VAR);
144                    FAILED ("PROGRAM_ERROR NOT RAISED - 3");
145               END IF;
146          EXCEPTION
147               WHEN PROGRAM_ERROR =>
148                    NULL;
149               WHEN OTHERS =>
150                    FAILED ("UNEXPECTED EXCEPTION RAISED - 3");
151          END P;
152
153          PROCEDURE ADD1 (A : IN OUT INTEGER) IS
154          BEGIN
155               A := A + IDENT_INT(1);
156          END ADD1;
157
158     BEGIN
159          NULL;
160     END;
161
162     RESULT;
163END C39006B;
164