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