1-- C34004A.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-- CHECK THAT THE REQUIRED PREDEFINED OPERATIONS ARE DECLARED 27-- (IMPLICITLY) FOR DERIVED FIXED POINT TYPES. 28 29-- HISTORY: 30-- JRK 09/08/86 CREATED ORIGINAL TEST. 31-- JET 08/06/87 FIXED BUGS IN DELTAS AND RANGE ERROR. 32-- JET 09/22/88 CHANGED USAGE OF X'SIZE. 33-- RDH 04/16/90 ADDED TEST FOR REAL VARIABLE VALUES. 34-- THS 09/25/90 REMOVED ALL REFERENCES TO B, MODIFIED CHECK OF 35-- '=', INITIALIZED Z NON-STATICALLY, MOVED BINARY 36-- CHECKS. 37-- DTN 11/30/95 REMOVED NON ADA95 ATTRIBUTES. 38-- KAS 03/04/96 REMOVED COMPARISON OF T'SMALL TO T'BASE'SMALL 39 40WITH SYSTEM; USE SYSTEM; 41WITH REPORT; USE REPORT; 42 43PROCEDURE C34004A IS 44 45 TYPE PARENT IS DELTA 2.0 ** (-7) RANGE -100.0 .. 100.0; 46 47 SUBTYPE SUBPARENT IS PARENT RANGE 48 IDENT_INT (1) * (-50.0) .. 49 IDENT_INT (1) * ( 50.0); 50 51 TYPE T IS NEW SUBPARENT DELTA 2.0 ** (-4) RANGE 52 IDENT_INT (1) * (-30.0) .. 53 IDENT_INT (1) * ( 30.0); 54 55 TYPE FIXED IS DELTA 2.0 ** (-4) RANGE -1000.0 .. 1000.0; 56 57 X : T := -30.0; 58 I : INTEGER := X'SIZE; --CHECK FOR THE AVAILABILITY OF 'SIZE. 59 W : PARENT := -100.0; 60 R : CONSTANT := 1.0; 61 M : CONSTANT := 100.0; 62 F : FLOAT := 0.0; 63 G : FIXED := 0.0; 64 65 PROCEDURE A (X : ADDRESS) IS 66 BEGIN 67 NULL; 68 END A; 69 70 FUNCTION IDENT (X : T) RETURN T IS 71 BEGIN 72 IF EQUAL (3, 3) THEN 73 RETURN X; -- ALWAYS EXECUTED. 74 END IF; 75 RETURN T'FIRST; 76 END IDENT; 77 78BEGIN 79 80 DECLARE 81 Z : CONSTANT T := IDENT(0.0); 82 BEGIN 83 TEST ("C34004A", "CHECK THAT THE REQUIRED PREDEFINED " & 84 "OPERATIONS ARE DECLARED (IMPLICITLY) " & 85 "FOR DERIVED FIXED POINT TYPES"); 86 87 X := IDENT (30.0); 88 IF X /= 30.0 THEN 89 FAILED ("INCORRECT :="); 90 END IF; 91 92 IF X + IDENT (-1.0) /= 29.0 OR X + 70.0 /= 100.0 THEN 93 FAILED ("INCORRECT BINARY +"); 94 END IF; 95 96 IF X - IDENT (30.0) /= 0.0 OR X - 100.0 /= -70.0 THEN 97 FAILED ("INCORRECT BINARY -"); 98 END IF; 99 100 IF T'(X) /= 30.0 THEN 101 FAILED ("INCORRECT QUALIFICATION"); 102 END IF; 103 104 IF T (X) /= 30.0 THEN 105 FAILED ("INCORRECT SELF CONVERSION"); 106 END IF; 107 108 IF EQUAL (3, 3) THEN 109 W := -30.0; 110 END IF; 111 IF T (W) /= -30.0 THEN 112 FAILED ("INCORRECT CONVERSION FROM PARENT"); 113 END IF; 114 115 IF PARENT (X) /= 30.0 OR PARENT (Z - 100.0) /= -100.0 THEN 116 FAILED ("INCORRECT CONVERSION TO PARENT"); 117 END IF; 118 119 IF T (IDENT_INT (-30)) /= -30.0 THEN 120 FAILED ("INCORRECT CONVERSION FROM INTEGER"); 121 END IF; 122 123 IF INTEGER (X) /= 30 OR INTEGER (Z - 100.0) /= -100 THEN 124 FAILED ("INCORRECT CONVERSION TO INTEGER"); 125 END IF; 126 127 IF EQUAL (3, 3) THEN 128 F := -30.0; 129 END IF; 130 IF T (F) /= -30.0 THEN 131 FAILED ("INCORRECT CONVERSION FROM FLOAT"); 132 END IF; 133 134 IF FLOAT (X) /= 30.0 OR FLOAT (Z - 100.0) /= -100.0 THEN 135 FAILED ("INCORRECT CONVERSION TO FLOAT"); 136 END IF; 137 138 IF EQUAL (3, 3) THEN 139 G := -30.0; 140 END IF; 141 IF T (G) /= -30.0 THEN 142 FAILED ("INCORRECT CONVERSION FROM FIXED"); 143 END IF; 144 145 IF FIXED (X) /= 30.0 OR FIXED (Z - 100.0) /= -100.0 THEN 146 FAILED ("INCORRECT CONVERSION TO FIXED"); 147 END IF; 148 149 IF IDENT (R) /= 1.0 OR X = M THEN 150 FAILED ("INCORRECT IMPLICIT CONVERSION"); 151 END IF; 152 153 IF IDENT (30.0) /= 30.0 OR X = 100.0 THEN 154 FAILED ("INCORRECT REAL LITERAL"); 155 END IF; 156 157 IF NOT (X = IDENT (30.0)) THEN 158 FAILED ("INCORRECT ="); 159 END IF; 160 161 IF X /= IDENT (30.0) OR NOT (X /= 100.0) THEN 162 FAILED ("INCORRECT /="); 163 END IF; 164 165 IF X < IDENT (30.0) OR 100.0 < X THEN 166 FAILED ("INCORRECT <"); 167 END IF; 168 169 IF X > IDENT (30.0) OR X > 100.0 THEN 170 FAILED ("INCORRECT >"); 171 END IF; 172 173 IF X <= IDENT (0.0) OR 100.0 <= X THEN 174 FAILED ("INCORRECT <="); 175 END IF; 176 177 IF IDENT (0.0) >= X OR X >= 100.0 THEN 178 FAILED ("INCORRECT >="); 179 END IF; 180 181 IF NOT (X IN T) OR 100.0 IN T THEN 182 FAILED ("INCORRECT ""IN"""); 183 END IF; 184 185 IF X NOT IN T OR NOT (100.0 NOT IN T) THEN 186 FAILED ("INCORRECT ""NOT IN"""); 187 END IF; 188 189 IF +X /= 30.0 OR +(Z - 100.0) /= -100.0 THEN 190 FAILED ("INCORRECT UNARY +"); 191 END IF; 192 193 IF -X /= 0.0 - 30.0 OR -(Z - 100.0) /= 100.0 THEN 194 FAILED ("INCORRECT UNARY -"); 195 END IF; 196 197 IF ABS X /= 30.0 OR ABS (Z - 100.0) /= 100.0 THEN 198 FAILED ("INCORRECT ABS"); 199 END IF; 200 201 IF T (X * IDENT (-1.0)) /= -30.0 OR 202 T (IDENT (2.0) * (Z + 15.0)) /= 30.0 THEN 203 FAILED ("INCORRECT * (FIXED, FIXED)"); 204 END IF; 205 206 IF X * IDENT_INT (-1) /= -30.0 OR 207 (Z + 50.0) * 2 /= 100.0 THEN 208 FAILED ("INCORRECT * (FIXED, INTEGER)"); 209 END IF; 210 211 IF IDENT_INT (-1) * X /= -30.0 OR 212 2 * (Z + 50.0) /= 100.0 THEN 213 FAILED ("INCORRECT * (INTEGER, FIXED)"); 214 END IF; 215 216 IF T (X / IDENT (3.0)) /= 10.0 OR 217 T ((Z + 90.0) / X) /= 3.0 THEN 218 FAILED ("INCORRECT / (FIXED, FIXED)"); 219 END IF; 220 221 IF X / IDENT_INT (3) /= 10.0 OR (Z + 90.0) / 30 /= 3.0 THEN 222 FAILED ("INCORRECT / (FIXED, INTEGER)"); 223 END IF; 224 225 A (X'ADDRESS); 226 227 IF T'AFT /= 2 OR T'BASE'AFT < 3 THEN 228 FAILED ("INCORRECT 'AFT"); 229 END IF; 230 231 IF T'BASE'SIZE < 15 THEN 232 FAILED ("INCORRECT 'BASE'SIZE"); 233 END IF; 234 235 IF T'DELTA /= 2.0 ** (-4) OR T'BASE'DELTA > 2.0 ** (-7) THEN 236 FAILED ("INCORRECT 'DELTA"); 237 END IF; 238 239 240 IF T'FORE /= 3 OR T'BASE'FORE < 4 THEN 241 FAILED ("INCORRECT 'FORE"); 242 END IF; 243 244 245 246 IF T'MACHINE_OVERFLOWS /= T'BASE'MACHINE_OVERFLOWS THEN 247 FAILED ("INCORRECT 'MACHINE_OVERFLOWS"); 248 END IF; 249 250 IF T'MACHINE_ROUNDS /= T'BASE'MACHINE_ROUNDS THEN 251 FAILED ("INCORRECT 'MACHINE_ROUNDS"); 252 END IF; 253 254 255 256 257 IF T'SIZE < 10 THEN 258 FAILED ("INCORRECT TYPE'SIZE"); 259 END IF; 260 261 IF T'SMALL > 2.0 ** (-4) OR T'BASE'SMALL > 2.0 ** (-7) THEN 262 FAILED ("INCORRECT 'SMALL"); 263 END IF; 264 END; 265 266 RESULT; 267END C34004A; 268