old-autovect-branch/gcc/testsuite/ada/acats/tests/c5/c54a13b.ada

   1 -- C54A13B.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 IF A CASE EXPRESSION IS A GENERIC "IN" OR "IN OUT"
  27 --     PARAMETER WITH A NON-STATIC SUBTYPE OR ONE OF THESE IN
  28 --     PARENTHESES, THEN ANY VALUE OF THE EXPRESSION'S BASE TYPE MAY
  29 --     APPEAR AS A CHOICE.
  30
  31 -- HISTORY:
  32 --     BCB 07/13/88  CREATED ORIGINAL TEST.
  33
  34 WITH REPORT; USE REPORT;
  35
  36 PROCEDURE C54A13B IS
  37
  38      L : INTEGER := IDENT_INT(1);
  39      R : INTEGER := IDENT_INT(100);
  40
  41      SUBTYPE INT IS INTEGER RANGE L .. R;
  42
  43      GENERIC
  44           IN_PAR : IN INT;
  45           IN_OUT_PAR : IN OUT INT;
  46      PROCEDURE GEN_PROC (I : IN OUT INTEGER);
  47
  48      IN_VAR : INT := IDENT_INT (10);
  49      IN_OUT_VAR : INT := IDENT_INT (100);
  50      CHECK_VAR : INT := IDENT_INT (1);
  51
  52      PROCEDURE GEN_PROC (I : IN OUT INTEGER) IS
  53      BEGIN
  54           CASE IN_PAR IS
  55                WHEN 0 => I := I + IDENT_INT (2);
  56                WHEN 10 => I := I + IDENT_INT (1);
  57                WHEN -3000 => I := I + IDENT_INT (3);
  58                WHEN OTHERS => I := I + IDENT_INT (4);
  59           END CASE;
  60
  61           CASE IN_OUT_PAR IS
  62                WHEN 0 => IN_OUT_PAR := IDENT_INT (0);
  63                WHEN 100 => IN_OUT_PAR := IDENT_INT (50);
  64                WHEN -3000 => IN_OUT_PAR := IDENT_INT (-3000);
  65                WHEN OTHERS => IN_OUT_PAR := IDENT_INT (5);
  66           END CASE;
  67
  68           CASE (IN_PAR) IS
  69                WHEN 0 => I := I + IDENT_INT (2);
  70                WHEN 10 => I := I + IDENT_INT (1);
  71                WHEN -3000 => I := I + IDENT_INT (3);
  72                WHEN OTHERS => I := I + IDENT_INT (4);
  73           END CASE;
  74
  75           CASE (IN_OUT_PAR) IS
  76                WHEN 0 => IN_OUT_PAR := IDENT_INT (200);
  77                WHEN 50 => IN_OUT_PAR := IDENT_INT (25);
  78                WHEN -3000 => IN_OUT_PAR := IDENT_INT (300);
  79                WHEN OTHERS => IN_OUT_PAR := IDENT_INT (400);
  80           END CASE;
  81
  82      END GEN_PROC;
  83
  84      PROCEDURE P IS NEW GEN_PROC (IN_VAR, IN_OUT_VAR);
  85
  86 BEGIN
  87      TEST ("C54A13B", "CHECK THAT IF A CASE EXPRESSION IS A " &
  88                       "GENERIC 'IN' OR 'IN OUT' PARAMETER WITH A " &
  89                       "NON-STATIC SUBTYPE OR ONE OF " &
  90                       "THESE IN PARENTHESES, THEN ANY VALUE OF " &
  91                       "THE EXPRESSION'S BASE TYPE MAY APPEAR AS " &
  92                       "A CHOICE");
  93
  94      P (CHECK_VAR);
  95
  96      IF NOT EQUAL (CHECK_VAR, IDENT_INT(3)) THEN
  97           FAILED ("INCORRECT CHOICES MADE FOR IN PARAMETER IN CASE");
  98      END IF;
  99
 100      IF NOT EQUAL (IN_OUT_VAR, IDENT_INT(25)) THEN
 101           FAILED ("INCORRECT CHOICESMADE FOR IN OUT PARAMETER IN CASE");
 102      END IF;
 103
 104      RESULT;
 105 END C54A13B;