gcc/testsuite/ada/acats/tests/c3/c35a07d.ada

   1 -- C35A07D.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 FIRST AND LAST ATTRIBUTES YIELD
  26 -- CORRECT VALUES.
  27
  28 -- CASE D: TYPES TYPICAL OF APPLICATIONS USING FIXED POINT ARITHMETIC.
  29
  30 -- WRG 8/25/86
  31 -- PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
  32
  33 WITH REPORT; USE REPORT;
  34 WITH SYSTEM; USE SYSTEM;
  35 PROCEDURE C35A07D IS
  36
  37      PI      : CONSTANT := 3.14159_26535_89793_23846;
  38      TWO_PI  : CONSTANT := 2 * PI;
  39      HALF_PI : CONSTANT := PI / 2;
  40
  41      MM : CONSTANT := MAX_MANTISSA;
  42
  43      -- THE NAME OF EACH TYPE OR SUBTYPE ENDS WITH THAT TYPE'S
  44      -- 'MANTISSA VALUE.
  45
  46      TYPE PIXEL_M10 IS DELTA 1.0 / 1024.0 RANGE 0.0 ..  1.0;
  47      TYPE RULER_M8  IS DELTA 1.0 / 16.0   RANGE 0.0 .. 12.0;
  48
  49      TYPE HOURS_M16 IS DELTA   24.0 * 2.0 ** (-15) RANGE 0.0 ..   24.0;
  50      TYPE MILES_M16 IS DELTA 3000.0 * 2.0 ** (-15) RANGE 0.0 .. 3000.0;
  51
  52      TYPE SYMMETRIC_DEGREES_M7  IS
  53           DELTA 2.0         RANGE -180.0 .. 180.0;
  54      TYPE NATURAL_DEGREES_M15   IS
  55           DELTA 2.0 ** (-6) RANGE    0.0 .. 360.0;
  56      TYPE SYMMETRIC_RADIANS_M16 IS
  57           DELTA     PI * 2.0 ** (-15) RANGE -PI .. PI;
  58                -- 'SMALL = 2.0 ** (-14) = 0.00006_10351_5625.
  59      TYPE NATURAL_RADIANS_M8    IS
  60           DELTA TWO_PI * 2.0 ** ( -7) RANGE 0.0 .. TWO_PI;
  61                -- 'SMALL = 2.0 ** ( -5) = 0.03125.
  62
  63      -------------------------------------------------------------------
  64
  65      SUBTYPE ST_MILES_M8             IS MILES_M16
  66           DELTA 3000.0 * 2.0 ** (-15) RANGE 0.0 .. 10.0;
  67      SUBTYPE ST_NATURAL_DEGREES_M11  IS NATURAL_DEGREES_M15
  68           DELTA 0.25 RANGE 0.0 .. 360.0;
  69      SUBTYPE ST_SYMMETRIC_RADIANS_M8 IS SYMMETRIC_RADIANS_M16
  70           DELTA HALF_PI * 2.0 ** (-7) RANGE -HALF_PI .. HALF_PI;
  71                -- 'SMALL = 2.0 ** ( -7) = 0.00781_25.
  72
  73 BEGIN
  74
  75      TEST ("C35A07D", "CHECK THAT FOR FIXED POINT TYPES THE FIRST " &
  76                       "AND LAST ATTRIBUTES YIELD CORRECT VALUES - " &
  77                       "TYPICAL TYPES");
  78
  79      -------------------------------------------------------------------
  80
  81
  82      IF PIXEL_M10'FIRST /= IDENT_INT (1) * 0.0 THEN
  83           FAILED ("PIXEL_M10'FIRST /= 0.0");
  84      END IF;
  85
  86      -------------------------------------------------------------------
  87
  88      IF RULER_M8'FIRST /= IDENT_INT (1) * 0.0 THEN
  89           FAILED ("RULER_M8'FIRST /= 0.0");
  90      END IF;
  91      IF RULER_M8'LAST /= IDENT_INT (1) * 12.0 THEN
  92           FAILED ("RULER_M8'LAST /= 12.0");
  93      END IF;
  94
  95      -------------------------------------------------------------------
  96
  97      IF HOURS_M16'FIRST /= IDENT_INT (1) * 0.0 THEN
  98           FAILED ("HOURS_M16'FIRST /= 0.0");
  99      END IF;
 100      IF HOURS_M16'LAST /= IDENT_INT (1) * 24.0 THEN
 101           FAILED ("HOURS_M16'LAST /= 24.0");
 102      END IF;
 103
 104      -------------------------------------------------------------------
 105
 106      IF MILES_M16'FIRST /= IDENT_INT (1) * 0.0 THEN
 107           FAILED ("MILES_M16'FIRST /= 0.0");
 108      END IF;
 109      IF MILES_M16'LAST /= IDENT_INT (1) * 3000.0 THEN
 110           FAILED ("MILES_M16'LAST /= 3000.0");
 111      END IF;
 112
 113      -------------------------------------------------------------------
 114
 115      IF SYMMETRIC_DEGREES_M7'FIRST /= IDENT_INT (1) * (-180.0) THEN
 116           FAILED ("SYMMETRIC_DEGREES_M7'FIRST /= -180.0");
 117      END IF;
 118      IF SYMMETRIC_DEGREES_M7'LAST /= IDENT_INT (1) * 180.0 THEN
 119           FAILED ("SYMMETRIC_DEGREES_M7'LAST /= 180.0");
 120      END IF;
 121
 122      -------------------------------------------------------------------
 123
 124      IF NATURAL_DEGREES_M15'FIRST /= IDENT_INT (1) * 0.0 THEN
 125           FAILED ("NATURAL_DEGREES_M15'FIRST /= 0.0");
 126      END IF;
 127      IF NATURAL_DEGREES_M15'LAST /= IDENT_INT (1) * 360.0 THEN
 128           FAILED ("NATURAL_DEGREES_M15'LAST /= 360.0");
 129      END IF;
 130
 131      -------------------------------------------------------------------
 132
 133      -- PI IS IN 3.0 + 2319 * 'SMALL .. 3.0 + 2320 * 'SMALL.
 134      IF SYMMETRIC_RADIANS_M16'FIRST NOT IN
 135         -3.14160_15625 .. -3.14154_05273_4375 THEN
 136           FAILED ("SYMMETRIC_RADIANS_M16'FIRST NOT IN " &
 137                   "-3.14160_15625 .. -3.14154_05273_4375");
 138      END IF;
 139      IF SYMMETRIC_RADIANS_M16'LAST  NOT IN
 140         3.14154_05273_4375 .. 3.14160_15625 THEN
 141           FAILED ("SYMMETRIC_RADIANS_M16'LAST NOT IN " &
 142                   "3.14154_05273_4375 .. 3.14160_15625");
 143      END IF;
 144
 145      -------------------------------------------------------------------
 146
 147      IF NATURAL_RADIANS_M8'FIRST /= IDENT_INT (1) * 0.0 THEN
 148           FAILED ("NATURAL_RADIANS_M8'FIRST /= 0.0");
 149      END IF;
 150      -- TWO_PI IS IN 201 * 'SMALL .. 202 * 'SMALL.
 151      IF NATURAL_RADIANS_M8'LAST  NOT IN 6.28125 .. 6.3125 THEN
 152           FAILED ("NATURAL_RADIANS_M8'LAST NOT IN 6.28125 .. 6.3125");
 153      END IF;
 154
 155      -------------------------------------------------------------------
 156
 157      IF ST_MILES_M8'FIRST /= IDENT_INT (1) * 0.0 THEN
 158           FAILED ("ST_MILES_M8'FIRST /= 0.0");
 159      END IF;
 160      IF ST_MILES_M8'LAST /= IDENT_INT (1) * 10.0 THEN
 161           FAILED ("ST_MILES_M8'LAST /= 10.0");
 162      END IF;
 163
 164      -------------------------------------------------------------------
 165
 166      IF ST_NATURAL_DEGREES_M11'FIRST /= IDENT_INT (1) * 0.0 THEN
 167           FAILED ("ST_NATURAL_DEGREES_M11'FIRST /= 0.0");
 168      END IF;
 169      IF ST_NATURAL_DEGREES_M11'LAST /= IDENT_INT (1) * 360.0 THEN
 170           FAILED ("ST_NATURAL_DEGREES_M11'LAST /= 360.0");
 171      END IF;
 172
 173      -------------------------------------------------------------------
 174
 175      -- HALF_PI IS IN 201 * 'SMALL .. 202 * 'SMALL.
 176      IF ST_SYMMETRIC_RADIANS_M8'FIRST NOT IN
 177         -1.57812_5 .. -1.57031_25 THEN
 178           FAILED ("ST_SYMMETRIC_RADIANS_M8'FIRST NOT IN " &
 179                   "-1.57812_5 .. -1.57031_25");
 180      END IF;
 181      IF ST_SYMMETRIC_RADIANS_M8'LAST  NOT IN
 182         1.57031_25 .. 1.57812_5 THEN
 183           FAILED ("ST_SYMMETRIC_RADIANS_M8'LAST NOT IN " &
 184                   "1.57031_25 .. 1.57812_5");
 185      END IF;
 186
 187      -------------------------------------------------------------------
 188
 189      RESULT;
 190
 191 END C35A07D;