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

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