gcc/testsuite/ada/acats/tests/c3/c35003a.ada

   1 -- C35003A.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 CONSTRAINT_ERROR IS RAISED FOR AN INTEGER OR
  27 --     ENUMERATION SUBTYPE INDICATION WHEN THE LOWER OR UPPER BOUND
  28 --     OF A NON-NULL RANGE LIES OUTSIDE THE RANGE OF THE TYPE MARK.
  29
  30 -- HISTORY:
  31 --     JET 01/25/88  CREATED ORIGINAL TEST.
  32
  33 WITH REPORT; USE REPORT;
  34
  35 PROCEDURE C35003A IS
  36
  37      TYPE ENUM IS (ZERO, ONE, TWO, THREE);
  38      SUBTYPE SUBENUM IS ENUM RANGE ONE..TWO;
  39      TYPE INT IS RANGE 1..10;
  40      SUBTYPE SUBINT IS INTEGER RANGE -10..10;
  41      TYPE A1 IS ARRAY (0..11) OF INTEGER;
  42      TYPE A2 IS ARRAY (INTEGER RANGE -11..10) OF INTEGER;
  43
  44 BEGIN
  45      TEST ("C35003A", "CHECK THAT CONSTRAINT_ERROR IS RAISED FOR AN " &
  46                       "INTEGER OR ENUMERATION SUBTYPE INDICATION " &
  47                       "WHEN THE LOWER OR UPPER BOUND OF A NON-NULL " &
  48                       "RANGE LIES OUTSIDE THE RANGE OF THE TYPE MARK");
  49      BEGIN
  50           DECLARE
  51                SUBTYPE SUBSUBENUM IS SUBENUM RANGE ZERO..TWO;
  52           BEGIN
  53                FAILED ("NO EXCEPTION RAISED (E1)");
  54                DECLARE
  55                     Z : SUBSUBENUM := ONE;
  56                BEGIN
  57                     IF NOT EQUAL(SUBSUBENUM'POS(Z),SUBSUBENUM'POS(Z))
  58                     THEN
  59                          COMMENT ("DON'T OPTIMIZE Z");
  60                     END IF;
  61                END;
  62           EXCEPTION
  63                WHEN OTHERS =>
  64                     FAILED ("EXCEPTION RAISED IN WRONG PLACE (E1)");
  65           END;
  66      EXCEPTION
  67           WHEN CONSTRAINT_ERROR =>
  68                NULL;
  69           WHEN OTHERS =>
  70                FAILED ("WRONG EXCEPTION RAISED (E1)");
  71      END;
  72
  73      BEGIN
  74           DECLARE
  75                TYPE A IS ARRAY (SUBENUM RANGE ONE..THREE) OF INTEGER;
  76           BEGIN
  77                FAILED ("NO EXCEPTION RAISED (E2)");
  78                DECLARE
  79                     Z : A := (OTHERS => 0);
  80                BEGIN
  81                     IF NOT EQUAL(Z(ONE),Z(ONE)) THEN
  82                          COMMENT ("DON'T OPTIMIZE Z");
  83                     END IF;
  84                END;
  85           EXCEPTION
  86                WHEN OTHERS =>
  87                     FAILED ("EXCEPTION RAISED IN WRONG PLACE (E2)");
  88           END;
  89      EXCEPTION
  90           WHEN CONSTRAINT_ERROR =>
  91                NULL;
  92           WHEN OTHERS =>
  93                FAILED ("WRONG EXCEPTION RAISED (E2)");
  94      END;
  95
  96      BEGIN
  97           DECLARE
  98                TYPE I IS ACCESS INT RANGE INT(IDENT_INT(0))..10;
  99           BEGIN
 100                FAILED ("NO EXCEPTION RAISED (I1)");
 101                DECLARE
 102                     Z : I := NEW INT'(1);
 103                BEGIN
 104                     IF NOT EQUAL(INTEGER(Z.ALL),INTEGER(Z.ALL)) THEN
 105                          COMMENT ("DON'T OPTIMIZE Z");
 106                     END IF;
 107                END;
 108           EXCEPTION
 109                WHEN OTHERS =>
 110                     FAILED ("EXCEPTION RAISED IN WRONG PLACE (I1)");
 111           END;
 112      EXCEPTION
 113           WHEN CONSTRAINT_ERROR =>
 114                NULL;
 115           WHEN OTHERS =>
 116                FAILED ("WRONG EXCEPTION RAISED (I1)");
 117      END;
 118
 119      BEGIN
 120           DECLARE
 121                TYPE I IS NEW INT RANGE 1..INT'SUCC(10);
 122           BEGIN
 123                FAILED ("NO EXCEPTION RAISED (I2)");
 124                DECLARE
 125                     Z : I := 1;
 126                BEGIN
 127                     IF NOT EQUAL(INTEGER(Z),INTEGER(Z)) THEN
 128                          COMMENT ("DON'T OPTIMIZE Z");
 129                     END IF;
 130                END;
 131           EXCEPTION
 132                WHEN OTHERS =>
 133                     FAILED ("EXCEPTION RAISED IN WRONG PLACE (I2)");
 134           END;
 135      EXCEPTION
 136           WHEN CONSTRAINT_ERROR =>
 137                NULL;
 138           WHEN OTHERS =>
 139                FAILED ("WRONG EXCEPTION RAISED (I2)");
 140      END;
 141
 142      BEGIN
 143           DECLARE
 144                TYPE R IS RECORD
 145                     A : SUBINT RANGE IDENT_INT(-11)..0;
 146                END RECORD;
 147           BEGIN
 148                FAILED ("NO EXCEPTION RAISED (S1)");
 149                DECLARE
 150                     Z : R := (A => 1);
 151                BEGIN
 152                     IF NOT EQUAL(INTEGER(Z.A),INTEGER(Z.A)) THEN
 153                          COMMENT ("DON'T OPTIMIZE Z");
 154                     END IF;
 155                END;
 156           EXCEPTION
 157                WHEN OTHERS =>
 158                     FAILED ("EXCEPTION RAISED IN WRONG PLACE (S1)");
 159           END;
 160      EXCEPTION
 161           WHEN CONSTRAINT_ERROR =>
 162                NULL;
 163           WHEN OTHERS =>
 164                FAILED ("WRONG EXCEPTION RAISED (S1)");
 165      END;
 166
 167      BEGIN
 168           DECLARE
 169                Z : SUBINT RANGE 0..IDENT_INT(11) := 0;
 170           BEGIN
 171                FAILED ("NO EXCEPTION RAISED (S2)");
 172                IF NOT EQUAL(INTEGER(Z),INTEGER(Z)) THEN
 173                     COMMENT ("DON'T OPTIMIZE Z");
 174                END IF;
 175           EXCEPTION
 176                WHEN OTHERS =>
 177                     FAILED ("EXCEPTION RAISED IN WRONG PLACE (S2)");
 178           END;
 179      EXCEPTION
 180           WHEN CONSTRAINT_ERROR =>
 181                NULL;
 182           WHEN OTHERS =>
 183                FAILED ("WRONG EXCEPTION RAISED (S2)");
 184      END;
 185
 186      BEGIN
 187           DECLARE
 188                SUBTYPE I IS SUBINT RANGE A1'RANGE;
 189           BEGIN
 190                FAILED ("NO EXCEPTION RAISED (R1)");
 191                DECLARE
 192                     Z : I := 1;
 193                BEGIN
 194                     IF NOT EQUAL(INTEGER(Z),INTEGER(Z)) THEN
 195                          COMMENT ("DON'T OPTIMIZE Z");
 196                     END IF;
 197                END;
 198           EXCEPTION
 199                WHEN OTHERS =>
 200                     FAILED ("EXCEPTION RAISED IN WRONG PLACE (R1)");
 201           END;
 202      EXCEPTION
 203           WHEN CONSTRAINT_ERROR =>
 204                NULL;
 205           WHEN OTHERS =>
 206                FAILED ("WRONG EXCEPTION RAISED (R1)");
 207      END;
 208
 209      BEGIN
 210           DECLARE
 211                SUBTYPE I IS SUBINT RANGE A2'RANGE;
 212           BEGIN
 213                FAILED ("NO EXCEPTION RAISED (R2)");
 214                DECLARE
 215                     Z : I := 1;
 216                BEGIN
 217                     IF NOT EQUAL(INTEGER(Z),INTEGER(Z)) THEN
 218                          COMMENT ("DON'T OPTIMIZE Z");
 219                     END IF;
 220                END;
 221           EXCEPTION
 222                WHEN OTHERS =>
 223                     FAILED ("EXCEPTION RAISED IN WRONG PLACE (R2)");
 224           END;
 225      EXCEPTION
 226           WHEN CONSTRAINT_ERROR =>
 227                NULL;
 228           WHEN OTHERS =>
 229                FAILED ("WRONG EXCEPTION RAISED (R2)");
 230      END;
 231
 232      RESULT;
 233
 234 END C35003A;