3 -- Grant of Unlimited Rights
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
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.
25 -- CHECK THAT THE REQUIRED PREDEFINED OPERATIONS ARE DECLARED
26 -- (IMPLICITLY) FOR DERIVED FLOATING POINT TYPES.
29 -- GJD 11/14/95 REMOVED USES OF OBSOLETE ADA 83 ATTRIBUTES.
31 WITH SYSTEM
; USE SYSTEM
;
32 WITH REPORT
; USE REPORT
;
36 TYPE PARENT
IS DIGITS 5;
38 SUBTYPE SUBPARENT
IS PARENT
RANGE
39 PARENT
(IDENT_INT
(-50)) ..
40 PARENT
(IDENT_INT
( 50));
42 TYPE T
IS NEW SUBPARENT
DIGITS 4 RANGE
43 PARENT
(IDENT_INT
(-30)) ..
44 PARENT
(IDENT_INT
( 30));
46 TYPE FIXED
IS DELTA 0.1 RANGE -1000.0 .. 1000.0;
51 M
: CONSTANT := 100.0;
56 Z
: CONSTANT T
:= 0.0;
58 PROCEDURE A
(X
: ADDRESS
) IS
60 B
:= IDENT_BOOL
(TRUE);
63 FUNCTION IDENT
(X
: T
) RETURN T
IS
66 RETURN X
; -- ALWAYS EXECUTED.
72 TEST
("C34003A", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
73 "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
74 "FLOATING POINT TYPES");
78 FAILED
("INCORRECT :=");
82 FAILED ("INCORRECT QUALIFICATION");
86 FAILED ("INCORRECT SELF CONVERSION");
92 IF T (W) /= -30.0 THEN
93 FAILED ("INCORRECT CONVERSION FROM PARENT");
96 IF PARENT (X) /= 30.0 OR PARENT (Z - 100.0) /= -100.0 THEN
97 FAILED ("INCORRECT CONVERSION TO PARENT");
100 IF T (IDENT_INT (-30)) /= -30.0 THEN
101 FAILED ("INCORRECT CONVERSION FROM INTEGER");
104 IF INTEGER (X) /= 30 OR INTEGER (Z - 100.0) /= -100 THEN
105 FAILED ("INCORRECT CONVERSION TO INTEGER");
111 IF T (F) /= -30.0 THEN
112 FAILED ("INCORRECT CONVERSION FROM FLOAT");
115 IF FLOAT (X) /= 30.0 OR FLOAT (Z - 100.0) /= -100.0 THEN
116 FAILED ("INCORRECT CONVERSION TO FLOAT");
122 IF T (G) /= -30.0 THEN
123 FAILED ("INCORRECT CONVERSION FROM FIXED");
126 IF FIXED (X) /= 30.0 OR FIXED (Z - 100.0) /= -100.0 THEN
127 FAILED ("INCORRECT CONVERSION TO FIXED");
130 IF IDENT (R) /= 1.0 OR X = M THEN
131 FAILED ("INCORRECT IMPLICIT CONVERSION");
134 IF IDENT (30.0) /= 30.0 OR X = 100.0 THEN
135 FAILED ("INCORRECT REAL LITERAL");
138 IF X = IDENT (0.0) OR X = 100.0 THEN
139 FAILED ("INCORRECT =");
142 IF X /= IDENT (30.0) OR NOT (X /= 100.0) THEN
143 FAILED ("INCORRECT /=");
146 IF X < IDENT (30.0) OR 100.0 < X THEN
147 FAILED ("INCORRECT <");
150 IF X > IDENT (30.0) OR X > 100.0 THEN
151 FAILED ("INCORRECT >");
154 IF X <= IDENT (0.0) OR 100.0 <= X THEN
155 FAILED ("INCORRECT <=");
158 IF IDENT (0.0) >= X OR X >= 100.0 THEN
159 FAILED ("INCORRECT >=");
162 IF NOT (X IN T) OR 100.0 IN T THEN
163 FAILED ("INCORRECT ""IN""");
166 IF X NOT IN T OR NOT (100.0 NOT IN T) THEN
167 FAILED ("INCORRECT ""NOT IN""");
170 IF +X /= 30.0 OR +(Z - 100.0) /= -100.0 THEN
171 FAILED ("INCORRECT UNARY +");
174 IF -X /= 0.0 - 30.0 OR -(Z - 100.0) /= 100.0 THEN
175 FAILED ("INCORRECT UNARY -");
178 IF ABS X /= 30.0 OR ABS (Z - 100.0) /= 100.0 THEN
179 FAILED ("INCORRECT ABS");
182 IF X + IDENT (-1.0) /= 29.0 OR X + 70.0 /= 100.0 THEN
183 FAILED ("INCORRECT BINARY +");
186 IF X - IDENT (30.0) /= 0.0 OR X - 100.0 /= -70.0 THEN
187 FAILED ("INCORRECT BINARY -");
190 IF X * IDENT (-1.0) /= -30.0 OR IDENT (2.0) * 50.0 /= 100.0 THEN
191 FAILED ("INCORRECT *");
194 IF X / IDENT (3.0) /= 10.0 OR 90.0 / X /= 3.0 THEN
195 FAILED ("INCORRECT /");
198 IF X ** IDENT_INT (1) /= 30.0 OR
199 (Z + 100.0) ** IDENT_INT (1) /= 100.0 THEN
200 FAILED ("INCORRECT **");
206 FAILED ("INCORRECT 'ADDRESS
");
209 IF T'BASE'SIZE < 27 THEN
210 FAILED ("INCORRECT
'BASE'SIZE");
213 IF T'DIGITS /= 4 OR T'BASE'DIGITS < 5 THEN
214 FAILED
("INCORRECT 'DIGITS");
217 IF T
'FIRST /= -30.0 THEN
218 FAILED
("INCORRECT 'FIRST");
221 IF T
'LAST /= 30.0 THEN
222 FAILED
("INCORRECT 'LAST");
225 IF T
'MACHINE_EMAX < 1 OR T
'BASE'MACHINE_EMAX /= T'MACHINE_EMAX THEN
226 FAILED ("INCORRECT 'MACHINE_EMAX
");
229 IF T'MACHINE_EMIN > -1 OR T'BASE'MACHINE_EMIN /= T'MACHINE_EMIN THEN
230 FAILED ("INCORRECT
'MACHINE_EMIN");
233 IF T'MACHINE_MANTISSA < 1 OR
234 T'BASE'MACHINE_MANTISSA
/= T
'MACHINE_MANTISSA THEN
235 FAILED
("INCORRECT 'MACHINE_MANTISSA");
238 IF T
'MACHINE_OVERFLOWS /= T
'BASE'MACHINE_OVERFLOWS THEN
239 FAILED ("INCORRECT 'MACHINE_OVERFLOWS
");
242 IF T'MACHINE_RADIX < 2 OR
243 T'BASE'MACHINE_RADIX /= T'MACHINE_RADIX THEN
244 FAILED ("INCORRECT
'MACHINE_RADIX");
247 IF T'MACHINE_ROUNDS /= T'BASE'MACHINE_ROUNDS
THEN
248 FAILED
("INCORRECT 'MACHINE_ROUNDS");
252 FAILED
("INCORRECT TYPE'SIZE");
256 FAILED
("INCORRECT OBJECT'SIZE");