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

   1 -- C37010B.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 EXPRESSIONS IN AN INDEX CONSTRAINT OR DISCRIMINANT
  26 -- CONSTRAINT ARE EVALUATED WHEN THE COMPONENT DECLARATION IS
  27 -- ELABORATED EVEN IF SOME BOUNDS OR DISCRIMINANTS ARE GIVEN BY
  28 -- A DISCRIMINANT OF AN ENCLOSING RECORD TYPE.
  29
  30 -- R.WILLIAMS 8/22/86
  31
  32 WITH REPORT; USE REPORT;
  33 PROCEDURE C37010B IS
  34
  35      INIT :INTEGER := IDENT_INT (5);
  36
  37      TYPE R (D1, D2 : INTEGER) IS
  38           RECORD
  39                NULL;
  40           END RECORD;
  41
  42      TYPE ACCR IS ACCESS R;
  43
  44      TYPE ARR IS ARRAY (INTEGER RANGE <> ) OF INTEGER;
  45
  46      TYPE ACCA IS ACCESS ARR;
  47
  48      FUNCTION RESET (N : INTEGER) RETURN INTEGER IS
  49      BEGIN
  50           INIT := IDENT_INT (N);
  51           RETURN N;
  52      END RESET;
  53
  54 BEGIN
  55      TEST ( "C37010B", "CHECK THAT EXPRESSIONS IN AN INDEX " &
  56                        "CONSTRAINT OR DISCRIMINANT CONSTRAINT " &
  57                        "ARE EVALUATED WHEN THE COMPONENT " &
  58                        "DECLARATION IS ELABORATED EVEN IF SOME " &
  59                        "BOUNDS OR DISCRIMINANTS ARE GIVEN BY " &
  60                        "A DISCRIMINANT OF AN ENCLOSING RECORD TYPE" );
  61
  62      DECLARE
  63
  64           TYPE REC1 (D : INTEGER) IS
  65                RECORD
  66                     W1 : R (D1 => INIT, D2 => D);
  67                     X1 : ARR (INIT .. D);
  68                     Y1 : ACCR (D, INIT);
  69                     Z1 : ACCA (D .. INIT);
  70                END RECORD;
  71
  72           INT1 : INTEGER := RESET (10);
  73
  74           R1 : REC1 (D => 4);
  75
  76      BEGIN
  77           IF R1.W1.D1 /= 5 THEN
  78                FAILED ( "INCORRECT VALUE FOR R1.W1.D1" );
  79           END IF;
  80
  81           IF R1.W1.D2 /= 4 THEN
  82                FAILED ( "INCORRECT VALUE FOR R1.W1.D2" );
  83           END IF;
  84
  85           IF R1.X1'FIRST /= 5 THEN
  86                FAILED ( "INCORRECT VALUE FOR R1.X1'FIRST" );
  87           END IF;
  88
  89           IF R1.X1'LAST /= 4 THEN
  90                FAILED ( "INCORRECT VALUE FOR R1.X1'LAST" );
  91           END IF;
  92
  93           BEGIN
  94                R1.Y1 := NEW R (4, 5);
  95           EXCEPTION
  96                WHEN OTHERS =>
  97                     FAILED ( "INCORRECT VALUE FOR R1.Y1" );
  98           END;
  99
 100           BEGIN
 101                R1.Z1 := NEW ARR (4 .. 5);
 102           EXCEPTION
 103                WHEN OTHERS =>
 104                     FAILED ( "INCORRECT VALUE FOR R1.Z1" );
 105           END;
 106
 107      END;
 108
 109      DECLARE
 110
 111           TYPE REC2 (D : INTEGER) IS
 112                RECORD
 113                     CASE D IS
 114                          WHEN 1 =>
 115                               NULL;
 116                          WHEN 2 =>
 117                               NULL;
 118                          WHEN OTHERS =>
 119                               W2 : R (D1 => D, D2 => INIT);
 120                               X2 : ARR (D .. INIT);
 121                               Y2 : ACCR (INIT, D);
 122                               Z2 : ACCA (D .. INIT);
 123                     END CASE;
 124                END RECORD;
 125
 126           INT2 : INTEGER := RESET (20);
 127
 128           R2 : REC2 (D => 6);
 129
 130      BEGIN
 131           IF R2.W2.D1 /= 6 THEN
 132                FAILED ( "INCORRECT VALUE FOR R2.W2.D1" );
 133           END IF;
 134
 135           IF R2.W2.D2 /= 10 THEN
 136                FAILED ( "INCORRECT VALUE FOR R2.W2.D2" );
 137           END IF;
 138
 139           IF R2.X2'FIRST /= 6 THEN
 140                FAILED ( "INCORRECT VALUE FOR R2.X2'FIRST" );
 141           END IF;
 142
 143           IF R2.X2'LAST /= 10 THEN
 144                FAILED ( "INCORRECT VALUE FOR R2.X2'LAST" );
 145           END IF;
 146
 147           BEGIN
 148                R2.Y2 := NEW R (10, 6);
 149           EXCEPTION
 150                WHEN OTHERS =>
 151                     FAILED ( "INCORRECT VALUE FOR R2.Y2" );
 152           END;
 153
 154           BEGIN
 155                R2.Z2 := NEW ARR (6 .. 10);
 156           EXCEPTION
 157                WHEN OTHERS =>
 158                     FAILED ( "INCORRECT VALUE FOR R2.Z2" );
 159           END;
 160
 161      END;
 162
 163      RESULT;
 164 END C37010B;