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

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