annotate gcc/testsuite/ada/acats/tests/cc/cc1222a.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 -- CC1222A.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 -- FOR A FORMAL FLOATING POINT TYPE, CHECK THAT THE FOLLOWING BASIC
kono
parents:
diff changeset
26 -- OPERATIONS ARE IMPLICITLY DECLARED AND ARE THEREFORE AVAILABLE
kono
parents:
diff changeset
27 -- WITHIN THE GENERIC UNIT: ASSIGNMENT, MEMBERSHIP TESTS,
kono
parents:
diff changeset
28 -- QUALIFICATION, EXPLICIT CONVERSION TO AND FROM OTHER NUMERIC TYPES,
kono
parents:
diff changeset
29 -- AND REAL LITERALS (IMPLICIT CONVERSION FROM UNIVERSAL REAL TO THE
kono
parents:
diff changeset
30 -- FORMAL TYPE), 'FIRST, 'LAST, 'SIZE, 'ADDRESS, 'DIGITS, 'MACHINE_RADIX,
kono
parents:
diff changeset
31 -- 'MACHINE_MANTISSA, 'MACHINE_EMAX, 'MACHINE_EMIN, 'MACHINE_ROUNDS,
kono
parents:
diff changeset
32 -- 'MACHINE_OVERFLOWS.
kono
parents:
diff changeset
33
kono
parents:
diff changeset
34 -- R.WILLIAMS 9/30/86
kono
parents:
diff changeset
35 -- PWN 01/31/95 REMOVED INCONSISTENCIES WITH ADA 9X.
kono
parents:
diff changeset
36
kono
parents:
diff changeset
37 WITH REPORT; USE REPORT;
kono
parents:
diff changeset
38 WITH SYSTEM; USE SYSTEM;
kono
parents:
diff changeset
39 PROCEDURE CC1222A IS
kono
parents:
diff changeset
40
kono
parents:
diff changeset
41 TYPE NEWFLT IS NEW FLOAT;
kono
parents:
diff changeset
42
kono
parents:
diff changeset
43 BEGIN
kono
parents:
diff changeset
44 TEST ( "CC1222A", "FOR A FORMAL FLOATING POINT TYPE, CHECK " &
kono
parents:
diff changeset
45 "THAT THE BASIC OPERATIONS ARE " &
kono
parents:
diff changeset
46 "IMPLICITLY DECLARED AND ARE THEREFORE " &
kono
parents:
diff changeset
47 "AVAILABLE WITHIN THE GENERIC UNIT" );
kono
parents:
diff changeset
48
kono
parents:
diff changeset
49 DECLARE -- (A). CHECKS FOR ASSIGNMENT, MEMBERSHIP TESTS AND
kono
parents:
diff changeset
50 -- QUALIFICATION.
kono
parents:
diff changeset
51
kono
parents:
diff changeset
52 GENERIC
kono
parents:
diff changeset
53 TYPE T IS DIGITS <>;
kono
parents:
diff changeset
54 TYPE T1 IS DIGITS <>;
kono
parents:
diff changeset
55 F : T;
kono
parents:
diff changeset
56 F1 : T1;
kono
parents:
diff changeset
57 PROCEDURE P (F2 : T; STR : STRING);
kono
parents:
diff changeset
58
kono
parents:
diff changeset
59 PROCEDURE P (F2 : T; STR : STRING) IS
kono
parents:
diff changeset
60 SUBTYPE ST IS T RANGE -1.0 .. 1.0;
kono
parents:
diff changeset
61 F3, F4 : T;
kono
parents:
diff changeset
62
kono
parents:
diff changeset
63 FUNCTION FUN (X : T) RETURN BOOLEAN IS
kono
parents:
diff changeset
64 BEGIN
kono
parents:
diff changeset
65 RETURN IDENT_BOOL (TRUE);
kono
parents:
diff changeset
66 END FUN;
kono
parents:
diff changeset
67
kono
parents:
diff changeset
68 FUNCTION FUN (X : T1) RETURN BOOLEAN IS
kono
parents:
diff changeset
69 BEGIN
kono
parents:
diff changeset
70 RETURN IDENT_BOOL (FALSE);
kono
parents:
diff changeset
71 END FUN;
kono
parents:
diff changeset
72
kono
parents:
diff changeset
73 BEGIN
kono
parents:
diff changeset
74 F3 := F;
kono
parents:
diff changeset
75 F4 := F2;
kono
parents:
diff changeset
76 F3 := F4;
kono
parents:
diff changeset
77
kono
parents:
diff changeset
78 IF F3 /= F2 THEN
kono
parents:
diff changeset
79 FAILED ( "INCORRECT RESULTS FOR ASSIGNMENT " &
kono
parents:
diff changeset
80 "WITH TYPE - " & STR);
kono
parents:
diff changeset
81 END IF;
kono
parents:
diff changeset
82
kono
parents:
diff changeset
83 IF F IN ST THEN
kono
parents:
diff changeset
84 NULL;
kono
parents:
diff changeset
85 ELSE
kono
parents:
diff changeset
86 FAILED ( "INCORRECT RESULTS FOR ""IN"" WITH " &
kono
parents:
diff changeset
87 "TYPE - " & STR);
kono
parents:
diff changeset
88 END IF;
kono
parents:
diff changeset
89
kono
parents:
diff changeset
90 IF F2 NOT IN ST THEN
kono
parents:
diff changeset
91 NULL;
kono
parents:
diff changeset
92 ELSE
kono
parents:
diff changeset
93 FAILED ( "INCORRECT RESULTS FOR ""NOT IN"" WITH " &
kono
parents:
diff changeset
94 "TYPE - " & STR);
kono
parents:
diff changeset
95 END IF;
kono
parents:
diff changeset
96
kono
parents:
diff changeset
97 IF T'(F) /= F THEN
kono
parents:
diff changeset
98 FAILED ( "INCORRECT RESULTS FOR QUALIFICATION " &
kono
parents:
diff changeset
99 "WITH TYPE - " & STR & " - 1" );
kono
parents:
diff changeset
100 END IF;
kono
parents:
diff changeset
101
kono
parents:
diff changeset
102 IF FUN (T'(1.0)) THEN
kono
parents:
diff changeset
103 NULL;
kono
parents:
diff changeset
104 ELSE
kono
parents:
diff changeset
105 FAILED ( "INCORRECT RESULTS FOR QUALIFICATION " &
kono
parents:
diff changeset
106 "WITH TYPE - " & STR & " - 2" );
kono
parents:
diff changeset
107 END IF;
kono
parents:
diff changeset
108
kono
parents:
diff changeset
109 END P;
kono
parents:
diff changeset
110
kono
parents:
diff changeset
111 PROCEDURE P1 IS NEW P (FLOAT, FLOAT, 0.0, 0.0);
kono
parents:
diff changeset
112 PROCEDURE P2 IS NEW P (NEWFLT, NEWFLT, 0.0, 0.0);
kono
parents:
diff changeset
113
kono
parents:
diff changeset
114 BEGIN
kono
parents:
diff changeset
115 P1 (2.0, "FLOAT");
kono
parents:
diff changeset
116 P2 (2.0, "NEWFLT");
kono
parents:
diff changeset
117 END; -- (A).
kono
parents:
diff changeset
118
kono
parents:
diff changeset
119 DECLARE -- (B) CHECKS FOR EXPLICIT CONVERSION TO AND FROM OTHER
kono
parents:
diff changeset
120 -- NUMERIC TYPES, AND IMPLICIT CONVERSION FROM
kono
parents:
diff changeset
121 -- REAL LITERAL.
kono
parents:
diff changeset
122
kono
parents:
diff changeset
123 GENERIC
kono
parents:
diff changeset
124 TYPE T IS DIGITS <>;
kono
parents:
diff changeset
125 PROCEDURE P (STR : STRING);
kono
parents:
diff changeset
126
kono
parents:
diff changeset
127 PROCEDURE P (STR : STRING) IS
kono
parents:
diff changeset
128
kono
parents:
diff changeset
129 TYPE FIXED IS DELTA 0.1 RANGE -100.0 .. 100.0;
kono
parents:
diff changeset
130 FI0 : FIXED := 0.0;
kono
parents:
diff changeset
131 FI2 : FIXED := 2.0;
kono
parents:
diff changeset
132 FIN2 : FIXED := -2.0;
kono
parents:
diff changeset
133
kono
parents:
diff changeset
134 I0 : INTEGER := 0;
kono
parents:
diff changeset
135 I2 : INTEGER := 2;
kono
parents:
diff changeset
136 IN2 : INTEGER := -2;
kono
parents:
diff changeset
137
kono
parents:
diff changeset
138 T0 : T := 0.0;
kono
parents:
diff changeset
139 T2 : T := 2.0;
kono
parents:
diff changeset
140 TN2 : T := -2.0;
kono
parents:
diff changeset
141
kono
parents:
diff changeset
142 FUNCTION IDENT (X : T) RETURN T IS
kono
parents:
diff changeset
143 BEGIN
kono
parents:
diff changeset
144 IF EQUAL (3, 3) THEN
kono
parents:
diff changeset
145 RETURN X;
kono
parents:
diff changeset
146 ELSE
kono
parents:
diff changeset
147 RETURN T'FIRST;
kono
parents:
diff changeset
148 END IF;
kono
parents:
diff changeset
149 END IDENT;
kono
parents:
diff changeset
150
kono
parents:
diff changeset
151 BEGIN
kono
parents:
diff changeset
152 IF T0 + 1.0 /= 1.0 THEN
kono
parents:
diff changeset
153 FAILED ( "INCORRECT RESULTS FOR IMPLICIT " &
kono
parents:
diff changeset
154 "CONVERSION WITH TYPE " & STR & " - 1" );
kono
parents:
diff changeset
155 END IF;
kono
parents:
diff changeset
156
kono
parents:
diff changeset
157 IF T2 + 1.0 /= 3.0 THEN
kono
parents:
diff changeset
158 FAILED ( "INCORRECT RESULTS FOR IMPLICIT " &
kono
parents:
diff changeset
159 "CONVERSION WITH TYPE " & STR & " - 2" );
kono
parents:
diff changeset
160 END IF;
kono
parents:
diff changeset
161
kono
parents:
diff changeset
162 IF TN2 + 1.0 /= -1.0 THEN
kono
parents:
diff changeset
163 FAILED ( "INCORRECT RESULTS FOR IMPLICIT " &
kono
parents:
diff changeset
164 "CONVERSION WITH TYPE " & STR & " - 3" );
kono
parents:
diff changeset
165 END IF;
kono
parents:
diff changeset
166
kono
parents:
diff changeset
167 IF T (FI0) /= T0 THEN
kono
parents:
diff changeset
168 FAILED ( "INCORRECT CONVERSION FROM " &
kono
parents:
diff changeset
169 "FIXED VALUE 0.0 WITH TYPE " & STR);
kono
parents:
diff changeset
170 END IF;
kono
parents:
diff changeset
171
kono
parents:
diff changeset
172 IF T (FI2) /= IDENT (T2) THEN
kono
parents:
diff changeset
173 FAILED ( "INCORRECT CONVERSION FROM " &
kono
parents:
diff changeset
174 "FIXED VALUE 2.0 WITH TYPE " & STR);
kono
parents:
diff changeset
175 END IF;
kono
parents:
diff changeset
176
kono
parents:
diff changeset
177 IF T (FIN2) /= TN2 THEN
kono
parents:
diff changeset
178 FAILED ( "INCORRECT CONVERSION FROM " &
kono
parents:
diff changeset
179 "FIXED VALUE -2.0 WITH TYPE " & STR);
kono
parents:
diff changeset
180 END IF;
kono
parents:
diff changeset
181
kono
parents:
diff changeset
182 IF T (I0) /= IDENT (T0) THEN
kono
parents:
diff changeset
183 FAILED ( "INCORRECT CONVERSION FROM " &
kono
parents:
diff changeset
184 "INTEGER VALUE 0 WITH TYPE " & STR);
kono
parents:
diff changeset
185 END IF;
kono
parents:
diff changeset
186
kono
parents:
diff changeset
187 IF T (I2) /= T2 THEN
kono
parents:
diff changeset
188 FAILED ( "INCORRECT CONVERSION FROM " &
kono
parents:
diff changeset
189 "INTEGER VALUE 2 WITH TYPE " & STR);
kono
parents:
diff changeset
190 END IF;
kono
parents:
diff changeset
191
kono
parents:
diff changeset
192 IF T (IN2) /= IDENT (TN2) THEN
kono
parents:
diff changeset
193 FAILED ( "INCORRECT CONVERSION FROM " &
kono
parents:
diff changeset
194 "INTEGER VALUE -2 WITH TYPE " & STR);
kono
parents:
diff changeset
195 END IF;
kono
parents:
diff changeset
196
kono
parents:
diff changeset
197 IF FIXED (T0) /= FI0 THEN
kono
parents:
diff changeset
198 FAILED ( "INCORRECT CONVERSION TO " &
kono
parents:
diff changeset
199 "FIXED VALUE 0.0 WITH TYPE " & STR);
kono
parents:
diff changeset
200 END IF;
kono
parents:
diff changeset
201
kono
parents:
diff changeset
202 IF FIXED (IDENT (T2)) /= FI2 THEN
kono
parents:
diff changeset
203 FAILED ( "INCORRECT CONVERSION TO " &
kono
parents:
diff changeset
204 "FIXED VALUE 2.0 WITH TYPE " & STR);
kono
parents:
diff changeset
205 END IF;
kono
parents:
diff changeset
206
kono
parents:
diff changeset
207 IF FIXED (TN2) /= FIN2 THEN
kono
parents:
diff changeset
208 FAILED ( "INCORRECT CONVERSION TO " &
kono
parents:
diff changeset
209 "FIXED VALUE -2.0 WITH TYPE " & STR);
kono
parents:
diff changeset
210 END IF;
kono
parents:
diff changeset
211
kono
parents:
diff changeset
212 IF INTEGER (IDENT (T0)) /= I0 THEN
kono
parents:
diff changeset
213 FAILED ( "INCORRECT CONVERSION TO " &
kono
parents:
diff changeset
214 "INTEGER VALUE 0 WITH TYPE " & STR);
kono
parents:
diff changeset
215 END IF;
kono
parents:
diff changeset
216
kono
parents:
diff changeset
217 IF INTEGER (T2) /= I2 THEN
kono
parents:
diff changeset
218 FAILED ( "INCORRECT CONVERSION TO " &
kono
parents:
diff changeset
219 "INTEGER VALUE 2 WITH TYPE " & STR);
kono
parents:
diff changeset
220 END IF;
kono
parents:
diff changeset
221
kono
parents:
diff changeset
222 IF INTEGER (IDENT (TN2)) /= IN2 THEN
kono
parents:
diff changeset
223 FAILED ( "INCORRECT CONVERSION TO " &
kono
parents:
diff changeset
224 "INTEGER VALUE -2 WITH TYPE " & STR);
kono
parents:
diff changeset
225 END IF;
kono
parents:
diff changeset
226
kono
parents:
diff changeset
227 END P;
kono
parents:
diff changeset
228
kono
parents:
diff changeset
229 PROCEDURE P1 IS NEW P (FLOAT);
kono
parents:
diff changeset
230 PROCEDURE P2 IS NEW P (NEWFLT);
kono
parents:
diff changeset
231
kono
parents:
diff changeset
232 BEGIN
kono
parents:
diff changeset
233 P1 ( "FLOAT" );
kono
parents:
diff changeset
234 P2 ( "NEWFLT" );
kono
parents:
diff changeset
235 END; -- (B).
kono
parents:
diff changeset
236
kono
parents:
diff changeset
237 DECLARE -- (C) CHECKS FOR ATTRIBUTES.
kono
parents:
diff changeset
238
kono
parents:
diff changeset
239 GENERIC
kono
parents:
diff changeset
240 TYPE T IS DIGITS <>;
kono
parents:
diff changeset
241 F, L : T;
kono
parents:
diff changeset
242 D : INTEGER;
kono
parents:
diff changeset
243 PROCEDURE P (STR : STRING);
kono
parents:
diff changeset
244
kono
parents:
diff changeset
245 PROCEDURE P (STR : STRING) IS
kono
parents:
diff changeset
246
kono
parents:
diff changeset
247 F1 : T;
kono
parents:
diff changeset
248 A : ADDRESS := F'ADDRESS;
kono
parents:
diff changeset
249 S : INTEGER := F'SIZE;
kono
parents:
diff changeset
250
kono
parents:
diff changeset
251 I : INTEGER;
kono
parents:
diff changeset
252 I1 : INTEGER := T'MACHINE_RADIX;
kono
parents:
diff changeset
253 I2 : INTEGER := T'MACHINE_MANTISSA;
kono
parents:
diff changeset
254 I3 : INTEGER := T'MACHINE_EMAX;
kono
parents:
diff changeset
255 I4 : INTEGER := T'MACHINE_EMIN;
kono
parents:
diff changeset
256
kono
parents:
diff changeset
257 B1 : BOOLEAN := T'MACHINE_ROUNDS;
kono
parents:
diff changeset
258 B2 : BOOLEAN := T'MACHINE_OVERFLOWS;
kono
parents:
diff changeset
259
kono
parents:
diff changeset
260 BEGIN
kono
parents:
diff changeset
261 IF T'DIGITS /= D THEN
kono
parents:
diff changeset
262 FAILED ( "INCORRECT VALUE FOR " &
kono
parents:
diff changeset
263 STR & "'DIGITS" );
kono
parents:
diff changeset
264 END IF;
kono
parents:
diff changeset
265
kono
parents:
diff changeset
266 IF T'FIRST /= F THEN
kono
parents:
diff changeset
267 FAILED ( "INCORRECT VALUE FOR " &
kono
parents:
diff changeset
268 STR & "'FIRST" );
kono
parents:
diff changeset
269 END IF;
kono
parents:
diff changeset
270
kono
parents:
diff changeset
271 IF T'LAST /= L THEN
kono
parents:
diff changeset
272 FAILED ( "INCORRECT VALUE FOR " &
kono
parents:
diff changeset
273 STR & "'LAST" );
kono
parents:
diff changeset
274 END IF;
kono
parents:
diff changeset
275
kono
parents:
diff changeset
276 END P;
kono
parents:
diff changeset
277
kono
parents:
diff changeset
278 PROCEDURE P1 IS
kono
parents:
diff changeset
279 NEW P (FLOAT, FLOAT'FIRST, FLOAT'LAST, FLOAT'DIGITS);
kono
parents:
diff changeset
280 PROCEDURE P2 IS
kono
parents:
diff changeset
281 NEW P (NEWFLT, NEWFLT'FIRST, NEWFLT'LAST,
kono
parents:
diff changeset
282 NEWFLT'DIGITS);
kono
parents:
diff changeset
283
kono
parents:
diff changeset
284 BEGIN
kono
parents:
diff changeset
285 P1 ( "FLOAT" );
kono
parents:
diff changeset
286 P2 ( "NEWFLT" );
kono
parents:
diff changeset
287 END; -- (C).
kono
parents:
diff changeset
288
kono
parents:
diff changeset
289 RESULT;
kono
parents:
diff changeset
290 END CC1222A;