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

   1 -- C37102B.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 A RECORD TYPE, THE IDENTIFIER FOR A DISCRIMINANT
  26 -- CAN BE USED AS A SELECTED COMPONENT IN AN INDEX OR DISCRIMINANT
  27 -- CONSTRAINT, AS THE NAME OF A DISCRIMINANT IN A DISCRIMINANT
  28 -- SPECIFICATION, AND AS THE PARAMETER NAME IN A FUNCTION CALL IN A
  29 -- DISCRIMINANT OR INDEX CONSTRAINT.
  30
  31 -- R.WILLIAMS 8/25/86
  32
  33 WITH REPORT; USE REPORT;
  34 PROCEDURE C37102B IS
  35
  36 BEGIN
  37      TEST ( "C37102B", "CHECK THAT, FOR A RECORD TYPE, THE " &
  38                        "IDENTIFIER FOR A DISCRIMINANT CAN BE USED " &
  39                        "AS A SELECTED COMPONENT IN AN INDEX OR " &
  40                        "DISCRIMINANT CONSTRAINT, AS THE NAME OF A " &
  41                        "DISCRIMINANT IN A DISCRIMINANT " &
  42                        "SPECIFICATION, AND AS THE PARAMETER NAME " &
  43                        "IN A FUNCTION CALL IN A DISCRIMINANT OR " &
  44                        "INDEX CONSTRAINT" );
  45
  46      DECLARE
  47
  48           FUNCTION F (D : INTEGER) RETURN INTEGER IS
  49           BEGIN
  50                RETURN IDENT_INT (D);
  51           END F;
  52
  53           PACKAGE P IS
  54
  55                TYPE D IS NEW INTEGER;
  56
  57                TYPE REC1 IS
  58                     RECORD
  59                          D : INTEGER := IDENT_INT (1);
  60                     END RECORD;
  61
  62                G : REC1;
  63
  64                TYPE REC2 (D : INTEGER := 3) IS
  65                     RECORD
  66                          NULL;
  67                     END RECORD;
  68
  69                H : REC2 (IDENT_INT (5));
  70
  71                TYPE ARR IS ARRAY (INTEGER RANGE <>) OF INTEGER;
  72
  73                TYPE Q (D : INTEGER := 0) IS
  74                     RECORD
  75                          J : REC2 (D => H.D);
  76                          K : ARR (G.D .. F (D => 5));
  77                          L : REC2 (F (D => 4));
  78                     END RECORD;
  79
  80           END P;
  81
  82           USE P;
  83
  84      BEGIN
  85           DECLARE
  86                R : Q;
  87
  88           BEGIN
  89                IF R.J.D /= 5 THEN
  90                     FAILED ( "INCORRECT VALUE FOR R.J" );
  91                END IF;
  92
  93                IF R.K'FIRST /= 1 THEN
  94                     FAILED ( "INCORRECT VALUE FOR R.K'FIRST" );
  95                END IF;
  96
  97                IF R.K'LAST /= 5 THEN
  98                     FAILED ( "INCORRECT VALUE FOR R.K'LAST" );
  99                END IF;
 100
 101                IF R.L.D /= 4 THEN
 102                     FAILED ( "INCORRECT VALUE FOR R.L" );
 103                END IF;
 104           END;
 105
 106      END;
 107
 108      RESULT;
 109 END C37102B;