Mercurial > hg > CbC > CbC_gcc

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