1-- C39006F2.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 NO PROGRAM_ERROR IS RAISED IF A SUBPROGRAM'S BODY HAS
27--     BEEN ELABORATED BEFORE IT IS CALLED.  CHECK THE FOLLOWING:
28--        B) FOR A SUBPROGRAM LIBRARY UNIT USED IN ANOTHER UNIT, NO
29--           PROGRAM_ERROR IS RAISED IF PRAGMA ELABORATE NAMES THE
30--           SUBPROGRAM.
31
32--     THIS LIBRARY PACKAGE BODY IS USED BY C39006F3M.ADA.
33
34-- HISTORY:
35--     TBN  08/22/86  CREATED ORIGINAL TEST.
36--     BCB  03/29/90  CORRECTED HEADER.  CHANGED TEST NAME IN CALL
37--                    TO 'TEST'.
38--     PWN  05/25/94  ADDED A PROCEDURE TO KEEP PACKAGE BODIES LEGAL.
39
40WITH C39006F0;
41WITH REPORT; USE REPORT;
42PRAGMA ELABORATE (C39006F0, REPORT);
43
44PACKAGE BODY C39006F1 IS
45
46     PROCEDURE REQUIRE_BODY IS
47     BEGIN
48          NULL;
49     END;
50
51BEGIN
52     TEST ("C39006F", "CHECK THAT NO PROGRAM_ERROR IS RAISED IF A " &
53                      "SUBPROGRAM'S BODY HAS BEEN ELABORATED " &
54                      "BEFORE IT IS CALLED, WHEN A SUBPROGRAM " &
55                      "LIBRARY UNIT IS USED IN ANOTHER UNIT AND " &
56                      "PRAGMA ELABORATE IS USED");
57     BEGIN
58          DECLARE
59               VAR1 : INTEGER := C39006F0 (IDENT_INT(1));
60          BEGIN
61               IF VAR1 /= IDENT_INT(1) THEN
62                    FAILED ("INCORRECT RESULTS - 1");
63               END IF;
64          END;
65     EXCEPTION
66          WHEN PROGRAM_ERROR =>
67               FAILED ("PROGRAM_ERROR RAISED - 1");
68          WHEN OTHERS =>
69               FAILED ("UNEXPECTED EXCEPTION RAISED - 1");
70     END;
71
72     DECLARE
73          VAR2 : INTEGER := 1;
74
75          PROCEDURE CHECK (B : IN OUT INTEGER) IS
76          BEGIN
77               B := C39006F0 (IDENT_INT(2));
78          EXCEPTION
79               WHEN PROGRAM_ERROR =>
80                    FAILED ("PROGRAM_ERROR RAISED - 2");
81               WHEN OTHERS =>
82                    FAILED ("UNEXPECTED EXCEPTION RAISED - 2");
83          END CHECK;
84     BEGIN
85          CHECK (VAR2);
86          IF VAR2 /= IDENT_INT(2) THEN
87               FAILED ("INCORRECT RESULTS - 2");
88          END IF;
89     END;
90
91     DECLARE
92          PACKAGE P IS
93               VAR3 : INTEGER;
94          END P;
95
96          PACKAGE BODY P IS
97          BEGIN
98               VAR3 := C39006F0 (IDENT_INT(3));
99               IF VAR3 /= IDENT_INT(3) THEN
100                    FAILED ("INCORRECT RESULTS - 3");
101               END IF;
102          EXCEPTION
103               WHEN PROGRAM_ERROR =>
104                    FAILED ("PROGRAM_ERROR RAISED - 3");
105               WHEN OTHERS =>
106                    FAILED ("UNEXPECTED EXCEPTION - 3");
107          END P;
108     BEGIN
109          NULL;
110     END;
111
112     DECLARE
113          GENERIC
114               VAR4 : INTEGER := 1;
115          PACKAGE Q IS
116               TYPE ARRAY_TYP1 IS ARRAY (1 .. VAR4) OF INTEGER;
117               ARRAY_1 : ARRAY_TYP1;
118          END Q;
119
120          PACKAGE NEW_Q IS NEW Q (C39006F0 (IDENT_INT(4)));
121
122          USE NEW_Q;
123
124     BEGIN
125          IF ARRAY_1'LAST /= IDENT_INT(4) THEN
126               FAILED ("INCORRECT RESULTS - 4");
127          END IF;
128     END;
129
130END C39006F1;
131