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

   1 -- C36172B.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 FOR A MULTIDIMENSIONAL INDEX
  26 -- CONSTRAINT IF ONE OF THE RANGES IS A NULL RANGE AND THE OTHER IS A
  27 -- NON-NULL RANGE WITH A BOUND THAT LIES OUTSIDE THE INDEX SUBTYPE.
  28
  29 -- CHECK THAT NO EXCEPTION IS RAISED IF ALL DISCRETE RANGES ARE NULL.
  30
  31 -- JBG 6/5/85
  32 -- EDS 7/16/98     AVOID OPTIMIZATION
  33
  34 WITH REPORT; USE REPORT;
  35 PROCEDURE C36172B IS
  36      SUBTYPE INT_10 IS INTEGER RANGE 1..10;
  37      TYPE ARR2 IS ARRAY (INT_10 RANGE <>, INT_10 RANGE <>) OF INTEGER;
  38 BEGIN
  39      TEST ("C36172B", "CHECK THAT CONSTRAINT_ERROR IS RAISED FOR A " &
  40                       "NON-NULL DIMENSION OF A NULL MULTIDIMENSIONAL " &
  41                       "INDEX CONSTRAINT IF A BOUND LIES OUTSIDE THE " &
  42                       "INDEX SUBTYPE");
  43
  44      BEGIN
  45           DECLARE
  46                V : ARR2 (6..4, 9..11);
  47           BEGIN
  48                FAILED ("EXCEPTION NOT RAISED WHEN NON-NULL RANGE OF " &
  49                        "NULL INDEX CONSTRAINT HAS A BOUND OUTSIDE " &
  50                        "THE INDEX SUBTYPE (13) " & INTEGER'IMAGE(V'FIRST));
  51           END;
  52      EXCEPTION
  53           WHEN CONSTRAINT_ERROR =>
  54                NULL;
  55           WHEN OTHERS =>
  56                FAILED ("UNEXPECTED EXCEPTION RAISED - 13");
  57      END;
  58
  59      BEGIN
  60           DECLARE
  61                V : ARR2 (0..3, 8..7);
  62           BEGIN
  63                FAILED ("EXCEPTION NOT RAISED WHEN NON-NULL RANGE OF " &
  64                        "NULL INDEX CONSTRAINT HAS A BOUND OUTSIDE " &
  65                        "THE INDEX SUBTYPE (14) " & INTEGER'IMAGE(V'FIRST));
  66           END;
  67      EXCEPTION
  68           WHEN CONSTRAINT_ERROR =>
  69                NULL;
  70           WHEN OTHERS =>
  71                FAILED ("UNEXPECTED EXCEPTION RAISED - 14");
  72      END;
  73
  74      BEGIN
  75           DECLARE
  76                V : ARR2 (6..4, IDENT_INT(0)..2);
  77           BEGIN
  78                FAILED ("EXCEPTION NOT RAISED WHEN NON-NULL RANGE OF " &
  79                        "NULL INDEX CONSTRAINT HAS A BOUND OUTSIDE " &
  80                        "THE INDEX SUBTYPE (15) " & INTEGER'IMAGE(V'FIRST));
  81           END;
  82      EXCEPTION
  83           WHEN CONSTRAINT_ERROR =>
  84                NULL;
  85           WHEN OTHERS =>
  86                FAILED ("UNEXPECTED EXCEPTION RAISED - 15");
  87      END;
  88
  89      BEGIN
  90           DECLARE
  91                V : ARR2 (9..IDENT_INT(11), 6..4);
  92           BEGIN
  93                FAILED ("EXCEPTION NOT RAISED WHEN NON-NULL RANGE OF " &
  94                        "NULL INDEX CONSTRAINT HAS A BOUND OUTSIDE " &
  95                        "THE INDEX SUBTYPE (16) " & INTEGER'IMAGE(V'FIRST));
  96           END;
  97      EXCEPTION
  98           WHEN CONSTRAINT_ERROR =>
  99                NULL;
 100           WHEN OTHERS =>
 101                FAILED ("UNEXPECTED EXCEPTION RAISED - 16");
 102      END;
 103
 104      BEGIN
 105           DECLARE
 106                V : ARR2 (6..IDENT_INT(4), 9..IDENT_INT(11));
 107           BEGIN
 108                FAILED ("EXCEPTION NOT RAISED WHEN NON-NULL RANGE OF " &
 109                        "NULL INDEX CONSTRAINT HAS A BOUND OUTSIDE " &
 110                        "THE INDEX SUBTYPE (17) " & INTEGER'IMAGE(V'FIRST));
 111           END;
 112      EXCEPTION
 113           WHEN CONSTRAINT_ERROR =>
 114                NULL;
 115           WHEN OTHERS =>
 116                FAILED ("UNEXPECTED EXCEPTION RAISED - 17");
 117      END;
 118
 119      BEGIN
 120           DECLARE
 121                V : ARR2 (IDENT_INT(-1)..2, IDENT_INT(6)..4);
 122           BEGIN
 123                FAILED ("EXCEPTION NOT RAISED WHEN NON-NULL RANGE OF " &
 124                        "NULL INDEX CONSTRAINT HAS A BOUND OUTSIDE " &
 125                        "THE INDEX SUBTYPE (18) " & INTEGER'IMAGE(V'FIRST));
 126           END;
 127      EXCEPTION
 128           WHEN CONSTRAINT_ERROR =>
 129                NULL;
 130           WHEN OTHERS =>
 131                FAILED ("UNEXPECTED EXCEPTION RAISED - 18");
 132      END;
 133
 134      BEGIN
 135           DECLARE
 136                V : ARR2 (6..-1, 11..9);
 137           BEGIN
 138                IF NOT EQUAL (V'FIRST, V'FIRST) THEN
 139                     FAILED ("IMPOSSIBLE");
 140                END IF;
 141           END;
 142      EXCEPTION
 143           WHEN OTHERS =>
 144                FAILED ("EXCEPTION RAISED FOR NULL CONSTRAINT - 19");
 145      END;
 146
 147      BEGIN
 148           DECLARE
 149                V : ARR2 (IDENT_INT(11)..9, 6..IDENT_INT(0));
 150           BEGIN
 151                IF NOT EQUAL (V'FIRST, V'FIRST) THEN
 152                     FAILED ("IMPOSSIBLE");
 153                END IF;
 154           END;
 155      EXCEPTION
 156           WHEN OTHERS =>
 157                FAILED ("EXCEPTION RAISED FOR NULL CONSTRAINT - 20");
 158      END;
 159
 160      RESULT;
 161 END C36172B;