gomp-20050608-branch/gcc/testsuite/ada/acats/tests/cd/cd2a22e.ada

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