old-autovect-branch/gcc/testsuite/ada/acats/tests/c3/c34001a.ada

   1 -- C34001A.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 -- CHECK THAT THE REQUIRED PREDEFINED OPERATIONS ARE DECLARED
  26 -- (IMPLICITLY) FOR DERIVED ENUMERATION TYPES, EXCLUDING BOOLEAN TYPES.
  27
  28 -- JRK 8/20/86
  29
  30 WITH SYSTEM; USE SYSTEM;
  31 WITH REPORT; USE REPORT;
  32
  33 PROCEDURE C34001A IS
  34
  35      TYPE PARENT IS (E1, E2, E3, 'A', E4, E5, E6);
  36
  37      SUBTYPE SUBPARENT IS PARENT RANGE
  38                PARENT'VAL (IDENT_INT (PARENT'POS (E2))) ..
  39                PARENT'VAL (IDENT_INT (PARENT'POS (E5)));
  40
  41      TYPE T IS NEW SUBPARENT RANGE
  42                PARENT'VAL (IDENT_INT (PARENT'POS (E3))) ..
  43                PARENT'VAL (IDENT_INT (PARENT'POS (E4)));
  44
  45      X : T       := E3;
  46      W : PARENT  := E1;
  47      B : BOOLEAN := FALSE;
  48
  49      PROCEDURE A (X : ADDRESS) IS
  50      BEGIN
  51           B := IDENT_BOOL (TRUE);
  52      END A;
  53
  54      FUNCTION IDENT (X : T) RETURN T IS
  55      BEGIN
  56           IF EQUAL (T'POS (X), T'POS (X)) THEN
  57                RETURN X;                          -- ALWAYS EXECUTED.
  58           END IF;
  59           RETURN T'FIRST;
  60      END IDENT;
  61
  62 BEGIN
  63      TEST ("C34001A", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
  64                       "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
  65                       "ENUMERATION TYPES, EXCLUDING BOOLEAN TYPES");
  66
  67      X := IDENT (E4);
  68      IF X /= E4 THEN
  69           FAILED ("INCORRECT :=");
  70      END IF;
  71
  72      IF T'(X) /= E4 THEN
  73           FAILED ("INCORRECT QUALIFICATION");
  74      END IF;
  75
  76      IF T (X) /= E4 THEN
  77           FAILED ("INCORRECT SELF CONVERSION");
  78      END IF;
  79
  80      IF EQUAL (3, 3) THEN
  81           W := E3;
  82      END IF;
  83      IF T (W) /= E3 THEN
  84           FAILED ("INCORRECT CONVERSION FROM PARENT");
  85      END IF;
  86
  87      IF PARENT (X) /= E4 OR PARENT (T'VAL (0)) /= E1 THEN
  88           FAILED ("INCORRECT CONVERSION TO PARENT");
  89      END IF;
  90
  91      IF IDENT ('A') /= 'A' THEN
  92           FAILED ("INCORRECT 'A'");
  93      END IF;
  94
  95      IF IDENT (E3) /= E3 OR IDENT (E4) = E1 THEN
  96           FAILED ("INCORRECT ENUMERATION LITERAL");
  97      END IF;
  98
  99      IF X = IDENT ('A') OR X = E1 THEN
 100           FAILED ("INCORRECT =");
 101      END IF;
 102
 103      IF X /= IDENT (E4) OR NOT (X /= E1) THEN
 104           FAILED ("INCORRECT /=");
 105      END IF;
 106
 107      IF X < IDENT (E4) OR X < E1 THEN
 108           FAILED ("INCORRECT <");
 109      END IF;
 110
 111      IF X > IDENT (E4) OR X > E6 THEN
 112           FAILED ("INCORRECT >");
 113      END IF;
 114
 115      IF X <= IDENT ('A') OR X <= E1 THEN
 116           FAILED ("INCORRECT <=");
 117      END IF;
 118
 119      IF IDENT ('A') >= X OR X >= E6 THEN
 120           FAILED ("INCORRECT >=");
 121      END IF;
 122
 123      IF NOT (X IN T) OR E1 IN T THEN
 124           FAILED ("INCORRECT ""IN""");
 125      END IF;
 126
 127      IF X NOT IN T OR NOT (E1 NOT IN T) THEN
 128           FAILED ("INCORRECT ""NOT IN""");
 129      END IF;
 130
 131      B := FALSE;
 132      A (X'ADDRESS);
 133      IF NOT B THEN
 134           FAILED ("INCORRECT 'ADDRESS");
 135      END IF;
 136
 137      IF T'BASE'SIZE < 3 THEN
 138           FAILED ("INCORRECT 'BASE'SIZE");
 139      END IF;
 140
 141      IF T'FIRST /= E3 OR T'BASE'FIRST /= E1 THEN
 142           FAILED ("INCORRECT 'FIRST");
 143      END IF;
 144
 145      IF T'IMAGE (X) /= "E4" OR T'IMAGE (E1) /= "E1" THEN
 146           FAILED ("INCORRECT 'IMAGE");
 147      END IF;
 148
 149      IF T'LAST /= E4 OR T'BASE'LAST /= E6 THEN
 150           FAILED ("INCORRECT 'LAST");
 151      END IF;
 152
 153      IF T'POS (X) /= 4 OR T'POS (E1) /= 0 THEN
 154           FAILED ("INCORRECT 'POS");
 155      END IF;
 156
 157      IF T'PRED (X) /= 'A' OR T'PRED (E2) /= E1 THEN
 158           FAILED ("INCORRECT 'PRED");
 159      END IF;
 160
 161      IF T'SIZE < 2 THEN
 162           FAILED ("INCORRECT TYPE'SIZE");
 163      END IF;
 164
 165      IF X'SIZE < 2 THEN
 166           FAILED ("INCORRECT OBJECT'SIZE");
 167      END IF;
 168
 169      IF T'SUCC (IDENT ('A')) /= X OR T'SUCC (E1) /= E2 THEN
 170           FAILED ("INCORRECT 'SUCC");
 171      END IF;
 172
 173      IF T'VAL (IDENT_INT (4)) /= X OR T'VAL (0) /= E1 THEN
 174           FAILED ("INCORRECT 'VAL");
 175      END IF;
 176
 177      IF T'VALUE (IDENT_STR ("E4")) /= X OR T'VALUE ("E1") /= E1 THEN
 178           FAILED ("INCORRECT 'VALUE");
 179      END IF;
 180
 181      IF T'WIDTH /= 3 OR T'BASE'WIDTH /= 3 THEN
 182           FAILED ("INCORRECT 'WIDTH");
 183      END IF;
 184
 185      RESULT;
 186 END C34001A;