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

   1 --C37404A.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 --     CHECK THAT 'CONSTRAINED IS TRUE FOR VARIABLES DECLARED WITH A
  27 --     CONSTRAINED TYPE, FOR CONSTANT OBJECTS (EVEN IF NOT DECLARED
  28 --     WITH A CONSTRAINED TYPE), AND DESIGNATED OBJECTS.
  29
  30 -- HISTORY:
  31 --     DHH 02/25/88 CREATED ORIGINAL TEST.
  32
  33 WITH REPORT; USE REPORT;
  34 PROCEDURE C37404A IS
  35
  36      SUBTYPE INT IS INTEGER RANGE 1 .. 10;
  37      TYPE REC(A : INT) IS
  38           RECORD
  39                I : INT;
  40      END RECORD;
  41
  42      TYPE ACC_REC IS ACCESS REC(4);
  43      TYPE ACC_REC1 IS ACCESS REC;
  44      SUBTYPE REC4 IS REC(4);
  45      SUBTYPE REC5 IS REC;
  46
  47      TYPE REC_DEF(A : INT := 5) IS
  48           RECORD
  49                I : INT := 1;
  50      END RECORD;
  51
  52      TYPE ACC_DEF IS ACCESS REC_DEF(4);
  53      TYPE ACC_DEF1 IS ACCESS REC_DEF;
  54      SUBTYPE REC6 IS REC_DEF(6);
  55      SUBTYPE REC7 IS REC_DEF;
  56
  57      A : REC4 := (A => 4, I => 1);                    -- CONSTRAINED.
  58      B : REC5(4) := (A => 4, I => 1);                 -- CONSTRAINED.
  59      C : REC6;                                        -- CONSTRAINED.
  60      D : REC7(6);                                     -- CONSTRAINED.
  61      E : ACC_REC1(4);                                 -- CONSTRAINED.
  62      F : ACC_DEF1(4);                                 -- CONSTRAINED.
  63      G : ACC_REC1;                                    -- UNCONSTRAINED.
  64      H : ACC_DEF1;                                    -- UNCONSTRAINED.
  65
  66      R : REC(5) := (A => 5, I => 1);                  -- CONSTRAINED.
  67      T : REC_DEF(5);                                  -- CONSTRAINED.
  68      U : ACC_REC;                                     -- CONSTRAINED.
  69      V : ACC_DEF;                                     -- CONSTRAINED.
  70      W : CONSTANT REC(5) := (A => 5, I => 1);         -- CONSTANT.
  71      X : CONSTANT REC := (A => 5, I => 1);            -- CONSTANT.
  72      Y : CONSTANT REC_DEF(5) := (A => 5, I => 1);     -- CONSTANT.
  73      Z : CONSTANT REC_DEF := (A => 5, I => 1);        -- CONSTANT.
  74
  75 BEGIN
  76      TEST("C37404A", "CHECK THAT 'CONSTRAINED IS TRUE FOR VARIABLES " &
  77                      "DECLARED WITH A  CONSTRAINED TYPE, FOR " &
  78                      "CONSTANT OBJECTS (EVEN IF NOT DECLARED WITH A " &
  79                      "CONSTRAINED TYPE), AND DESIGNATED OBJECTS");
  80
  81      U := NEW REC(4);
  82      V := NEW REC_DEF(4);
  83      E := NEW REC(4);
  84      F := NEW REC_DEF(4);
  85      G := NEW REC(4);                                 -- CONSTRAINED.
  86      H := NEW REC_DEF(4);                             -- CONSTRAINED.
  87
  88      IF NOT A'CONSTRAINED THEN
  89           FAILED("'CONSTRAINED NOT TRUE FOR SUBTYPE1");
  90      END IF;
  91
  92      IF NOT B'CONSTRAINED THEN
  93           FAILED("'CONSTRAINED NOT TRUE FOR SUBTYPE2");
  94      END IF;
  95
  96      IF NOT C'CONSTRAINED THEN
  97           FAILED("'CONSTRAINED NOT TRUE FOR DEFAULT SUBTYPE1");
  98      END IF;
  99
 100      IF NOT D'CONSTRAINED THEN
 101           FAILED("'CONSTRAINED NOT TRUE FOR DEFAULT SUBTYPE2");
 102      END IF;
 103
 104      IF NOT R'CONSTRAINED THEN
 105           FAILED("'CONSTRAINED NOT TRUE FOR RECORD COMPONENT");
 106      END IF;
 107
 108      IF NOT T'CONSTRAINED THEN
 109           FAILED("'CONSTRAINED NOT TRUE FOR DEFAULT VARIABLE");
 110      END IF;
 111
 112      IF NOT E.ALL'CONSTRAINED THEN
 113           FAILED("'CONSTRAINED NOT TRUE FOR ACCESS 1");
 114      END IF;
 115
 116      IF NOT F.ALL'CONSTRAINED THEN
 117           FAILED("'CONSTRAINED NOT TRUE FOR DEFAULT ACCESS 1");
 118      END IF;
 119
 120      IF NOT G.ALL'CONSTRAINED THEN
 121           FAILED("'CONSTRAINED NOT TRUE FOR ACCESS 2");
 122      END IF;
 123
 124      IF NOT H.ALL'CONSTRAINED THEN
 125           FAILED("'CONSTRAINED NOT TRUE FOR DEFAULT ACCESS 2");
 126      END IF;
 127
 128      IF NOT U.ALL'CONSTRAINED THEN
 129           FAILED("'CONSTRAINED NOT TRUE FOR ACCESS 3");
 130      END IF;
 131
 132      IF NOT V.ALL'CONSTRAINED THEN
 133           FAILED("'CONSTRAINED NOT TRUE FOR DEFAULT ACCESS 3");
 134      END IF;
 135
 136      IF NOT W'CONSTRAINED THEN
 137           FAILED("'CONSTRAINED NOT TRUE FOR CONSTANT, CONSTRAINED");
 138      END IF;
 139
 140      IF NOT X'CONSTRAINED THEN
 141           FAILED("'CONSTRAINED NOT TRUE FOR CONSTANT, UNCONSTRAINED");
 142      END IF;
 143
 144      IF NOT Y'CONSTRAINED THEN
 145           FAILED("'CONSTRAINED NOT TRUE FOR DEFAULT CONSTANT, " &
 146                  "CONSTRAINED");
 147      END IF;
 148
 149      IF NOT Z'CONSTRAINED THEN
 150           FAILED("'CONSTRAINED NOT TRUE FOR DEFAULT CONSTANT, " &
 151                  "UNCONSTRAINED");
 152      END IF;
 153
 154      IF IDENT_INT(T.I) /= 1 OR
 155         IDENT_INT(C.I) /= 1 OR
 156         IDENT_INT(D.I) /= 1 OR
 157         IDENT_INT(W.A) /= 5 OR
 158         IDENT_INT(X.A) /= 5 OR
 159         IDENT_INT(Y.A) /= 5 OR
 160         IDENT_INT(Z.I) /= 1 OR
 161         IDENT_INT(A.I) /= 1 OR
 162         IDENT_INT(B.I) /= 1 OR
 163         IDENT_BOOL(R.I /= 1) THEN
 164              FAILED("INCORRECT INITIALIZATION VALUES");
 165      END IF;
 166
 167      RESULT;
 168 END C37404A;