1-- CA1108A.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 A WITH_CLAUSE AND USE_CLAUSE GIVEN FOR A PACKAGE
26-- SPECIFICATION APPLIES TO THE BODY AND SUBUNITS OF THE BODY.
27
28-- BHS 7/27/84
29-- JBG 5/1/85
30
31PACKAGE OTHER_PKG IS
32
33     I : INTEGER := 4;
34     FUNCTION F (X : INTEGER) RETURN INTEGER;
35
36END OTHER_PKG;
37
38PACKAGE BODY OTHER_PKG IS
39
40     FUNCTION F (X : INTEGER) RETURN INTEGER IS
41     BEGIN
42          RETURN X + 1;
43     END F;
44
45END OTHER_PKG;
46
47WITH REPORT, OTHER_PKG;
48USE REPORT, OTHER_PKG;
49PRAGMA ELABORATE (OTHER_PKG);
50PACKAGE CA1108A_PKG IS
51
52     J : INTEGER := 2;
53     PROCEDURE PROC;
54     PROCEDURE CALL_SUBS (X, Y : IN OUT INTEGER);
55
56END CA1108A_PKG;
57
58PACKAGE BODY CA1108A_PKG IS
59
60     PROCEDURE SUB (X, Y : IN OUT INTEGER) IS SEPARATE;
61
62     PROCEDURE PROC IS
63          Y : INTEGER := 2;
64     BEGIN
65          Y := OTHER_PKG.I;
66          IF Y /= 4 THEN
67               FAILED ("OTHER_PKG VARIABLE NOT VISIBLE " &
68                       "IN PACKAGE BODY PROCEDURE");
69          END IF;
70     END PROC;
71
72     PROCEDURE CALL_SUBS (X, Y : IN OUT INTEGER) IS
73     BEGIN
74          SUB (X, Y);
75     END CALL_SUBS;
76
77BEGIN
78
79     J := F(J);            -- J => J + 1.
80     IF J /= 3 THEN
81          FAILED ("OTHER_PKG FUNCTION NOT VISIBLE IN " &
82                  "PACKAGE BODY");
83     END IF;
84
85END CA1108A_PKG;
86
87
88WITH REPORT, CA1108A_PKG;
89USE REPORT, CA1108A_PKG;
90PROCEDURE CA1108A IS
91
92     VAR1, VAR2 : INTEGER;
93
94BEGIN
95
96     TEST ("CA1108A", "WITH_ AND USE_CLAUSES GIVEN FOR A PACKAGE " &
97                      "SPEC APPLY TO THE BODY AND ITS SUBUNITS");
98
99     PROC;
100
101     VAR1 := 1;
102     VAR2 := 1;
103     CALL_SUBS (VAR1, VAR2);
104     IF VAR1 /= 4 THEN
105          FAILED ("OTHER_PKG VARIABLE NOT VISIBLE IN SUBUNIT");
106     END IF;
107
108     IF VAR2 /= 6 THEN
109          FAILED ("OTHER_PKG FUNCTION NOT VISIBLE IN SUBUNIT " &
110                  "OF SUBUNIT");
111     END IF;
112
113     RESULT;
114
115END CA1108A;
116
117
118SEPARATE (CA1108A_PKG)
119PROCEDURE SUB (X, Y : IN OUT INTEGER) IS
120     PROCEDURE SUB2 (Z : IN OUT INTEGER) IS SEPARATE;
121BEGIN
122
123     X := I;
124     SUB2 (Y);
125
126END SUB;
127
128
129SEPARATE (CA1108A_PKG.SUB)
130PROCEDURE SUB2 (Z : IN OUT INTEGER) IS
131     I : INTEGER := 5;
132BEGIN
133
134     Z := OTHER_PKG.F(I);    -- Z => I + 1.
135
136END SUB2;
137