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

   1 -- C36172A.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 CONSTRAINT_ERROR IS RAISED APPROPRIATELY
  26 -- ON DISCRETE_RANGES USED AS INDEX_CONSTRAINTS.
  27
  28 -- DAT 2/9/81
  29 -- SPS 4/7/82
  30 -- JBG 6/5/85
  31
  32 WITH REPORT;
  33 PROCEDURE C36172A IS
  34
  35      USE REPORT;
  36
  37      SUBTYPE INT_10 IS INTEGER RANGE 1 .. 10;
  38      TYPE A IS ARRAY (INT_10 RANGE <> ) OF INTEGER;
  39
  40      SUBTYPE INT_11 IS INTEGER RANGE 0 .. 11;
  41      SUBTYPE NULL_6_4 IS INTEGER RANGE 6 .. 4;
  42      SUBTYPE NULL_11_10 IS INTEGER RANGE 11 .. 10;
  43      SUBTYPE INT_9_11 IS INTEGER RANGE 9 .. 11;
  44
  45      TYPE A_9_11 IS ARRAY (9..11) OF BOOLEAN;
  46      TYPE A_11_10 IS ARRAY (11 .. 10) OF INTEGER;
  47      SUBTYPE A_1_10 IS A(INT_10);
  48
  49 BEGIN
  50      TEST ("C36172A", "CONSTRAINT_ERROR IS RAISED APPROPRIATELY" &
  51            " FOR INDEX_RANGES");
  52
  53      BEGIN
  54           DECLARE
  55                V : A (9 .. 11);
  56           BEGIN
  57                IF EQUAL (V'FIRST, V'FIRST) THEN
  58                     FAILED ("OUT-OF-BOUNDS INDEX_RANGE 1");
  59                ELSE
  60                     FAILED ("IMPOSSIBLE");
  61                END IF;
  62           END;
  63      EXCEPTION
  64           WHEN CONSTRAINT_ERROR => NULL;
  65           WHEN OTHERS => FAILED ("WRONG EXCEPTION 1");
  66      END;
  67
  68      BEGIN
  69           DECLARE
  70                V : A (11 .. 10);
  71           BEGIN
  72                IF EQUAL (V'FIRST, V'FIRST) THEN
  73                     NULL;
  74                ELSE
  75                     FAILED ("IMPOSSIBLE");
  76                END IF;
  77           END;
  78      EXCEPTION
  79           WHEN CONSTRAINT_ERROR => FAILED ("CONSTRAINT_ERROR " &
  80                "RAISED INAPPROPRIATELY 2");
  81           WHEN OTHERS => FAILED ("EXCEPTION RAISED WHEN NONE " &
  82                "SHOULD BE 2");
  83      END;
  84
  85      BEGIN
  86           DECLARE
  87                V : A (6 .. 4);
  88           BEGIN
  89                IF EQUAL (V'FIRST, V'FIRST) THEN
  90                     NULL;
  91                ELSE
  92                     FAILED ("IMPOSSIBLE");
  93                END IF;
  94           END;
  95      EXCEPTION
  96           WHEN CONSTRAINT_ERROR => FAILED ("CONSTRAINT_ERROR " &
  97                "RAISED INAPPROPRIATELY 3");
  98           WHEN OTHERS => FAILED ("EXCEPTION RAISED WHEN NONE " &
  99                "SHOULD BE 3");
 100      END;
 101
 102      BEGIN
 103           DECLARE
 104                V : A (INT_9_11);
 105           BEGIN
 106                IF EQUAL (V'FIRST, V'FIRST) THEN
 107                     FAILED ("OUT-OF-BOUNDS INDEX RANGE 4");
 108                ELSE
 109                     FAILED ("IMPOSSIBLE");
 110                END IF;
 111           END;
 112      EXCEPTION
 113           WHEN CONSTRAINT_ERROR => NULL;
 114           WHEN OTHERS => FAILED ("WRONG EXCEPTION 4");
 115      END;
 116
 117      BEGIN
 118           DECLARE
 119                V : A (NULL_11_10);
 120           BEGIN
 121                IF EQUAL (V'FIRST, V'FIRST) THEN
 122                     NULL;
 123                ELSE
 124                     FAILED ("IMPOSSIBLE");
 125                END IF;
 126           END;
 127      EXCEPTION
 128           WHEN CONSTRAINT_ERROR => FAILED ("CONSTRAINT_ERROR " &
 129                "RAISED INAPPROPRIATELY 5");
 130           WHEN OTHERS => FAILED ("EXCEPTION RAISED WHEN NONE " &
 131                "SHOULD BE 5");
 132      END;
 133
 134      BEGIN
 135           DECLARE
 136                V : A (NULL_6_4);
 137           BEGIN
 138                IF EQUAL (V'FIRST, V'FIRST) THEN
 139                     NULL;
 140                ELSE
 141                     FAILED ("IMPOSSIBLE");
 142                END IF;
 143           END;
 144      EXCEPTION
 145           WHEN CONSTRAINT_ERROR => FAILED ("CONSTRAINT_ERROR " &
 146                "RAISED INAPPROPRIATELY 6");
 147           WHEN OTHERS => FAILED ("EXCEPTION RAISED WHEN NONE " &
 148                "SHOULD BE 6");
 149      END;
 150
 151      BEGIN
 152           DECLARE
 153                V : A (INT_9_11 RANGE 10 .. 11);
 154           BEGIN
 155                IF EQUAL (V'FIRST, V'FIRST) THEN
 156                     FAILED ("BAD NON-NULL INDEX RANGE 7");
 157                ELSE
 158                     FAILED ("IMPOSSIBLE");
 159                END IF;
 160           END;
 161      EXCEPTION
 162           WHEN CONSTRAINT_ERROR => NULL;
 163           WHEN OTHERS => FAILED ("WRONG EXCEPTION 7");
 164      END;
 165
 166      BEGIN
 167           DECLARE
 168                V : A (NULL_11_10 RANGE 11 .. 10);
 169           BEGIN
 170                IF EQUAL (V'FIRST, V'FIRST) THEN
 171                     NULL;
 172                ELSE
 173                     FAILED ("IMPOSSIBLE");
 174                END IF;
 175           END;
 176      EXCEPTION
 177           WHEN CONSTRAINT_ERROR => FAILED ("CONSTRAINT_ERROR " &
 178                "RAISED INAPPROPRIATELY 8");
 179           WHEN OTHERS => FAILED ("EXCEPTION RAISED WHEN NONE " &
 180                "SHOULD BE 8");
 181      END;
 182
 183      BEGIN
 184           DECLARE
 185                V : A (NULL_6_4 RANGE 6 .. 4);
 186           BEGIN
 187                IF EQUAL (V'FIRST, V'FIRST) THEN
 188                     NULL;
 189                ELSE
 190                     FAILED ("IMPOSSIBLE");
 191                END IF;
 192           END;
 193      EXCEPTION
 194           WHEN CONSTRAINT_ERROR => FAILED ("CONSTRAINT_ERROR " &
 195                "RAISED INAPPROPRIATELY 9");
 196           WHEN OTHERS => FAILED ("EXCEPTION RAISED WHEN NONE " &
 197                "SHOULD BE 9");
 198      END;
 199
 200      BEGIN
 201           DECLARE
 202                V : A (A_9_11'RANGE);
 203           BEGIN
 204                IF EQUAL (V'FIRST, V'FIRST) THEN
 205                     FAILED ("BAD INDEX RANGE 10");
 206                ELSE
 207                     FAILED ("IMPOSSIBLE");
 208                END IF;
 209           END;
 210      EXCEPTION
 211           WHEN CONSTRAINT_ERROR => NULL;
 212           WHEN OTHERS => FAILED ("WRONG EXCEPTION 10");
 213      END;
 214
 215      BEGIN
 216           DECLARE
 217                V : A (A_11_10'RANGE);
 218           BEGIN
 219                IF EQUAL (V'FIRST, V'FIRST) THEN
 220                     NULL;
 221                ELSE
 222                     FAILED ("IMPOSSIBLE");
 223                END IF;
 224           END;
 225      EXCEPTION
 226           WHEN CONSTRAINT_ERROR => FAILED ("CONSTRAINT_ERROR " &
 227                "RAISED INAPPROPRIATELY 11");
 228           WHEN OTHERS => FAILED ("EXCEPTION RAISED WHEN NONE " &
 229                "SHOULD BE 11");
 230      END;
 231
 232      BEGIN
 233           DECLARE
 234                V : A (6 .. 4);
 235           BEGIN
 236                IF EQUAL (V'FIRST, V'FIRST) THEN
 237                     NULL;
 238                ELSE
 239                     FAILED ("IMPOSSIBLE");
 240                END IF;
 241           END;
 242      EXCEPTION
 243           WHEN CONSTRAINT_ERROR => FAILED ("CONSTRAINT_ERROR " &
 244                "RAISED INAPPROPRIATELY 12");
 245           WHEN OTHERS => FAILED ("EXCEPTION RAISED WHEN NONE " &
 246                "SHOULD BE 12");
 247      END;
 248
 249      RESULT;
 250 END C36172A;