old-autovect-branch/gcc/testsuite/ada/acats/tests/c3/c35a05n.ada

   1 -- C35A05N.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 N: BASIC TYPES THAT FIT THE CHARACTERISTICS OF DURATION'BASE,
  29 --         FOR GENERICS.
  30
  31 -- WRG 8/15/86
  32
  33 WITH REPORT; USE REPORT;
  34 PROCEDURE C35A05N IS
  35
  36      -- THE NAME OF EACH TYPE OR SUBTYPE ENDS WITH THAT TYPE'S
  37      -- 'MANTISSA VALUE.
  38
  39      TYPE LEFT_OUT_M1       IS DELTA 0.25  RANGE -0.5 .. 0.5;
  40      TYPE LEFT_EDGE_M1      IS DELTA 0.5   RANGE -1.0 .. 1.0;
  41      TYPE RIGHT_EDGE_M1     IS DELTA 1.0   RANGE -2.0 .. 2.0;
  42      TYPE RIGHT_OUT_M1      IS DELTA 2.0   RANGE -4.0 .. 4.0;
  43      TYPE MIDDLE_M2         IS DELTA 0.5   RANGE -2.0 .. 2.0;
  44      TYPE MIDDLE_M3         IS DELTA 0.5   RANGE  0.0 .. 2.5;
  45      TYPE MIDDLE_M15        IS DELTA 2.0 **(-6) RANGE  -512.0 ..  512.0;
  46      TYPE MIDDLE_M16        IS DELTA 2.0 **(-6) RANGE -1024.0 .. 1024.0;
  47      TYPE LIKE_DURATION_M23 IS DELTA 0.020 RANGE -86_400.0 .. 86_400.0;
  48      TYPE DECIMAL_M18       IS DELTA 0.1   RANGE -10_000.0 .. 10_000.0;
  49      TYPE DECIMAL_M4        IS DELTA 100.0 RANGE   -1000.0 ..   1000.0;
  50      TYPE DECIMAL_M11       IS DELTA 0.09999 RANGE  -100.0 ..    100.0;
  51      TYPE DECIMAL2_M18      IS DELTA 0.1   RANGE   -9999.0 ..   9999.0;
  52
  53      -------------------------------------------------------------------
  54
  55      SUBTYPE ST_LEFT_EDGE_M6 IS MIDDLE_M15
  56           DELTA 2.0 ** (-6) RANGE IDENT_INT (1) * (-1.0) .. 1.0;
  57      SUBTYPE ST_MIDDLE_M14   IS MIDDLE_M16
  58           DELTA 2.0 ** (-5) RANGE -512.0 .. IDENT_INT (1) * 512.0;
  59      SUBTYPE ST_MIDDLE_M2    IS LIKE_DURATION_M23
  60           DELTA 0.5 RANGE -2.0 .. 2.0;
  61      SUBTYPE ST_MIDDLE_M3    IS LIKE_DURATION_M23
  62           DELTA 0.5 RANGE  0.0 .. 2.5;
  63      SUBTYPE ST_DECIMAL_M7   IS DECIMAL_M18
  64           DELTA  10.0 RANGE -1000.0 .. 1000.0;
  65      SUBTYPE ST_DECIMAL_M3   IS DECIMAL_M4
  66           DELTA 100.0 RANGE  -500.0 ..  500.0;
  67
  68      -------------------------------------------------------------------
  69
  70      TYPE FORE_AND_AFT IS
  71           RECORD
  72                FORE, AFT : INTEGER;
  73           END RECORD;
  74
  75      GENERIC
  76           TYPE T IS DELTA <>;
  77      FUNCTION ATTRIBUTES RETURN FORE_AND_AFT;
  78
  79      FUNCTION ATTRIBUTES RETURN FORE_AND_AFT IS
  80      BEGIN
  81           RETURN ( IDENT_INT (T'FORE), IDENT_INT (T'AFT) );
  82      END ATTRIBUTES;
  83
  84      -------------------------------------------------------------------
  85
  86      PROCEDURE CHECK_ATTRIBUTES
  87          (NAME : STRING;
  88           ACTUAL_ATTRIBUTES, CORRECT_ATTRIBUTES : FORE_AND_AFT) IS
  89      BEGIN
  90           IF ACTUAL_ATTRIBUTES.FORE /= CORRECT_ATTRIBUTES.FORE THEN
  91                FAILED ("GENERIC 'FORE FOR " & NAME & " =" &
  92                        INTEGER'IMAGE(ACTUAL_ATTRIBUTES.FORE) );
  93           END IF;
  94           IF ACTUAL_ATTRIBUTES.AFT  /= CORRECT_ATTRIBUTES.AFT  THEN
  95                FAILED ("GENERIC 'AFT  FOR " & NAME & " =" &
  96                        INTEGER'IMAGE(ACTUAL_ATTRIBUTES.AFT ) );
  97           END IF;
  98      END CHECK_ATTRIBUTES;
  99
 100      -------------------------------------------------------------------
 101
 102      FUNCTION FA_LEFT_OUT_M1       IS NEW ATTRIBUTES(LEFT_OUT_M1      );
 103      FUNCTION FA_LEFT_EDGE_M1      IS NEW ATTRIBUTES(LEFT_EDGE_M1     );
 104      FUNCTION FA_RIGHT_EDGE_M1     IS NEW ATTRIBUTES(RIGHT_EDGE_M1    );
 105      FUNCTION FA_RIGHT_OUT_M1      IS NEW ATTRIBUTES(RIGHT_OUT_M1     );
 106      FUNCTION FA_MIDDLE_M2         IS NEW ATTRIBUTES(MIDDLE_M2        );
 107      FUNCTION FA_MIDDLE_M3         IS NEW ATTRIBUTES(MIDDLE_M3        );
 108      FUNCTION FA_MIDDLE_M15        IS NEW ATTRIBUTES(MIDDLE_M15       );
 109      FUNCTION FA_MIDDLE_M16        IS NEW ATTRIBUTES(MIDDLE_M16       );
 110      FUNCTION FA_LIKE_DURATION_M23 IS NEW ATTRIBUTES(LIKE_DURATION_M23);
 111      FUNCTION FA_DECIMAL_M18       IS NEW ATTRIBUTES(DECIMAL_M18      );
 112      FUNCTION FA_DECIMAL_M4        IS NEW ATTRIBUTES(DECIMAL_M4       );
 113      FUNCTION FA_DECIMAL_M11       IS NEW ATTRIBUTES(DECIMAL_M11      );
 114      FUNCTION FA_DECIMAL2_M18      IS NEW ATTRIBUTES(DECIMAL2_M18     );
 115      FUNCTION FA_ST_LEFT_EDGE_M6   IS NEW ATTRIBUTES(ST_LEFT_EDGE_M6  );
 116      FUNCTION FA_ST_MIDDLE_M14     IS NEW ATTRIBUTES(ST_MIDDLE_M14    );
 117      FUNCTION FA_ST_MIDDLE_M2      IS NEW ATTRIBUTES(ST_MIDDLE_M2     );
 118      FUNCTION FA_ST_MIDDLE_M3      IS NEW ATTRIBUTES(ST_MIDDLE_M3     );
 119      FUNCTION FA_ST_DECIMAL_M7     IS NEW ATTRIBUTES(ST_DECIMAL_M7    );
 120      FUNCTION FA_ST_DECIMAL_M3     IS NEW ATTRIBUTES(ST_DECIMAL_M3    );
 121
 122 BEGIN
 123
 124      TEST ("C35A05N", "CHECK THAT FOR FIXED POINT TYPES THE FORE AND " &
 125                       "AFT ATTRIBUTES YIELD THE CORRECT VALUES - " &
 126                       "BASIC TYPES, GENERICS");
 127
 128      CHECK_ATTRIBUTES ("LEFT_OUT_M1",     FA_LEFT_OUT_M1,     (2, 1) );
 129      CHECK_ATTRIBUTES ("LEFT_EDGE_M1",    FA_LEFT_EDGE_M1,    (2, 1) );
 130      CHECK_ATTRIBUTES ("RIGHT_EDGE_M1",   FA_RIGHT_EDGE_M1,   (2, 1) );
 131      CHECK_ATTRIBUTES ("RIGHT_OUT_M1",    FA_RIGHT_OUT_M1,    (2, 1) );
 132      CHECK_ATTRIBUTES ("MIDDLE_M2",       FA_MIDDLE_M2,       (2, 1) );
 133      CHECK_ATTRIBUTES ("MIDDLE_M3",       FA_MIDDLE_M3,       (2, 1) );
 134      CHECK_ATTRIBUTES ("MIDDLE_M15",      FA_MIDDLE_M15,      (4, 2) );
 135      CHECK_ATTRIBUTES ("MIDDLE_M16",      FA_MIDDLE_M16,      (5, 2) );
 136      CHECK_ATTRIBUTES ("LIKE_DURATION_M23",
 137                                         FA_LIKE_DURATION_M23, (6, 2) );
 138      CHECK_ATTRIBUTES ("DECIMAL_M18",     FA_DECIMAL_M18,     (6, 1) );
 139
 140      IF FA_DECIMAL_M4.FORE /= 5 AND FA_DECIMAL_M4.FORE /= 4 THEN
 141           FAILED ("GENERIC 'FORE FOR DECIMAL_M4 =" &
 142                   INTEGER'IMAGE(FA_DECIMAL_M4.FORE) );
 143      END IF;
 144      IF FA_DECIMAL_M4.AFT /= 1 THEN
 145           FAILED ("GENERIC 'AFT  FOR DECIMAL_M4 =" &
 146                   INTEGER'IMAGE(FA_DECIMAL_M4.AFT) );
 147      END IF;
 148
 149      CHECK_ATTRIBUTES ("DECIMAL_M11",     FA_DECIMAL_M11,     (4, 2) );
 150      CHECK_ATTRIBUTES ("DECIMAL2_M18",    FA_DECIMAL2_M18,    (5, 1) );
 151      CHECK_ATTRIBUTES ("ST_LEFT_EDGE_M6", FA_ST_LEFT_EDGE_M6, (2, 2) );
 152      CHECK_ATTRIBUTES ("ST_MIDDLE_M14",   FA_ST_MIDDLE_M14,   (4, 2) );
 153      CHECK_ATTRIBUTES ("ST_MIDDLE_M2",    FA_ST_MIDDLE_M2,    (2, 1) );
 154      CHECK_ATTRIBUTES ("ST_MIDDLE_M3",    FA_ST_MIDDLE_M3,    (2, 1) );
 155      CHECK_ATTRIBUTES ("ST_DECIMAL_M7",   FA_ST_DECIMAL_M7,   (5, 1) );
 156      CHECK_ATTRIBUTES ("ST_DECIMAL_M3",   FA_ST_DECIMAL_M3,   (4, 1) );
 157
 158      RESULT;
 159
 160 END C35A05N;