gcc/testsuite/ada/acats/tests/c4/c45331a.ada

   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
  40 WITH REPORT; USE REPORT;
  41 PROCEDURE 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
  50 BEGIN
  51
  52      TEST ("C45331A", "CHECK THAT FOR FIXED POINT TYPES THE " &
  53                       "OPERATORS ""+"" AND ""-"" PRODUCE CORRECT " &
  54                       "RESULTS - BASIC TYPES");
  55
  56      -------------------------------------------------------------------
  57
  58 A:   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
 152 B:   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
 223 C:   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
 357 END C45331A;