annotate gcc/testsuite/ada/acats/tests/cc/cc3016f.ada @ 111:04ced10e8804

gcc 7
author kono
date Fri, 27 Oct 2017 22:46:09 +0900
parents
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
111
kono
parents:
diff changeset
1 -- CC3016F.ADA
kono
parents:
diff changeset
2
kono
parents:
diff changeset
3 -- Grant of Unlimited Rights
kono
parents:
diff changeset
4 --
kono
parents:
diff changeset
5 -- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
kono
parents:
diff changeset
6 -- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
kono
parents:
diff changeset
7 -- unlimited rights in the software and documentation contained herein.
kono
parents:
diff changeset
8 -- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making
kono
parents:
diff changeset
9 -- this public release, the Government intends to confer upon all
kono
parents:
diff changeset
10 -- recipients unlimited rights equal to those held by the Government.
kono
parents:
diff changeset
11 -- These rights include rights to use, duplicate, release or disclose the
kono
parents:
diff changeset
12 -- released technical data and computer software in whole or in part, in
kono
parents:
diff changeset
13 -- any manner and for any purpose whatsoever, and to have or permit others
kono
parents:
diff changeset
14 -- to do so.
kono
parents:
diff changeset
15 --
kono
parents:
diff changeset
16 -- DISCLAIMER
kono
parents:
diff changeset
17 --
kono
parents:
diff changeset
18 -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
kono
parents:
diff changeset
19 -- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
kono
parents:
diff changeset
20 -- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
kono
parents:
diff changeset
21 -- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
kono
parents:
diff changeset
22 -- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
kono
parents:
diff changeset
23 -- PARTICULAR PURPOSE OF SAID MATERIAL.
kono
parents:
diff changeset
24 --*
kono
parents:
diff changeset
25 -- OFFICE, 3E 114, THE PENTAGON, WASHINGTON DC 20301-3081.
kono
parents:
diff changeset
26
kono
parents:
diff changeset
27 -- OBJECTIVE:
kono
parents:
diff changeset
28 -- CHECK THAT AN INSTANTIATED PACKAGE HAS THE PROPERTIES REQUIRED
kono
parents:
diff changeset
29 -- OF A PACKAGE.
kono
parents:
diff changeset
30
kono
parents:
diff changeset
31 -- CHECK THAT IF THE PARENT TYPE IN A DERIVED TYPE DEFINITION IS
kono
parents:
diff changeset
32 -- A GENERIC FORMAL TYPE, THE OPERATIONS DECLARED FOR THE DERIVED
kono
parents:
diff changeset
33 -- TYPE IN THE TEMPLATE ARE DETERMINED BY THE DECLARATION OF THE
kono
parents:
diff changeset
34 -- FORMAL TYPE. THE OPERATIONS DECLARED FOR DERIVED TYPE IN THE
kono
parents:
diff changeset
35 -- INSTANCE ARE DETERMINED BY THE ACTUAL TYPE DENOTED BY THE FORMAL
kono
parents:
diff changeset
36 -- PARAMETER. SEE AI-00398.
kono
parents:
diff changeset
37
kono
parents:
diff changeset
38 -- HISTORY:
kono
parents:
diff changeset
39 -- DAS 8 OCT 90 INITIAL VERSION.
kono
parents:
diff changeset
40 -- JRL 02/19/93 ADDED USE CLAUSES FOR INSTANCES TO ENSURE DIRECT
kono
parents:
diff changeset
41 -- OPERATOR VISIBILITY. CHANGED NT4'LAST TO P4.NT4'LAST
kono
parents:
diff changeset
42 -- IN ASSIGNMENT STATEMENT FOR P4.X IN EXAMPLE_4.
kono
parents:
diff changeset
43 -- CORRECTED ABE ERRORS IN EXAMPLE_2 AND EXAMPLE_3.
kono
parents:
diff changeset
44 -- CHANGED R3."+" FROM MULTIPLICATION TO SUBTRACTION TO
kono
parents:
diff changeset
45 -- AVOID CONSTRAINT_ERROR.
kono
parents:
diff changeset
46
kono
parents:
diff changeset
47 WITH REPORT;
kono
parents:
diff changeset
48
kono
parents:
diff changeset
49 PROCEDURE CC3016F IS
kono
parents:
diff changeset
50 BEGIN
kono
parents:
diff changeset
51 REPORT.TEST ("CC3016F", "CHECK THAT IF THE PARENT TYPE IN A " &
kono
parents:
diff changeset
52 "DERIVED TYPE DEFINITION IS A GENERIC " &
kono
parents:
diff changeset
53 "FORMAL TYPE, THE OPERATIONS DECLARED " &
kono
parents:
diff changeset
54 "FOR THE DERIVED TYPE IN THE TEMPLATE " &
kono
parents:
diff changeset
55 "ARE DETERMINED BY THE DECLARATION OF " &
kono
parents:
diff changeset
56 "THE FORMAL TYPE, AND THAT THE " &
kono
parents:
diff changeset
57 "OPERATIONS DECLARED FOR THE DERIVED " &
kono
parents:
diff changeset
58 "TYPE IN THE INSTANCE ARE DETERMINED BY " &
kono
parents:
diff changeset
59 "THE ACTUAL TYPE DENOTED BY THE FORMAL " &
kono
parents:
diff changeset
60 "PARAMETER (AI-00398)");
kono
parents:
diff changeset
61 EXAMPLE_2:
kono
parents:
diff changeset
62 DECLARE
kono
parents:
diff changeset
63 GENERIC
kono
parents:
diff changeset
64 TYPE PRIV IS PRIVATE;
kono
parents:
diff changeset
65 PACKAGE GP2 IS
kono
parents:
diff changeset
66 TYPE NT2 IS NEW PRIV;
kono
parents:
diff changeset
67 END GP2;
kono
parents:
diff changeset
68
kono
parents:
diff changeset
69 PACKAGE R2 IS
kono
parents:
diff changeset
70 TYPE T2 IS RANGE 1..10;
kono
parents:
diff changeset
71 FUNCTION F RETURN T2;
kono
parents:
diff changeset
72 END R2;
kono
parents:
diff changeset
73
kono
parents:
diff changeset
74 PACKAGE P2 IS NEW GP2 (PRIV => R2.T2);
kono
parents:
diff changeset
75 USE P2;
kono
parents:
diff changeset
76
kono
parents:
diff changeset
77 XX1 : P2.NT2;
kono
parents:
diff changeset
78 XX2 : P2.NT2;
kono
parents:
diff changeset
79 XX3 : P2.NT2;
kono
parents:
diff changeset
80
kono
parents:
diff changeset
81 PACKAGE BODY R2 IS
kono
parents:
diff changeset
82 FUNCTION F RETURN T2 IS
kono
parents:
diff changeset
83 BEGIN
kono
parents:
diff changeset
84 RETURN T2'LAST;
kono
parents:
diff changeset
85 END F;
kono
parents:
diff changeset
86 END R2;
kono
parents:
diff changeset
87 BEGIN
kono
parents:
diff changeset
88 XX1 := 5; -- IMPLICIT CONVERSION FROM
kono
parents:
diff changeset
89 -- UNIVERSAL INTEGER TO P2.NT2
kono
parents:
diff changeset
90 -- IN P2.
kono
parents:
diff changeset
91 XX2 := XX1 + XX1; -- PREDEFINED "+" DECLARED FOR
kono
parents:
diff changeset
92 -- P2.NT2.
kono
parents:
diff changeset
93 XX3 := P2.F; -- FUNCTION F DERIVED WITH THE
kono
parents:
diff changeset
94 -- INSTANCE.
kono
parents:
diff changeset
95
kono
parents:
diff changeset
96 END EXAMPLE_2;
kono
parents:
diff changeset
97
kono
parents:
diff changeset
98 EXAMPLE_3:
kono
parents:
diff changeset
99 DECLARE
kono
parents:
diff changeset
100 GENERIC
kono
parents:
diff changeset
101 TYPE T3 IS RANGE <>;
kono
parents:
diff changeset
102 PACKAGE GP3 IS
kono
parents:
diff changeset
103 TYPE NT3 IS NEW T3;
kono
parents:
diff changeset
104 X : NT3 := 5;
kono
parents:
diff changeset
105 Y : NT3 := X + 3; -- USES PREDEFINED "+" EVEN IN
kono
parents:
diff changeset
106 -- INSTANCES
kono
parents:
diff changeset
107 END GP3;
kono
parents:
diff changeset
108
kono
parents:
diff changeset
109 PACKAGE R3 IS
kono
parents:
diff changeset
110 TYPE S IS RANGE 1..10;
kono
parents:
diff changeset
111 FUNCTION "+" (LEFT : IN S; RIGHT : IN S) RETURN S;
kono
parents:
diff changeset
112 END R3;
kono
parents:
diff changeset
113
kono
parents:
diff changeset
114 PACKAGE P3 IS NEW GP3 ( T3 => R3.S );
kono
parents:
diff changeset
115 USE P3;
kono
parents:
diff changeset
116
kono
parents:
diff changeset
117 Z : P3.NT3;
kono
parents:
diff changeset
118
kono
parents:
diff changeset
119 PACKAGE BODY R3 IS
kono
parents:
diff changeset
120 FUNCTION "+" (LEFT : IN S; RIGHT : IN S) RETURN S IS
kono
parents:
diff changeset
121 BEGIN -- IMPLEMENT AS SUBTRACTION, NOT ADDITION
kono
parents:
diff changeset
122 RETURN LEFT - RIGHT;
kono
parents:
diff changeset
123 END "+";
kono
parents:
diff changeset
124 END R3;
kono
parents:
diff changeset
125 BEGIN
kono
parents:
diff changeset
126 Z := P3.X + 3; -- USES REDEFINED "+"
kono
parents:
diff changeset
127
kono
parents:
diff changeset
128 IF ( P3.Y /= P3.NT3'(8) ) THEN
kono
parents:
diff changeset
129 REPORT.FAILED ("PREDEFINED ""+"" NOT USED TO COMPUTE " &
kono
parents:
diff changeset
130 "P3.Y");
kono
parents:
diff changeset
131 END IF;
kono
parents:
diff changeset
132
kono
parents:
diff changeset
133 IF (Z /= P3.NT3'(2) ) THEN
kono
parents:
diff changeset
134 REPORT.FAILED ("REDEFINED ""+"" NOT USED TO COMPUTE Z");
kono
parents:
diff changeset
135 END IF;
kono
parents:
diff changeset
136 END EXAMPLE_3;
kono
parents:
diff changeset
137
kono
parents:
diff changeset
138 EXAMPLE_4:
kono
parents:
diff changeset
139 DECLARE
kono
parents:
diff changeset
140 GENERIC
kono
parents:
diff changeset
141 TYPE T4 IS LIMITED PRIVATE;
kono
parents:
diff changeset
142 PACKAGE GP4 IS
kono
parents:
diff changeset
143 TYPE NT4 IS NEW T4;
kono
parents:
diff changeset
144 X : NT4;
kono
parents:
diff changeset
145 END GP4;
kono
parents:
diff changeset
146
kono
parents:
diff changeset
147 PACKAGE P4 IS NEW GP4 (BOOLEAN);
kono
parents:
diff changeset
148 USE P4;
kono
parents:
diff changeset
149
kono
parents:
diff changeset
150 BEGIN
kono
parents:
diff changeset
151 P4.X := P4.NT4'LAST;
kono
parents:
diff changeset
152 IF ( P4.X OR (NOT P4.X) ) THEN
kono
parents:
diff changeset
153 REPORT.COMMENT ("P4.X CORRECTLY HAS A BOOLEAN TYPE");
kono
parents:
diff changeset
154 END IF;
kono
parents:
diff changeset
155 END EXAMPLE_4;
kono
parents:
diff changeset
156
kono
parents:
diff changeset
157 EXAMPLE_5:
kono
parents:
diff changeset
158 DECLARE
kono
parents:
diff changeset
159 GENERIC
kono
parents:
diff changeset
160 TYPE T5 (D : POSITIVE) IS PRIVATE;
kono
parents:
diff changeset
161 PACKAGE GP5 IS
kono
parents:
diff changeset
162 TYPE NT5 IS NEW T5;
kono
parents:
diff changeset
163 X : NT5 (D => 5);
kono
parents:
diff changeset
164 Y : POSITIVE := X.D; -- REFERS TO DISCRIMINANT OF NT5
kono
parents:
diff changeset
165 END GP5;
kono
parents:
diff changeset
166
kono
parents:
diff changeset
167 TYPE REC (A : POSITIVE) IS
kono
parents:
diff changeset
168 RECORD
kono
parents:
diff changeset
169 D : POSITIVE := 7;
kono
parents:
diff changeset
170 END RECORD;
kono
parents:
diff changeset
171 PACKAGE P5 IS NEW GP5 (T5 => REC);
kono
parents:
diff changeset
172 -- P5.Y INITIALIZED WITH VALUE USING COMPONENT SELECTION
kono
parents:
diff changeset
173 -- OPERATION FOR THE DISCRIMINANT, I.E. FOR PARENT TYPE
kono
parents:
diff changeset
174 -- T5 WHICH DENOTES REC.
kono
parents:
diff changeset
175
kono
parents:
diff changeset
176 W1 : POSITIVE := P5.X.D; -- VALUE IS 7
kono
parents:
diff changeset
177 W2 : POSITIVE := P5.X.A; -- VALUE IS 5
kono
parents:
diff changeset
178 W3 : POSITIVE := P5.Y; -- VALUE IS 5;
kono
parents:
diff changeset
179 BEGIN
kono
parents:
diff changeset
180 IF ( ( W1 /= 7 ) OR ( W2 /= 5 ) OR (W3 /= 5 ) ) THEN
kono
parents:
diff changeset
181 REPORT.FAILED ("INCORRECT COMPONENT SELECTION");
kono
parents:
diff changeset
182 END IF;
kono
parents:
diff changeset
183 END EXAMPLE_5;
kono
parents:
diff changeset
184
kono
parents:
diff changeset
185 REPORT.RESULT;
kono
parents:
diff changeset
186
kono
parents:
diff changeset
187 END CC3016F;