Mercurial > hg > CbC > CbC_gcc

comparison gcc/testsuite/ada/acats/tests/ca/ca1108b.ada @ 111:04ced10e8804

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
gcc 7
author kono
date Fri, 27 Oct 2017 22:46:09 +0900
parents
children
comparison
equal deleted inserted replaced
68:561a7518be6b 111:04ced10e8804
1 -- CA1108B.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 IF WITH_CLAUSES ARE GIVEN FOR BOTH A SPEC AND A BODY, AND
26 -- THE CLAUSES NAME DIFFERENT LIBRARY UNITS, THE UNITS NAMED IN ALL THE
27 -- CLAUSES ARE VISIBLE IN THE BODY AND IN SUBUNITS OF THE BODY.
28
29 -- BHS 7/31/84
30 -- JBG 5/1/85
31
32 PACKAGE FIRST_PKG IS
33
34 FUNCTION F (X : INTEGER := 1) RETURN INTEGER;
35
36 END FIRST_PKG;
37
38 PACKAGE BODY FIRST_PKG IS
39
40 FUNCTION F (X : INTEGER := 1) RETURN INTEGER IS
41 BEGIN
42 RETURN X;
43 END F;
44
45 END FIRST_PKG;
46
47 PACKAGE LATER_PKG IS
48
49 FUNCTION F (Y : INTEGER := 2) RETURN INTEGER;
50
51 END LATER_PKG;
52
53 PACKAGE BODY LATER_PKG IS
54
55 FUNCTION F (Y : INTEGER := 2) RETURN INTEGER IS
56 BEGIN
57 RETURN Y + 1;
58 END F;
59
60 END LATER_PKG;
61
62 WITH REPORT, FIRST_PKG;
63 USE REPORT;
64 PRAGMA ELABORATE (FIRST_PKG);
65 PACKAGE CA1108B_PKG IS
66
67 I, J : INTEGER;
68 PROCEDURE PROC;
69 PROCEDURE CALL_SUBS (X, Y : IN OUT INTEGER);
70
71 END CA1108B_PKG;
72
73 WITH LATER_PKG;
74 PRAGMA ELABORATE (LATER_PKG);
75 PACKAGE BODY CA1108B_PKG IS
76
77 PROCEDURE SUB (X, Y : IN OUT INTEGER) IS SEPARATE;
78
79 PROCEDURE PROC IS
80 I, J : INTEGER;
81 BEGIN
82 I := FIRST_PKG.F;
83 IF I /= 1 THEN
84 FAILED ("FIRST_PKG FUNCTION NOT VISIBLE IN " &
85 "PACKAGE BODY PROCEDURE");
86 END IF;
87 J := LATER_PKG.F;
88 IF J /= 3 THEN
89 FAILED ("LATER_PKG FUNCITON NOT VISIBLE IN " &
90 "PACKAGE BODY PROCEDURE");
91 END IF;
92 END PROC;
93
94 PROCEDURE CALL_SUBS (X, Y : IN OUT INTEGER) IS
95 BEGIN
96 SUB (X, Y);
97 END CALL_SUBS;
98
99 BEGIN
100
101 I := FIRST_PKG.F;
102 IF I /= 1 THEN
103 FAILED ("FIRST_PKG FUNCTION NOT VISIBLE IN PACKAGE BODY");
104 END IF;
105 J := LATER_PKG.F;
106 IF J /= 3 THEN
107 FAILED ("LATER_PKG FUNCTION NOT VISIBLE IN PACKAGE BODY");
108 END IF;
109
110 END CA1108B_PKG;
111
112 WITH REPORT, CA1108B_PKG;
113 USE REPORT, CA1108B_PKG;
114 PROCEDURE CA1108B IS
115
116 VAR1, VAR2 : INTEGER;
117
118 BEGIN
119
120 TEST ("CA1108B", "IF DIFFERENT WITH_CLAUSES GIVEN FOR PACKAGE " &
121 "SPEC AND BODY, ALL NAMED UNITS ARE VISIBLE " &
122 "IN THE BODY AND ITS SUBUNITS");
123
124 PROC;
125
126 VAR1 := 0;
127 VAR2 := 1;
128 CALL_SUBS (VAR1, VAR2);
129 IF VAR1 /= 1 THEN
130 FAILED ("FIRST_PKG FUNCTION NOT VISIBLE IN SUBUNIT");
131 END IF;
132
133 IF VAR2 /= 3 THEN
134 FAILED ("LATER_PKG FUNCTION NOT VISIBLE IN SUBUNIT");
135 END IF;
136
137 RESULT;
138
139 END CA1108B;
140
141
142 SEPARATE (CA1108B_PKG)
143 PROCEDURE SUB (X, Y : IN OUT INTEGER) IS
144 PROCEDURE SUB2 (A, B : IN OUT INTEGER) IS SEPARATE;
145 BEGIN
146
147 SUB2 (Y, X);
148 IF Y /= 1 THEN
149 FAILED ("FIRST_PKG FUNCTION NOT VISIBLE IN SUBUNIT " &
150 "OF SUBUNIT");
151 END IF;
152 IF X /= 3 THEN
153 FAILED ("LATER_PKG FUNCTION NOT VISIBLE IN SUBUNIT " &
154 "OF SUBUNIT");
155 END IF;
156 X := FIRST_PKG.F;
157 Y := LATER_PKG.F;
158
159 END SUB;
160
161 SEPARATE (CA1108B_PKG.SUB)
162 PROCEDURE SUB2 (A, B : IN OUT INTEGER) IS
163 BEGIN
164
165 A := FIRST_PKG.F;
166 B := LATER_PKG.F;
167
168 END SUB2;