old-autovect-branch/gcc/testsuite/ada/acats/tests/cd/cd2a22a.ada

   1 -- CD2A22A.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 SPECIFICATION INDICATING THE SMALLEST SIZE
  28 --     APPROPRIATE FOR A SIGNED 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 --     RJW 07/28/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 CD2A22A IS
  39
  40      BASIC_SIZE : CONSTANT := 3;
  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 NOT ((CI0 <  IDENT (ONE))                          AND
  75                   (IDENT (CI2)  > IDENT (CIO1))                 AND
  76                   (CIO1 <= IDENT (ONE)) AND(IDENT (TWO) = CI2)) THEN
  77                FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS " &
  78                        "- 1");
  79           END IF;
  80
  81           IF CHECK_TYPE'POS (CI0)  /= IDENT_INT (0) OR
  82              CHECK_TYPE'POS (CIO1) /= IDENT_INT (1) OR
  83              CHECK_TYPE'POS (CI2)  /= IDENT_INT (2) THEN
  84                FAILED ("INCORRECT VALUE FOR CHECK_TYPE'POS - 1");
  85           END IF;
  86
  87           IF CHECK_TYPE'SUCC (CI0)  /=  IDENT (CIO1) OR
  88              CHECK_TYPE'SUCC (CIO1) /= IDENT (CI2)   THEN
  89                FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SUCC - 1");
  90           END IF;
  91
  92           IF CHECK_TYPE'IMAGE (CI0)  /= IDENT_STR ("ZERO") OR
  93              CHECK_TYPE'IMAGE (CIO1) /= IDENT_STR ("ONE")  OR
  94              CHECK_TYPE'IMAGE (CI2)  /= IDENT_STR ("TWO")  THEN
  95                FAILED ("INCORRECT VALUE FOR CHECK_TYPE'IMAGE - 1");
  96           END IF;
  97
  98           CO2 := TWO;
  99
 100      END PROC;
 101
 102 BEGIN
 103      TEST ("CD2A22A", "CHECK THAT IF A SIZE SPECIFICATION " &
 104                       "INDICATING THE SMALLEST SIZE APPROPRIATE " &
 105                       "FOR A SIGNED REPRESENTATION IS GIVEN " &
 106                       "FOR AN ENUMERATION TYPE, THEN OPERATIONS " &
 107                       "ON VALUES OF SUCH A TYPE ARE NOT AFFECTED " &
 108                       "BY THE REPRESENTATION CLAUSE");
 109
 110      PROC (ZERO, TWO, C1, C2, C2);
 111
 112      IF CHECK_TYPE'SIZE /= IDENT_INT (BASIC_SIZE) THEN
 113           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SIZE");
 114      END IF;
 115
 116      IF C0'SIZE < IDENT_INT (BASIC_SIZE) THEN
 117           FAILED ("INCORRECT VALUE FOR C0'SIZE");
 118      END IF;
 119
 120      IF NOT ((IDENT (C1) IN C1 .. C2)       AND
 121              (C0 NOT IN IDENT (ONE) .. C2)) THEN
 122           FAILED ("INCORRECT RESULTS FOR MEMBERSHIP OPERATORS - 2");
 123      END IF;
 124
 125      IF CHECK_TYPE'FIRST /= IDENT (ZERO) THEN
 126           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'FIRST - 2");
 127      END IF;
 128
 129      IF CHECK_TYPE'VAL (0) /= IDENT (C0) OR
 130         CHECK_TYPE'VAL (1) /= IDENT (C1) OR
 131         CHECK_TYPE'VAL (2) /= IDENT (C2) THEN
 132           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VAL - 2");
 133      END IF;
 134
 135      IF CHECK_TYPE'PRED (C1) /= IDENT (C0) OR
 136         CHECK_TYPE'PRED (C2) /= IDENT (C1) THEN
 137           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'PRED - 2");
 138      END IF;
 139
 140      IF CHECK_TYPE'VALUE ("ZERO") /= IDENT (C0)  OR
 141         CHECK_TYPE'VALUE ("ONE")  /=  IDENT (C1) OR
 142         CHECK_TYPE'VALUE ("TWO")  /=  IDENT (C2) THEN
 143           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VALUE - 2");
 144      END IF;
 145
 146      IF CHARRAY (1)'SIZE < IDENT_INT (BASIC_SIZE) THEN
 147           FAILED ("INCORRECT VALUE FOR CHARRAY (1)'SIZE");
 148      END IF;
 149
 150      IF NOT ((CHARRAY (0) <  IDENT (ONE))                 AND
 151              (IDENT (CHARRAY (2))  > IDENT (CHARRAY (1))) AND
 152              (CHARRAY (1) <= IDENT (ONE))                 AND
 153              (IDENT (TWO) = CHARRAY (2)))                 THEN
 154           FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS - 3");
 155      END IF;
 156
 157      IF NOT ((IDENT (CHARRAY (1)) IN CHARRAY (1) .. CHARRAY (2)) AND
 158              (CHARRAY (0) NOT IN IDENT (ONE) .. CHARRAY (2)))    THEN
 159           FAILED ("INCORRECT RESULTS FOR MEMBERSHIP OPERATORS - 3");
 160      END IF;
 161
 162      IF CHECK_TYPE'POS (CHARRAY (0)) /= IDENT_INT (0) OR
 163         CHECK_TYPE'POS (CHARRAY (1)) /= IDENT_INT (1) OR
 164         CHECK_TYPE'POS (CHARRAY (2)) /= IDENT_INT (2) THEN
 165           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'POS - 3");
 166      END IF;
 167
 168      IF CHECK_TYPE'SUCC (CHARRAY (0)) /= IDENT (CHARRAY (1)) OR
 169         CHECK_TYPE'SUCC (CHARRAY (1)) /= IDENT (CHARRAY (2)) THEN
 170           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SUCC - 3");
 171      END IF;
 172
 173      IF CHECK_TYPE'IMAGE (CHARRAY (0)) /= IDENT_STR ("ZERO") OR
 174         CHECK_TYPE'IMAGE (CHARRAY (1)) /= IDENT_STR ("ONE")  OR
 175         CHECK_TYPE'IMAGE (CHARRAY (2)) /= IDENT_STR ("TWO")  THEN
 176           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'IMAGE - 3");
 177      END IF;
 178
 179      IF CHREC.COMP1'SIZE < IDENT_INT (BASIC_SIZE) THEN
 180           FAILED ("INCORRECT VALUE FOR CHREC.COMP1'SIZE");
 181      END IF;
 182
 183      IF NOT ((CHREC.COMP0 <  IDENT (ONE))                 AND
 184              (IDENT (CHREC.COMP2)  > IDENT (CHREC.COMP1)) AND
 185              (CHREC.COMP1 <= IDENT (ONE))                 AND
 186              (IDENT (TWO) = CHREC.COMP2))                 THEN
 187           FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS - 4");
 188      END IF;
 189
 190      IF NOT ((IDENT (CHREC.COMP1) IN CHREC.COMP1 .. CHREC.COMP2) AND
 191              (CHREC.COMP0 NOT IN IDENT (ONE) .. CHREC.COMP2))    THEN
 192           FAILED ("INCORRECT RESULTS FOR MEMBERSHIP OPERATORS - 4");
 193      END IF;
 194
 195      IF CHECK_TYPE'VAL (0) /= IDENT (CHREC.COMP0) OR
 196         CHECK_TYPE'VAL (1) /= IDENT (CHREC.COMP1) OR
 197         CHECK_TYPE'VAL (2) /= IDENT (CHREC.COMP2) THEN
 198           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VAL - 4");
 199      END IF;
 200
 201      IF CHECK_TYPE'PRED (CHREC.COMP1) /= IDENT (CHREC.COMP0) OR
 202         CHECK_TYPE'PRED (CHREC.COMP2) /= IDENT (CHREC.COMP1) THEN
 203           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'PRED - 4");
 204      END IF;
 205
 206      IF CHECK_TYPE'VALUE ("ZERO") /= IDENT (CHREC.COMP0) OR
 207         CHECK_TYPE'VALUE ("ONE")  /= IDENT (CHREC.COMP1) OR
 208         CHECK_TYPE'VALUE ("TWO")  /= IDENT (CHREC.COMP2) THEN
 209           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VALUE - 4");
 210      END IF;
 211
 212      RESULT;
 213 END CD2A22A;