111
|
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;
|