Mercurial > hg > CbC > CbC_gcc

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