gcc/testsuite/ada/acats/tests/cd/cd2a23a.ada

   1 -- CD2A23A.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 WHEN A SIZE SPECIFICATION AND AN ENUMERATION
  27 --     REPRESENTATION CLAUSE ARE GIVEN FOR AN ENUMERATION TYPE,
  28 --     THEN OPERATIONS ON VALUES OF SUCH A TYPE ARE NOT AFFECTED
  29 --     BY THE REPRESENTATION CLAUSE.
  30
  31 -- HISTORY:
  32 --     RJW 07/28/87 CREATED ORIGINAL TEST.
  33 --     DHH 04/18/89 CHANGED EXTENSION FROM '.DEP' TO '.ADA', CHANGED
  34 --                  OPERATORS ON 'SIZE TESTS, AND ADDED CHECK ON
  35 --                  REPRESENTATION CLAUSE.
  36 --     WMC 03/27/92 ELIMINATED TEST REDUNDANCIES.
  37
  38
  39 WITH REPORT; USE REPORT;
  40 WITH LENGTH_CHECK;                      -- CONTAINS A CALL TO 'FAILED'.
  41 PROCEDURE CD2A23A IS
  42
  43      BASIC_SIZE : CONSTANT := INTEGER'SIZE/2;
  44
  45      TYPE CHECK_TYPE IS (ZERO, ONE, TWO);
  46
  47      FOR CHECK_TYPE USE (ZERO => 3, ONE => 4, TWO => 5);
  48
  49      FOR CHECK_TYPE'SIZE USE BASIC_SIZE;
  50
  51      C0 : CHECK_TYPE := ZERO;
  52      C1 : CHECK_TYPE := ONE;
  53      C2 : CHECK_TYPE := TWO;
  54
  55      TYPE ARRAY_TYPE IS ARRAY (0 .. 2) OF CHECK_TYPE;
  56      CHARRAY : ARRAY_TYPE := (ZERO, ONE, TWO);
  57
  58      TYPE REC_TYPE IS RECORD
  59           COMP0 : CHECK_TYPE := ZERO;
  60           COMP1 : CHECK_TYPE := ONE;
  61           COMP2 : CHECK_TYPE := TWO;
  62      END RECORD;
  63
  64      CHREC : REC_TYPE;
  65
  66      FUNCTION IDENT (CH : CHECK_TYPE) RETURN CHECK_TYPE IS
  67      BEGIN
  68           IF EQUAL (3, 3) THEN
  69                RETURN CH;
  70           ELSE
  71                RETURN ONE;
  72           END IF;
  73      END IDENT;
  74
  75      PROCEDURE CHECK_1 IS NEW LENGTH_CHECK (CHECK_TYPE);
  76
  77      PROCEDURE PROC (CI0,  CI2  :        CHECK_TYPE;
  78                      CIO1, CIO2 : IN OUT CHECK_TYPE;
  79                      CO2        :    OUT CHECK_TYPE) IS
  80      BEGIN
  81           IF NOT ((IDENT (CIO1) IN CIO1 .. CIO2)    AND
  82                   (CI0 NOT IN IDENT (ONE) .. CIO2)) THEN
  83                FAILED ("INCORRECT RESULTS FOR MEMBERSHIP OPERATORS " &
  84                        "- 1");
  85           END IF;
  86
  87           IF CHECK_TYPE'VAL (0) /= IDENT (CI0)  OR
  88              CHECK_TYPE'VAL (1) /= IDENT (CIO1) OR
  89              CHECK_TYPE'VAL (2) /= IDENT (CIO2) THEN
  90                FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VAL - 1");
  91           END IF;
  92
  93           IF CHECK_TYPE'PRED (CIO1) /= IDENT (CI0)  OR
  94              CHECK_TYPE'PRED (CIO2) /= IDENT (CIO1) THEN
  95                FAILED ("INCORRECT VALUE FOR CHECK_TYPE'PRED - 1");
  96           END IF;
  97
  98           IF CHECK_TYPE'VALUE ("ZERO") /= IDENT (CI0)   OR
  99              CHECK_TYPE'VALUE ("ONE")  /=  IDENT (CIO1) OR
 100              CHECK_TYPE'VALUE ("TWO")  /=  IDENT (CIO2) THEN
 101                FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VALUE - 1");
 102           END IF;
 103
 104           CO2 := TWO;
 105
 106      END PROC;
 107
 108 BEGIN
 109      TEST ("CD2A23A", "CHECK THAT WHEN A SIZE SPECIFICATION AND " &
 110                       "AN ENUMERATION REPRESENTATION CLAUSE ARE " &
 111                       "GIVEN FOR AN ENUMERATION TYPE, THEN " &
 112                       "OPERATIONS ON VALUES OF SUCH A TYPE ARE " &
 113                       "NOT AFFECTED BY THE REPRESENTATION CLAUSE");
 114
 115      CHECK_1 (C0, BASIC_SIZE, "CHECK_TYPE");
 116      PROC (ZERO, TWO, C1, C2, C2);
 117
 118      IF CHECK_TYPE'SIZE /= IDENT_INT (BASIC_SIZE) THEN
 119           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SIZE");
 120      END IF;
 121
 122      IF C0'SIZE < IDENT_INT (BASIC_SIZE) THEN
 123           FAILED ("INCORRECT VALUE FOR C0'SIZE");
 124      END IF;
 125
 126      IF NOT ((C0 <  IDENT (ONE)) AND(IDENT (C2)  > IDENT (C1)) AND
 127              (C1 <= IDENT (ONE)) AND(IDENT (TWO) = C2))        THEN
 128           FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS - 2");
 129      END IF;
 130
 131      IF CHECK_TYPE'LAST /= IDENT (TWO) THEN
 132           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'LAST - 2");
 133      END IF;
 134
 135      IF CHECK_TYPE'POS (C0) /= IDENT_INT (0) OR
 136         CHECK_TYPE'POS (C1) /= IDENT_INT (1) OR
 137         CHECK_TYPE'POS (C2) /= IDENT_INT (2) THEN
 138           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'POS - 2");
 139      END IF;
 140
 141      IF CHECK_TYPE'SUCC (C0) /= IDENT (C1) OR
 142         CHECK_TYPE'SUCC (C1) /= IDENT (C2) THEN
 143           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SUCC - 2");
 144      END IF;
 145
 146      IF CHECK_TYPE'IMAGE (C0) /= IDENT_STR ("ZERO") OR
 147         CHECK_TYPE'IMAGE (C1) /= IDENT_STR ("ONE")  OR
 148         CHECK_TYPE'IMAGE (C2) /= IDENT_STR ("TWO")  THEN
 149           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'IMAGE - 2");
 150      END IF;
 151
 152      IF CHARRAY (1)'SIZE < IDENT_INT (BASIC_SIZE) THEN
 153           FAILED ("INCORRECT VALUE FOR CHARRAY (1)'SIZE");
 154      END IF;
 155
 156      IF NOT ((CHARRAY (0) <  IDENT (ONE))                 AND
 157              (IDENT (CHARRAY (2))  > IDENT (CHARRAY (1))) AND
 158              (CHARRAY (1) <= IDENT (ONE))                 AND
 159              (IDENT (TWO) = CHARRAY (2)))                 THEN
 160           FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS - 3");
 161      END IF;
 162
 163      IF NOT ((IDENT (CHARRAY (1)) IN CHARRAY (1) .. CHARRAY (2)) AND
 164              (CHARRAY (0) NOT IN IDENT (ONE) .. CHARRAY (2)))    THEN
 165           FAILED ("INCORRECT RESULTS FOR MEMBERSHIP OPERATORS - 3");
 166      END IF;
 167
 168      IF CHECK_TYPE'VAL (0) /= IDENT (CHARRAY (0)) OR
 169         CHECK_TYPE'VAL (1) /= IDENT (CHARRAY (1)) OR
 170         CHECK_TYPE'VAL (2) /= IDENT (CHARRAY (2)) THEN
 171           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VAL - 3");
 172      END IF;
 173
 174      IF CHECK_TYPE'PRED (CHARRAY (1)) /= IDENT (CHARRAY (0)) OR
 175         CHECK_TYPE'PRED (CHARRAY (2)) /= IDENT (CHARRAY (1)) THEN
 176           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'PRED - 3");
 177      END IF;
 178
 179      IF CHECK_TYPE'VALUE ("ZERO") /= IDENT (CHARRAY (0)) OR
 180         CHECK_TYPE'VALUE ("ONE")  /= IDENT (CHARRAY (1)) OR
 181         CHECK_TYPE'VALUE ("TWO")  /= IDENT (CHARRAY (2)) THEN
 182           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VALUE - 3");
 183      END IF;
 184
 185      IF CHREC.COMP2'SIZE < IDENT_INT (BASIC_SIZE) THEN
 186           FAILED ("INCORRECT VALUE FOR CHREC.COMP2'SIZE");
 187      END IF;
 188
 189      IF NOT ((CHREC.COMP0 <  IDENT (ONE))                 AND
 190              (IDENT (CHREC.COMP2)  > IDENT (CHREC.COMP1)) AND
 191              (CHREC.COMP1 <= IDENT (ONE))                 AND
 192              (IDENT (TWO) = CHREC.COMP2))                 THEN
 193           FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS - 4");
 194      END IF;
 195
 196      IF NOT ((IDENT (CHREC.COMP1) IN CHREC.COMP1 .. CHREC.COMP2) AND
 197              (CHREC.COMP0 NOT IN IDENT (ONE) .. CHREC.COMP2))    THEN
 198           FAILED ("INCORRECT RESULTS FOR MEMBERSHIP OPERATORS - 4");
 199      END IF;
 200
 201      IF CHECK_TYPE'POS (CHREC.COMP0) /= IDENT_INT (0) OR
 202         CHECK_TYPE'POS (CHREC.COMP1) /= IDENT_INT (1) OR
 203         CHECK_TYPE'POS (CHREC.COMP2) /= IDENT_INT (2) THEN
 204           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'POS - 4");
 205      END IF;
 206
 207      IF CHECK_TYPE'SUCC (CHREC.COMP0) /= IDENT (CHREC.COMP1) OR
 208         CHECK_TYPE'SUCC (CHREC.COMP1) /= IDENT (CHREC.COMP2) THEN
 209           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SUCC - 4");
 210      END IF;
 211
 212      IF CHECK_TYPE'IMAGE (CHREC.COMP0) /= IDENT_STR ("ZERO") OR
 213         CHECK_TYPE'IMAGE (CHREC.COMP1) /= IDENT_STR ("ONE")  OR
 214         CHECK_TYPE'IMAGE (CHREC.COMP2) /= IDENT_STR ("TWO")  THEN
 215           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'IMAGE - 4");
 216      END IF;
 217
 218
 219      RESULT;
 220
 221 END CD2A23A;