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