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

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