gcc/testsuite/ada/acats/tests/c5/c54a13d.ada

   1 -- C54A13D.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 FUNCTION INVOCATION,
  27 --     ATTRIBUTE, STATIC EXPRESSION, OR ONE OF THESE IN PARENTHESES,
  28 --     THEN ANY VALUE OF THE EXPRESSION'S BASE TYPE MAY APPEAR AS A
  29 --     CHOICE.
  30
  31 -- HISTORY:
  32 --     BCB 07/19/88  CREATED ORIGINAL TEST.
  33 --     PWN 02/02/95  REMOVED INCONSISTENCIES WITH ADA 9X.
  34 --     GJD 11/15/95  REMOVED ADA 95 INCOMPATIBLE ALTERNATIVE IN FIRST CASE.
  35
  36 WITH REPORT; USE REPORT;
  37
  38 PROCEDURE C54A13D IS
  39
  40      SUBTYPE INT IS INTEGER RANGE -100 .. 100;
  41
  42      CONS : CONSTANT INT := 0;
  43
  44      C : INT;
  45
  46      TYPE ENUM IS (ONE, TWO, THREE, FOUR, FIVE, SIX);
  47
  48      SUBTYPE SUBENUM IS ENUM RANGE THREE .. FOUR;
  49
  50      FUNCTION FUNC RETURN INT IS
  51      BEGIN
  52           RETURN 0;
  53      END FUNC;
  54
  55 BEGIN
  56      TEST ("C54A13D", "CHECK THAT IF A CASE EXPRESSION IS A FUNCTION " &
  57                       "INVOCATION, ATTRIBUTE, STATIC EXPRESSION, OR " &
  58                       "ONE OF THESE IN PARENTHESES, THEN ANY VALUE " &
  59                       "OF THE EXPRESSION'S BASE TYPE MAY APPEAR AS " &
  60                       "A CHOICE");
  61
  62      CASE FUNC IS
  63           WHEN 0 => C := IDENT_INT (5);
  64           WHEN 100 => C := IDENT_INT (10);
  65           WHEN OTHERS => C := IDENT_INT (20);
  66      END CASE;
  67
  68      IF NOT EQUAL (C,5) THEN
  69           FAILED ("IMPROPER CHOICE FOR CASE EXPRESSION WHICH IS A " &
  70                   "FUNCTION INVOCATION - 1");
  71      END IF;
  72
  73      CASE (FUNC) IS
  74           WHEN 0 => C := IDENT_INT (25);
  75           WHEN 100 => C := IDENT_INT (50);
  76           WHEN -3000 => C := IDENT_INT (75);
  77           WHEN OTHERS => C := IDENT_INT (90);
  78      END CASE;
  79
  80      IF NOT EQUAL (C,25) THEN
  81           FAILED ("IMPROPER CHOICE FOR CASE EXPRESSION WHICH IS A " &
  82                   "FUNCTION INVOCATION - 2");
  83      END IF;
  84
  85      CASE SUBENUM'FIRST IS
  86           WHEN ONE => C := IDENT_INT (100);
  87           WHEN TWO => C := IDENT_INT (99);
  88           WHEN THREE => C := IDENT_INT (98);
  89           WHEN FOUR => C := IDENT_INT (97);
  90           WHEN FIVE => C := IDENT_INT (96);
  91           WHEN SIX => C := IDENT_INT (95);
  92      END CASE;
  93
  94      IF NOT EQUAL (C,98) THEN
  95           FAILED ("IMPROPER CHOICE FOR CASE EXPRESSION WHICH IS AN " &
  96                   "ATTRIBUTE - 1");
  97      END IF;
  98
  99      CASE (SUBENUM'FIRST) IS
 100           WHEN ONE => C := IDENT_INT (90);
 101           WHEN TWO => C := IDENT_INT (89);
 102           WHEN THREE => C := IDENT_INT (88);
 103           WHEN FOUR => C := IDENT_INT (87);
 104           WHEN FIVE => C := IDENT_INT (86);
 105           WHEN SIX => C := IDENT_INT (85);
 106      END CASE;
 107
 108      IF NOT EQUAL (C,88) THEN
 109           FAILED ("IMPROPER CHOICE FOR CASE EXPRESSION WHICH IS AN " &
 110                   "ATTRIBUTE - 2");
 111      END IF;
 112
 113      CASE CONS * 1 IS
 114           WHEN 0 => C := IDENT_INT (1);
 115           WHEN 100 => C := IDENT_INT (2);
 116           WHEN -3000 => C := IDENT_INT (3);
 117           WHEN OTHERS => C := IDENT_INT (4);
 118      END CASE;
 119
 120      IF NOT EQUAL (C,1) THEN
 121           FAILED ("IMPROPER CHOICE FOR CASE EXPRESSION WHICH IS A " &
 122                   "STATIC EXPRESSION - 1");
 123      END IF;
 124
 125      CASE (CONS * 1) IS
 126           WHEN 0 => C := IDENT_INT (10);
 127           WHEN 100 => C := IDENT_INT (20);
 128           WHEN -3000 => C := IDENT_INT (30);
 129           WHEN OTHERS => C := IDENT_INT (40);
 130      END CASE;
 131
 132      IF NOT EQUAL (C,10) THEN
 133           FAILED ("IMPROPER CHOICE FOR CASE EXPRESSION WHICH IS A " &
 134                   "STATIC EXPRESSION - 2");
 135      END IF;
 136
 137      RESULT;
 138 END C54A13D;