Mercurial > hg > CbC > CbC_gcc

comparison gcc/testsuite/ada/acats/tests/ca/ca5004b2.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 -- CA5004B2M.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 PRAGMA ELABORATE IS ACCEPTED AND OBEYED EVEN IF THE UNIT
26 -- NAMED IN THE PRAGMA DOES NOT YET HAVE A BODY IN THE LIBRARY OR IF
27 -- ITS BODY IS OBSOLETE.
28 -- CHECK THAT MORE THAN ONE NAME IS ALLOWED IN A PRAGMA ELABORATE.
29 --
30 -- SPECIAL INSTRUCTIONS:
31 -- 1. Compile CA5004B0.ADA
32 -- 2. Compile CA5004B1.ADA
33 -- 3. Compile CA5004B2M.ADA
34 -- 4. Bind/Link main unit CA5004B2M
35 -- 5. Execute the resulting file
36 --
37 -- TEST FILES:
38 -- CA5004B0.ADA
39 -- CA5004B1.ADA
40 -- => CA5004B2M.ADA
41
42 -- BHS 8/03/84
43 -- JRK 9/20/84
44 -- PWN 11/30/94 ADDED A PROCEDURE TO KEEP PACKAGE BODIES LEGAL.
45 -- PWN 05/31/96 Split test into files without duplicate unit names.
46 -- TMB 11/20/96 ADDED PROCEDURE DECL TO CA5004B0 TO INSURE IT MAKES
47 -- THE OLD BODY OBSOLETE
48 -- TMB 12/2/96 MADE NAME OF MAIN PROCEDURE SAME AS FILE NAME
49 -- RLB 03/11/99 Split first test file in order to prevent good units
50 -- from being made obsolete.
51
52 -------------------------------------------------------------
53
54 PACKAGE CA5004B0 IS -- OLD BODY NOW OBSOLETE.
55
56 I : INTEGER := 2;
57 B : BOOLEAN := TRUE;
58
59 FUNCTION F RETURN BOOLEAN;
60 PROCEDURE P;
61
62 END CA5004B0;
63
64 ---------------------------------------------------------
65
66 PACKAGE CA5004B1 IS
67
68 J : INTEGER := 3;
69
70 PROCEDURE P (X : INTEGER);
71
72 END CA5004B1; -- NO BODY GIVEN YET.
73
74 ----------------------------------------------------------
75
76 WITH HEADER; USE HEADER;
77 WITH CA5004B0, CA5004B1;
78 USE CA5004B0, CA5004B1;
79 PRAGMA ELABORATE (HEADER, CA5004B0, CA5004B1);
80 PACKAGE CA5004B2 IS
81
82 K1 : INTEGER := CA5004B0.I;
83 K2 : INTEGER := CA5004B1.J;
84
85 PROCEDURE REQUIRE_BODY;
86
87 END CA5004B2;
88
89
90 PACKAGE BODY CA5004B2 IS
91
92 PROCEDURE REQUIRE_BODY IS
93 BEGIN
94 NULL;
95 END;
96
97 BEGIN
98
99 IF K1 /= 4 THEN
100 WRONG ("OBSOLETE BODY");
101 END IF;
102
103 IF K2 /= 5 THEN
104 WRONG ("NO BODY");
105 END IF;
106
107 END CA5004B2;
108
109 --------------------------------------------------
110
111 WITH REPORT, CA5004B2;
112 USE REPORT, CA5004B2;
113 PROCEDURE CA5004B2M IS
114 BEGIN
115
116 RESULT;
117
118 END CA5004B2M;
119
120 ----------------------------------------------------
121
122 PACKAGE BODY CA5004B0 IS
123
124 FUNCTION F RETURN BOOLEAN IS
125 BEGIN
126 RETURN FALSE;
127 END F;
128
129 PROCEDURE P IS
130 BEGIN
131 RETURN;
132 END P;
133
134 BEGIN
135
136 I := 4;
137
138 END CA5004B0;
139
140 ---------------------------------------------------
141
142 PACKAGE BODY CA5004B1 IS
143
144 PROCEDURE P (X : INTEGER) IS
145 BEGIN
146 NULL;
147 END P;
148
149 BEGIN
150
151 J := 5;
152
153 END CA5004B1;