old-autovect-branch/gcc/testsuite/ada/acats/tests/cc/cc1221b.ada

   1 -- CC1221B.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 -- OBJECTIVE:
  26 --     FOR A FORMAL INTEGER TYPE, CHECK THAT THE FOLLOWING BASIC
  27 --     OPERATIONS ARE IMPLICITLY DECLARED AND ARE THEREFORE AVAILABLE
  28 --     WITHIN THE GENERIC UNIT:  ATTRIBUTES 'FIRST, 'LAST, 'WIDTH,
  29 --     'ADDRESS, AND 'SIZE.
  30
  31 -- HISTORY:
  32 --     BCB 11/12/87  CREATED ORIGINAL TEST FROM SPLIT OF CC1221A.ADA.
  33
  34 WITH SYSTEM; USE SYSTEM;
  35 WITH REPORT; USE REPORT;
  36 PROCEDURE CC1221B IS
  37
  38      SUBTYPE SUBINT IS INTEGER RANGE -100 .. 100;
  39      SUBTYPE NOINT IS INTEGER RANGE 1 .. -1;
  40      TYPE NEWINT IS NEW INTEGER;
  41      TYPE INT IS RANGE -300 .. 300;
  42      SUBTYPE SINT1 IS INT
  43           RANGE INT (IDENT_INT (-4)) .. INT (IDENT_INT (4));
  44      SUBTYPE SINT2 IS INT RANGE 16#E#E1 .. 2#1111_1111#;
  45      TYPE INT2 IS RANGE 0E8 .. 1E3;
  46
  47 BEGIN
  48      TEST ( "CC1221B", "FOR A FORMAL INTEGER TYPE, CHECK THAT THE " &
  49                        "FOLLOWING BASIC OPERATIONS ARE IMPLICITLY " &
  50                        "DECLARED AND ARE THEREFORE AVAILABLE " &
  51                        "WITHIN THE GENERIC UNIT:  ATTRIBUTES 'FIRST, " &
  52                        "'LAST, 'WIDTH, 'ADDRESS, AND 'SIZE");
  53
  54      DECLARE -- (B) CHECKS FOR BASIC OPERATIONS OF A DISCRETE TYPE.
  55              --     PART II.
  56
  57           GENERIC
  58                TYPE T IS RANGE <>;
  59                F, L : T;
  60                W : INTEGER;
  61           PROCEDURE P (STR : STRING);
  62
  63           PROCEDURE P (STR : STRING) IS
  64                I : INTEGER := F'SIZE;
  65                T1 : T;
  66                A : ADDRESS := T1'ADDRESS;
  67
  68           BEGIN
  69                IF T'FIRST /= F THEN
  70                     FAILED ( "INCORRECT VALUE FOR " & STR & "'FIRST" );
  71                END IF;
  72
  73                IF T'LAST /= L THEN
  74                     FAILED ( "INCORRECT VALUE FOR " & STR & "'LAST" );
  75                END IF;
  76
  77                IF T'BASE'FIRST > T'FIRST THEN
  78                     FAILED ( "INCORRECT RESULTS WITH " & STR &
  79                              "'BASE'FIRST" );
  80                END IF;
  81
  82                IF T'BASE'LAST < T'LAST THEN
  83                     FAILED ( "INCORRECT RESULTS WITH " & STR &
  84                              "'BASE'LAST" );
  85                END IF;
  86
  87                IF T'WIDTH /= W THEN
  88                     FAILED ( "INCORRECT VALUE FOR " & STR &
  89                              "'WIDTH" );
  90                END IF;
  91
  92                IF T'BASE'WIDTH < T'WIDTH THEN
  93                     FAILED ( "INCORRECT RESULTS WITH " & STR &
  94                              "'BASE'WIDTH" );
  95                END IF;
  96
  97           END P;
  98
  99           GENERIC
 100                TYPE T IS RANGE <>;
 101           PROCEDURE Q;
 102
 103           PROCEDURE Q IS
 104           BEGIN
 105                IF T'FIRST /= 1 THEN
 106                     FAILED ( "INCORRECT VALUE FOR NOINT'FIRST" );
 107                END IF;
 108
 109                IF T'LAST /= -1 THEN
 110                     FAILED ( "INCORRECT VALUE FOR NOINT'LAST" );
 111                END IF;
 112
 113                IF T'BASE'FIRST > T'FIRST THEN
 114                     FAILED ( "INCORRECT RESULTS WITH " &
 115                              "NOINT'BASE'FIRST" );
 116                END IF;
 117
 118                IF T'BASE'LAST < T'LAST THEN
 119                     FAILED ( "INCORRECT RESULTS WITH " &
 120                              "NOINT'BASE'LAST" );
 121                END IF;
 122
 123                IF T'WIDTH /= 0 THEN
 124                     FAILED ( "INCORRECT VALUE FOR " &
 125                              "NOINT'WIDTH" );
 126                END IF;
 127
 128                IF T'BASE'WIDTH < T'WIDTH THEN
 129                     FAILED ( "INCORRECT RESULTS WITH " &
 130                              "NOINT'BASE'WIDTH" );
 131                END IF;
 132
 133           END Q;
 134
 135           PROCEDURE P1 IS NEW P (INTEGER, INTEGER'FIRST, INTEGER'LAST,
 136                                  INTEGER'WIDTH);
 137           PROCEDURE P2 IS NEW P (SUBINT, -100, 100, 4);
 138           PROCEDURE P3 IS NEW P (NEWINT, NEWINT'FIRST, NEWINT'LAST,
 139                                  NEWINT'WIDTH);
 140           PROCEDURE P4 IS NEW P (SINT1, -4, 4, 2);
 141           PROCEDURE P5 IS NEW P (SINT2, 224, 255, 4);
 142           PROCEDURE P6 IS NEW P (INT2 , 0, 1000, 5);
 143
 144           PROCEDURE Q1 IS NEW Q (NOINT);
 145
 146      BEGIN
 147            P1 ( "INTEGER" );
 148            P2 ( "SUBINT" );
 149            P3 ( "NEWINT" );
 150            P4 ( "SINT1" );
 151            P5 ( "SINT2" );
 152            P6 ( "INT2" );
 153
 154            Q1;
 155
 156      END; -- (B).
 157
 158      RESULT;
 159 END CC1221B;