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

   1 -- CD2A24A.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 WITH THE SMALLEST
  29 --     APPROPRIATE SIGNED SIZE ARE NOT AFFECTED BY THE
  30 --     REPRESENTATION CLAUSE.
  31
  32 -- HISTORY:
  33 --     JET 08/19/87 CREATED ORIGINAL TEST.
  34 --     DHH 04/18/89 CHANGED EXTENSION FROM '.DEP' TO '.ADA', CHANGED
  35 --                  OPERATORS ON 'SIZE TESTS, AND ADDED CHECK ON
  36 --                  REPRESENTATION CLAUSE.
  37 --     WMC 03/27/92 ELIMINATED TEST REDUNDANCIES.
  38
  39 WITH REPORT; USE REPORT;
  40 WITH LENGTH_CHECK;                      -- CONTAINS A CALL TO 'FAILED'.
  41 PROCEDURE CD2A24A IS
  42
  43      BASIC_SIZE : CONSTANT := 4;
  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 ("CD2A24A", "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 WITH " &
 113                       "THE SMALLEST APPROPRIATE SIGNED SIZE ARE " &
 114                       "NOT AFFECTED BY THE REPRESENTATION CLAUSE");
 115
 116      CHECK_1 (C0, BASIC_SIZE, "CHECK_TYPE");
 117      PROC (ZERO, TWO, C1, C2, C2);
 118
 119      IF C1 /= ONE OR C2 /= TWO THEN
 120           FAILED ("INCORRECT VALUE RETURNED BY PROCEDURE");
 121      END IF;
 122
 123      IF CHECK_TYPE'SIZE /= IDENT_INT (BASIC_SIZE) THEN
 124           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SIZE");
 125      END IF;
 126
 127      IF C0'SIZE < IDENT_INT (BASIC_SIZE) THEN
 128           FAILED ("INCORRECT VALUE FOR C0'SIZE");
 129      END IF;
 130
 131      IF NOT ((C0 <  IDENT (ONE)) AND(IDENT (C2)  > IDENT (C1)) AND
 132              (C1 <= IDENT (ONE)) AND(IDENT (TWO) = C2))        THEN
 133           FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS - 2");
 134      END IF;
 135
 136      IF CHECK_TYPE'LAST /= IDENT (TWO) THEN
 137           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'LAST - 2");
 138      END IF;
 139
 140      IF CHECK_TYPE'POS (C0) /= IDENT_INT (0) OR
 141         CHECK_TYPE'POS (C1) /= IDENT_INT (1) OR
 142         CHECK_TYPE'POS (C2) /= IDENT_INT (2) THEN
 143           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'POS - 2");
 144      END IF;
 145
 146      IF CHECK_TYPE'SUCC (C0) /= IDENT (C1) OR
 147         CHECK_TYPE'SUCC (C1) /= IDENT (C2) THEN
 148           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SUCC - 2");
 149      END IF;
 150
 151      IF CHECK_TYPE'IMAGE (C0) /= IDENT_STR ("ZERO") OR
 152         CHECK_TYPE'IMAGE (C1) /= IDENT_STR ("ONE")  OR
 153         CHECK_TYPE'IMAGE (C2) /= IDENT_STR ("TWO")  THEN
 154           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'IMAGE - 2");
 155      END IF;
 156
 157      IF CHARRAY(1)'SIZE < IDENT_INT (BASIC_SIZE) THEN
 158           FAILED ("INCORRECT VALUE FOR CHARRAY(1)'SIZE");
 159      END IF;
 160
 161      IF NOT ((CHARRAY (0) <  IDENT (ONE))                 AND
 162              (IDENT (CHARRAY (2))  > IDENT (CHARRAY (1))) AND
 163              (CHARRAY (1) <= IDENT (ONE))                 AND
 164              (IDENT (TWO) = CHARRAY (2)))                 THEN
 165           FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS - 3");
 166      END IF;
 167
 168      IF NOT ((IDENT (CHARRAY (1)) IN CHARRAY (1) .. CHARRAY (2)) AND
 169              (CHARRAY (0) NOT IN IDENT (ONE) .. CHARRAY (2)))    THEN
 170           FAILED ("INCORRECT RESULTS FOR MEMBERSHIP OPERATORS - 3");
 171      END IF;
 172
 173      IF CHECK_TYPE'VAL (0) /= IDENT (CHARRAY (0)) OR
 174         CHECK_TYPE'VAL (1) /= IDENT (CHARRAY (1)) OR
 175         CHECK_TYPE'VAL (2) /= IDENT (CHARRAY (2)) THEN
 176           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VAL - 3");
 177      END IF;
 178
 179      IF CHECK_TYPE'PRED (CHARRAY (1)) /= IDENT (CHARRAY (0)) OR
 180         CHECK_TYPE'PRED (CHARRAY (2)) /= IDENT (CHARRAY (1)) THEN
 181           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'PRED - 3");
 182      END IF;
 183
 184      IF CHECK_TYPE'VALUE ("ZERO") /= IDENT (CHARRAY (0)) OR
 185         CHECK_TYPE'VALUE ("ONE")  /= IDENT (CHARRAY (1)) OR
 186         CHECK_TYPE'VALUE ("TWO")  /= IDENT (CHARRAY (2)) THEN
 187           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'VALUE - 3");
 188      END IF;
 189
 190      IF CHREC.COMP2'SIZE < IDENT_INT (BASIC_SIZE) THEN
 191           FAILED ("INCORRECT VALUE FOR CHREC.COMP2'SIZE");
 192      END IF;
 193
 194      IF NOT ((CHREC.COMP0 <  IDENT (ONE))                 AND
 195              (IDENT (CHREC.COMP2)  > IDENT (CHREC.COMP1)) AND
 196              (CHREC.COMP1 <= IDENT (ONE))                 AND
 197              (IDENT (TWO) = CHREC.COMP2))                 THEN
 198           FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS - 4");
 199      END IF;
 200
 201      IF NOT ((IDENT (CHREC.COMP1) IN CHREC.COMP1 .. CHREC.COMP2) AND
 202              (CHREC.COMP0 NOT IN IDENT (ONE) .. CHREC.COMP2))    THEN
 203           FAILED ("INCORRECT RESULTS FOR MEMBERSHIP OPERATORS - 4");
 204      END IF;
 205
 206      IF CHECK_TYPE'POS (CHREC.COMP0) /= IDENT_INT (0) OR
 207         CHECK_TYPE'POS (CHREC.COMP1) /= IDENT_INT (1) OR
 208         CHECK_TYPE'POS (CHREC.COMP2) /= IDENT_INT (2) THEN
 209           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'POS - 4");
 210      END IF;
 211
 212      IF CHECK_TYPE'SUCC (CHREC.COMP0) /= IDENT (CHREC.COMP1) OR
 213         CHECK_TYPE'SUCC (CHREC.COMP1) /= IDENT (CHREC.COMP2) THEN
 214           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SUCC - 4");
 215      END IF;
 216
 217      IF CHECK_TYPE'IMAGE (CHREC.COMP0) /= IDENT_STR ("ZERO") OR
 218         CHECK_TYPE'IMAGE (CHREC.COMP1) /= IDENT_STR ("ONE")  OR
 219         CHECK_TYPE'IMAGE (CHREC.COMP2) /= IDENT_STR ("TWO")  THEN
 220           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'IMAGE - 4");
 221      END IF;
 222
 223
 224      RESULT;
 225
 226 END CD2A24A;