1-- C45331A.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-- CHECK THAT FOR FIXED POINT TYPES THE OPERATORS "+" AND "-" PRODUCE 26-- CORRECT RESULTS WHEN: 27-- (A) A, B, A+B, AND A-B ARE ALL MODEL NUMBERS. 28-- (B) A IS A MODEL NUMBER BUT B, A+B, AND A-B ARE NOT. 29-- (C) A, B, A+B, AND A-B ARE ALL MODEL NUMBERS WITH DIFFERENT 30-- SUBTYPES. 31 32-- CASE A: BASIC TYPES THAT FIT THE CHARACTERISTICS OF DURATION'BASE. 33 34-- WRG 8/27/86 35-- KAS 11/14/95 REDUCE EXPECTATION FOR T'SMALL 36-- KAS 11/30/95 ONE MORE CHANGE... 37-- PWN 02/28/96 CLEANED COMMENTS FOR RELEASE 38-- KAS 03/18/96 ELIDED TWO 'SMALL CASES FOR 2.1 39 40WITH REPORT; USE REPORT; 41PROCEDURE C45331A IS 42 43 TYPE LIKE_DURATION IS DELTA 0.020 RANGE -86_400.0 .. 86_400.0; 44 -- 'MANTISSA = 23. 45 SUBTYPE F IS LIKE_DURATION DELTA 0.25 RANGE -1000.0 .. 1000.0; 46 SUBTYPE ST_F1 IS LIKE_DURATION DELTA 0.5 RANGE -4.0 .. 3.0; 47 SUBTYPE ST_F2 IS LIKE_DURATION DELTA 1.0 / 16 48 RANGE -13.0 / 16 .. 5.0 + 1.0 / 16; 49 50BEGIN 51 52 TEST ("C45331A", "CHECK THAT FOR FIXED POINT TYPES THE " & 53 "OPERATORS ""+"" AND ""-"" PRODUCE CORRECT " & 54 "RESULTS - BASIC TYPES"); 55 56 ------------------------------------------------------------------- 57 58A: DECLARE 59 SMALL, MAX, MIN, ZERO : F := 0.5; 60 X : F := 0.0; 61 BEGIN 62 -- INITIALIZE "CONSTANTS": 63 IF EQUAL (3, 3) THEN 64 SMALL := F'SMALL; 65 MAX := F'LAST; -- BECAUSE F'LAST < F'LARGE AND F'LAST 66 -- IS A MODEL NUMBER. 67 MIN := F'FIRST; -- F'FIRST IS A MODEL NUMBER. 68 ZERO := 0.0; 69 END IF; 70 71 -- CHECK SMALL + OR - ZERO = SMALL: 72 IF "+"(LEFT => SMALL, RIGHT => ZERO) /= SMALL OR 73 0.0 + SMALL /= SMALL THEN 74 FAILED ("F'SMALL + 0.0 /= F'SMALL"); 75 END IF; 76 IF "-"(LEFT => SMALL, RIGHT => ZERO) /= SMALL OR 77 SMALL - 0.0 /= SMALL THEN 78 FAILED ("F'SMALL - 0.0 /= F'SMALL"); 79 END IF; 80 81 -- CHECK MAX + OR - ZERO = MAX: 82 IF MAX + ZERO /= MAX OR 0.0 + MAX /= MAX THEN 83 FAILED ("F'LAST + 0.0 /= F'LAST"); 84 END IF; 85 IF MAX - ZERO /= MAX OR MAX - 0.0 /= MAX THEN 86 FAILED ("F'LAST - 0.0 /= F'LAST"); 87 END IF; 88 89 -- CHECK SMALL - SMALL = 0.0: 90 IF EQUAL (3, 3) THEN 91 X := SMALL; 92 END IF; 93 IF SMALL - X /= 0.0 OR SMALL - SMALL /= 0.0 OR 94 F'SMALL - F'SMALL /= 0.0 THEN 95 FAILED ("F'SMALL - F'SMALL /= 0.0"); 96 END IF; 97 98 -- CHECK MAX - MAX = 0.0: 99 IF EQUAL (3, 3) THEN 100 X := MAX; 101 END IF; 102 IF MAX - X /= 0.0 OR MAX - MAX /= 0.0 OR 103 F'LAST - F'LAST /= 0.0 THEN 104 FAILED ("F'LAST - F'LAST /= 0.0"); 105 END IF; 106 107 -- CHECK ZERO - MAX = MIN, MIN - MIN = 0.0, 108 -- AND MIN + MAX = 0.0: 109 IF EQUAL (3, 3) THEN 110 X := ZERO - MAX; 111 END IF; 112 IF X /= MIN THEN 113 FAILED ("0.0 - 1000.0 /= -1000.0"); 114 END IF; 115 IF EQUAL (3, 3) THEN 116 X := MIN; 117 END IF; 118 IF MIN - X /= 0.0 OR MIN - MIN /= 0.0 OR 119 F'FIRST - F'FIRST /= 0.0 THEN 120 FAILED ("F'FIRST - F'FIRST /= 0.0"); 121 END IF; 122 IF MIN + MAX /= 0.0 OR MAX + MIN /= 0.0 OR 123 F'FIRST + F'LAST /= 0.0 THEN 124 FAILED ("-1000.0 + 1000.0 /= 0.0"); 125 END IF; 126 127 -- CHECK ADDITION AND SUBTRACTION FOR ARBITRARY MID-RANGE 128 -- NUMBERS: 129 IF EQUAL (3, 3) THEN 130 X := 100.75; 131 END IF; 132 IF (X + SMALL) /= (SMALL + X) OR 133 (X + SMALL) > (X + 0.25) THEN -- X + SMALL SB <= X + DELTA 134 FAILED("X + SMALL DELIVERED BAD RESULT"); 135 END IF; 136 137 -- CHECK (MAX - SMALL) + SMALL = MAX: 138 IF EQUAL (3, 3) THEN 139 X := MAX - SMALL; 140 END IF; 141 IF X + SMALL /= MAX THEN 142 FAILED("(MAX - SMALL) + SMALL /= MAX"); 143 END IF; 144 145 EXCEPTION 146 WHEN OTHERS => 147 FAILED ("EXCEPTION RAISED - A"); 148 END A; 149 150 ------------------------------------------------------------------- 151 152B: DECLARE 153 NON_MODEL_CONST : CONSTANT := 2.0 / 3; 154 NON_MODEL_VAR : F := 0.0; 155 156 SMALL, MAX, MIN, ZERO : F := 0.5; 157 X : F := 0.0; 158 BEGIN 159 -- INITIALIZE "CONSTANTS": 160 IF EQUAL (3, 3) THEN 161 SMALL := F'SMALL; 162 MAX := F'LAST; -- BECAUSE F'LAST < F'LARGE AND 163 -- F'LAST IS A MODEL NUMBER. 164 MIN := F'FIRST; -- F'FIRST IS A MODEL NUMBER. 165 ZERO := 0.0; 166 NON_MODEL_VAR := NON_MODEL_CONST; 167 END IF; 168 169 -- CHECK VALUE OF NON_MODEL_VAR: 170 IF NON_MODEL_VAR NOT IN 0.5 .. 0.75 THEN 171 FAILED ("VALUE OF NON_MODEL_VAR NOT IN CORRECT RANGE"); 172 END IF; 173 174 -- CHECK NON-MODEL VALUE + OR - ZERO: 175 IF NON_MODEL_VAR + ZERO NOT IN 0.5 .. 0.75 OR 176 F'(0.0) + NON_MODEL_CONST NOT IN 0.5 .. 0.75 THEN 177 FAILED ("(2.0 / 3) + 0.0 NOT IN 0.5 .. 0.75"); 178 END IF; 179 IF NON_MODEL_VAR - ZERO NOT IN 0.5 .. 0.75 OR 180 NON_MODEL_CONST - F'(0.0) NOT IN 0.5 .. 0.75 THEN 181 FAILED ("(2.0 / 3) - 0.0 NOT IN 0.5 .. 0.75"); 182 END IF; 183 184 -- CHECK ZERO - NON-MODEL: 185 IF F'(0.0) - NON_MODEL_CONST NOT IN -0.75 .. -0.5 THEN 186 FAILED ("0.0 - (2.0 / 3) NOT IN -0.75 .. -0.5"); 187 END IF; 188 189 IF F'(1.0) - NON_MODEL_CONST NOT IN 0.25 .. 0.5 THEN 190 FAILED ("1.0 - (2.0 / 3) NOT IN 0.25 .. 0.5"); 191 END IF; 192 193 -- CHECK ADDITION AND SUBTRACTION OF NON-MODEL NEAR MIN AND 194 -- MAX: 195 IF MIN + NON_MODEL_VAR NOT IN -999.5 .. -999.25 OR 196 NON_MODEL_CONST + F'FIRST NOT IN -999.5 .. -999.25 THEN 197 FAILED ("-1000.0 + (2.0 / 3) NOT IN -999.5 .. -999.25"); 198 END IF; 199 IF MAX - NON_MODEL_VAR NOT IN 999.25 .. 999.5 OR 200 F'LAST - NON_MODEL_CONST NOT IN 999.25 .. 999.5 THEN 201 FAILED ("1000.0 - (2.0 / 3) NOT IN 999.25 .. 999.5"); 202 END IF; 203 204 -- CHECK ADDITION AND SUBTRACTION FOR ARBITRARY MID-RANGE 205 -- MODEL NUMBER WITH NON-MODEL: 206 IF EQUAL (3, 3) THEN 207 X := -213.25; 208 END IF; 209 IF X + NON_MODEL_CONST NOT IN -212.75 .. -212.5 THEN 210 FAILED ("-213.25 + (2.0 / 3) NOT IN -212.75 .. -212.5"); 211 END IF; 212 IF NON_MODEL_VAR - X NOT IN 213.75 .. 214.0 THEN 213 FAILED ("(2.0 / 3) - (-213.25) NOT IN 213.75 .. 214.0"); 214 END IF; 215 216 EXCEPTION 217 WHEN OTHERS => 218 FAILED ("EXCEPTION RAISED - B"); 219 END B; 220 221 ------------------------------------------------------------------- 222 223C: DECLARE 224 A_SMALL, A_MAX, A_MIN : ST_F1 := 0.0; 225 B_SMALL, B_MAX, B_MIN : ST_F2 := 0.0; 226 X : F; 227 BEGIN 228 -- INITIALIZE "CONSTANTS": 229 IF EQUAL (3, 3) THEN 230 A_SMALL := ST_F1'SMALL; 231 A_MAX := ST_F1'LAST; -- BECAUSE 'LAST < 'LARGE AND 232 -- 'LAST IS A MODEL NUMBER. 233 A_MIN := ST_F1'FIRST; -- 'FIRST IS A MODEL NUMBER. 234 235 B_SMALL := ST_F2'SMALL; 236 B_MAX := ST_F2'LAST; -- BECAUSE 'LAST <= 'LARGE AND 237 -- 'LAST IS A MODEL NUMBER. 238 B_MIN := ST_F2'FIRST; -- 'FIRST IS A MODEL NUMBER. 239 END IF; 240 241 IF A_MIN + B_MIN /= -4.8125 THEN 242 FAILED ("-4.0 + (-0.8125) /= -4.8125"); 243 END IF; 244 245 IF A_MIN - B_MIN /= -3.1875 THEN 246 FAILED ("-4.0 - (-0.8125) /= -3.1875"); 247 END IF; 248 249 IF (A_MIN + B_SMALL) NOT IN A_MIN .. -3.9375 THEN 250 FAILED ("(A_MIN + B_SMALL) NOT IN A_MIN .. -3.9375"); 251 END IF; 252 253 IF (A_MIN - B_SMALL) NOT IN -4.0625 .. -4.0 THEN 254 FAILED ("(A_MIN - B_SMALL) NOT IN -4.0 .. -4.0625"); 255 END IF; 256 257 IF A_MIN + B_MAX /= 1.0625 THEN 258 FAILED ("-4.0 + 5.0625 /= 1.0625"); 259 END IF; 260 261 IF A_MIN - B_MAX /= -9.0625 THEN 262 FAILED ("-4.0 - 5.0625 /= -9.0625"); 263 END IF; 264 265 IF (A_SMALL + B_MIN) NOT IN B_MIN..-0.3125 THEN 266 FAILED ("(A_SMALL + B_MIN) NOT IN B_MIN..-0.3125"); 267 END IF; 268 269 IF (A_SMALL - B_MIN) NOT IN +0.8125 .. 1.3125 THEN 270 FAILED ("(A_SMALL - B_MIN) NOT IN -0.8125 .. 1.3125"); 271 END IF; 272 273 274 275 IF (A_SMALL + B_MAX) NOT IN 5.0625 .. 5.5625 THEN 276 FAILED ("(A_SMALL + B_MAX) NOT IN 5.0625 .. 5.5625"); 277 END IF; 278 279 IF (A_SMALL - B_MAX) NOT IN -5.0625 .. -4.5625 THEN 280 FAILED ("(A_SMALL - B_MAX) NOT IN -5.0625 .. -4.5625"); 281 END IF; 282 283 IF A_MAX + B_MIN /= 2.1875 THEN 284 FAILED ("3.0 + (-0.8125) /= 2.1875"); 285 END IF; 286 287 IF A_MAX - B_MIN /= 3.8125 THEN 288 FAILED ("3.0 - (-0.8125) /= 3.8125"); 289 END IF; 290 291 IF (A_MAX + B_SMALL) NOT IN 3.0 .. 3.0625 THEN 292 FAILED ("(A_MAX + B_SMALL) NOT IN 3.0 .. 3.0625"); 293 END IF; 294 295 IF (A_MAX - B_SMALL) NOT IN 2.9375..3.0 THEN 296 FAILED ("(A_MAX - B_SMALL) NOT IN 2.9375..3.0"); 297 END IF; 298 299 IF A_MAX + B_MAX /= 8.0625 THEN 300 FAILED ("3.0 + 5.0625 /= 8.0625"); 301 END IF; 302 303 IF A_MAX - B_MAX /= -2.0625 THEN 304 FAILED ("3.0 - 5.0625 /= -2.0625"); 305 END IF; 306 307 X := B_MIN - A_MIN; 308 IF X NOT IN 3.0 .. 3.25 THEN 309 FAILED ("-0.8125 - (-4.0) NOT IN RANGE"); 310 END IF; 311 312 X := B_MIN - A_SMALL; 313 IF X NOT IN -1.3125 .. -0.8125 THEN 314 FAILED ("B_MIN - A_SMALL NOT IN RANGE"); 315 END IF; 316 317 X := B_MIN - A_MAX; 318 IF X NOT IN -4.0 .. -3.75 THEN 319 FAILED ("-0.8125 - 3.0 NOT IN RANGE"); 320 END IF; 321 322 X := B_SMALL - A_MIN; 323 IF X NOT IN 4.0 .. 4.0625 THEN 324 FAILED ("B_SMALL - A_MIN NOT IN RANGE"); 325 END IF; 326 327 328 X := B_SMALL - A_MAX; 329 IF X NOT IN -3.0 .. -2.75 THEN 330 FAILED ("B_SMALL - A_MAX NOT IN RANGE"); 331 END IF; 332 333 X := B_MAX - A_MIN; 334 IF X NOT IN 9.0 .. 9.25 THEN 335 FAILED ("5.0625 - (-4.0) NOT IN RANGE"); 336 END IF; 337 338 X := B_MAX - A_SMALL; 339 IF X NOT IN 4.56 .. 5.0625 THEN 340 FAILED ("5.0625 - 0.5 NOT IN RANGE"); 341 END IF; 342 343 X := B_MAX - A_MAX; 344 IF X NOT IN 2.0 .. 2.25 THEN 345 FAILED ("5.0625 - 3.0 NOT IN RANGE"); 346 END IF; 347 348 EXCEPTION 349 WHEN OTHERS => 350 FAILED ("EXCEPTION RAISED - C"); 351 END C; 352 353 ------------------------------------------------------------------- 354 355 RESULT; 356 357END C45331A; 358