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

   1 -- C35A05Q.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 FORE AND AFT ATTRIBUTES YIELD
  26 -- THE CORRECT VALUES.
  27
  28 -- CASE Q: TYPES TYPICAL OF APPLICATIONS USING FIXED POINT ARITHMETIC,
  29 --         FOR GENERICS.
  30
  31 -- WRG 8/20/86
  32
  33 WITH REPORT; USE REPORT;
  34 WITH SYSTEM; USE SYSTEM;
  35 PROCEDURE C35A05Q 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 := 23;
  42
  43      -- THE NAME OF EACH TYPE OR SUBTYPE ENDS WITH THAT TYPE'S
  44      -- 'MANTISSA VALUE.
  45
  46      TYPE MICRO_ANGLE_ERROR_M15  IS
  47           DELTA 16.0  RANGE -(2.0 ** 19) .. 2.0 ** 19;
  48      TYPE TRACK_RANGE_M15        IS
  49           DELTA 0.125 RANGE -(2.0 ** 12) .. 2.0 ** 12;
  50      TYPE SECONDS_MM             IS
  51           DELTA 2.0 ** (8 - MM) RANGE -(2.0 ** 8) .. 2.0 ** 8;
  52      TYPE RANGE_CELL_MM          IS
  53           DELTA 2.0 ** (-5)
  54           RANGE -(2.0 ** (MM - 5) ) .. 2.0 ** (MM - 5);
  55
  56      TYPE PIXEL_M10 IS DELTA 1.0 / 1024.0 RANGE 0.0 ..  1.0;
  57      TYPE RULER_M8  IS DELTA 1.0 / 16.0   RANGE 0.0 .. 12.0;
  58
  59      TYPE HOURS_M16 IS DELTA   24.0 * 2.0 ** (-15) RANGE 0.0 ..   24.0;
  60      TYPE MILES_M16 IS DELTA 3000.0 * 2.0 ** (-15) RANGE 0.0 .. 3000.0;
  61
  62      TYPE SYMMETRIC_DEGREES_M7  IS
  63           DELTA 2.0         RANGE -180.0 .. 180.0;
  64      TYPE NATURAL_DEGREES_M15   IS
  65           DELTA 2.0 ** (-6) RANGE    0.0 .. 360.0;
  66      TYPE SYMMETRIC_RADIANS_M16 IS
  67           DELTA     PI * 2.0 ** (-15) RANGE -PI .. PI;
  68      TYPE NATURAL_RADIANS_M8    IS
  69           DELTA TWO_PI * 2.0 ** ( -7) RANGE 0.0 .. TWO_PI;
  70
  71      -------------------------------------------------------------------
  72
  73      SUBTYPE ST_MILES_M8             IS MILES_M16
  74           DELTA 3000.0 * 2.0 ** (-15) RANGE 0.0 .. 10.0;
  75      SUBTYPE ST_NATURAL_DEGREES_M11  IS NATURAL_DEGREES_M15
  76           DELTA 0.25 RANGE 0.0 .. 360.0;
  77      SUBTYPE ST_SYMMETRIC_RADIANS_M8 IS SYMMETRIC_RADIANS_M16
  78           DELTA HALF_PI * 2.0 ** (-7) RANGE -HALF_PI .. HALF_PI;
  79
  80      -------------------------------------------------------------------
  81
  82      TYPE FORE_AND_AFT IS
  83           RECORD
  84                FORE, AFT : INTEGER;
  85           END RECORD;
  86
  87      GENERIC
  88           TYPE T IS DELTA <>;
  89      FUNCTION ATTRIBUTES RETURN FORE_AND_AFT;
  90
  91      FUNCTION ATTRIBUTES RETURN FORE_AND_AFT IS
  92      BEGIN
  93           RETURN ( IDENT_INT (T'FORE), IDENT_INT (T'AFT) );
  94      END ATTRIBUTES;
  95
  96      -------------------------------------------------------------------
  97
  98      PROCEDURE CHECK_ATTRIBUTES
  99          (NAME : STRING;
 100           ACTUAL_ATTRIBUTES, CORRECT_ATTRIBUTES : FORE_AND_AFT) IS
 101      BEGIN
 102           IF ACTUAL_ATTRIBUTES.FORE /= CORRECT_ATTRIBUTES.FORE THEN
 103                FAILED ("GENERIC 'FORE FOR " & NAME & " =" &
 104                        INTEGER'IMAGE(ACTUAL_ATTRIBUTES.FORE) );
 105           END IF;
 106           IF ACTUAL_ATTRIBUTES.AFT  /= CORRECT_ATTRIBUTES.AFT  THEN
 107                FAILED ("GENERIC 'AFT  FOR " & NAME & " =" &
 108                        INTEGER'IMAGE(ACTUAL_ATTRIBUTES.AFT ) );
 109           END IF;
 110      END CHECK_ATTRIBUTES;
 111
 112      -------------------------------------------------------------------
 113
 114      FUNCTION FA_MICRO_ANGLE_ERROR_M15
 115                              IS NEW ATTRIBUTES(MICRO_ANGLE_ERROR_M15  );
 116      FUNCTION FA_TRACK_RANGE_M15
 117                              IS NEW ATTRIBUTES(TRACK_RANGE_M15        );
 118      FUNCTION FA_SECONDS_MM  IS NEW ATTRIBUTES(SECONDS_MM             );
 119      FUNCTION FA_RANGE_CELL_MM
 120                              IS NEW ATTRIBUTES(RANGE_CELL_MM          );
 121      FUNCTION FA_PIXEL_M10   IS NEW ATTRIBUTES(PIXEL_M10              );
 122      FUNCTION FA_RULER_M8    IS NEW ATTRIBUTES(RULER_M8               );
 123      FUNCTION FA_HOURS_M16   IS NEW ATTRIBUTES(HOURS_M16              );
 124      FUNCTION FA_MILES_M16   IS NEW ATTRIBUTES(MILES_M16              );
 125      FUNCTION FA_SYMMETRIC_DEGREES_M7
 126                              IS NEW ATTRIBUTES(SYMMETRIC_DEGREES_M7   );
 127      FUNCTION FA_NATURAL_DEGREES_M15
 128                              IS NEW ATTRIBUTES(NATURAL_DEGREES_M15    );
 129      FUNCTION FA_SYMMETRIC_RADIANS_M16
 130                              IS NEW ATTRIBUTES(SYMMETRIC_RADIANS_M16  );
 131      FUNCTION FA_NATURAL_RADIANS_M8
 132                              IS NEW ATTRIBUTES(NATURAL_RADIANS_M8     );
 133      FUNCTION FA_ST_MILES_M8 IS NEW ATTRIBUTES(ST_MILES_M8            );
 134      FUNCTION FA_ST_NATURAL_DEGREES_M11
 135                              IS NEW ATTRIBUTES(ST_NATURAL_DEGREES_M11 );
 136      FUNCTION FA_ST_SYMMETRIC_RADIANS_M8
 137                              IS NEW ATTRIBUTES(ST_SYMMETRIC_RADIANS_M8);
 138
 139 BEGIN
 140
 141      TEST ("C35A05Q", "CHECK THAT FOR FIXED POINT TYPES THE FORE AND " &
 142                       "AFT ATTRIBUTES YIELD THE CORRECT VALUES - " &
 143                       "TYPICAL TYPES, GENERICS");
 144
 145      CHECK_ATTRIBUTES ("MICRO_ANGLE_ERROR_M15",
 146                                     FA_MICRO_ANGLE_ERROR_M15, (7, 1) );
 147
 148      CHECK_ATTRIBUTES ("TRACK_RANGE_M15", FA_TRACK_RANGE_M15, (5, 1) );
 149
 150      CHECK_ATTRIBUTES ("SECONDS_MM", FA_SECONDS_MM, (4, 5) );
 151
 152      CHECK_ATTRIBUTES ("RANGE_CELL_MM", FA_RANGE_CELL_MM, (7, 2) );
 153
 154      CHECK_ATTRIBUTES ("PIXEL_M10", FA_PIXEL_M10, (2, 4) );
 155
 156      CHECK_ATTRIBUTES ("RULER_M8",  FA_RULER_M8, (3, 2) );
 157
 158      CHECK_ATTRIBUTES ("HOURS_M16", FA_HOURS_M16, (3, 4) );
 159
 160      CHECK_ATTRIBUTES ("MILES_M16", FA_MILES_M16, (5, 2) );
 161
 162      CHECK_ATTRIBUTES ("SYMMETRIC_DEGREES_M7",
 163                                     FA_SYMMETRIC_DEGREES_M7, (4, 1) );
 164
 165      CHECK_ATTRIBUTES ("NATURAL_DEGREES_M15",
 166                                     FA_NATURAL_DEGREES_M15, (4, 2) );
 167
 168      CHECK_ATTRIBUTES ("SYMMETRIC_RADIANS_M16",
 169                                     FA_SYMMETRIC_RADIANS_M16, (2, 5) );
 170
 171      CHECK_ATTRIBUTES ("NATURAL_RADIANS_M8",
 172                                     FA_NATURAL_RADIANS_M8, (2, 2) );
 173
 174      CHECK_ATTRIBUTES ("ST_MILES_M8", FA_ST_MILES_M8, (3, 2) );
 175
 176      CHECK_ATTRIBUTES ("ST_NATURAL_DEGREES_M11",
 177                                     FA_ST_NATURAL_DEGREES_M11, (4, 1) );
 178
 179      CHECK_ATTRIBUTES ("ST_SYMMETRIC_RADIANS_M8",
 180                                    FA_ST_SYMMETRIC_RADIANS_M8, (2, 2) );
 181
 182      RESULT;
 183
 184 END C35A05Q;