gcc/testsuite/ada/acats/tests/c5/c52005d.ada

   1 -- C52005D.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 CONSTRAINT_ERROR EXCEPTION IS RAISED WHEN A DYNAMIC
  26 --    EXPRESSION VALUE IS OUTSIDE THE STATIC RANGE OF INTEGER, BOOLEAN,
  27 --    CHARACTER, AND ENUMERATION ASSIGNMENT TARGET VARIABLES.
  28
  29 -- JRK 7/21/80
  30 -- SPS 3/21/83
  31
  32 WITH REPORT;
  33 PROCEDURE C52005D IS
  34
  35      USE REPORT;
  36
  37 BEGIN
  38      TEST ("C52005D", "CHECK THAT CONSTRAINT_ERROR EXCEPTION IS RAISED "
  39          & "ON DYNAMIC OUT OF RANGE INTEGER, BOOLEAN, CHARACTER, " &
  40            "AND ENUMERATION ASSIGNMENTS");
  41
  42 -------------------------
  43
  44      DECLARE
  45           I1 : INTEGER RANGE 0..10 := 5;
  46
  47      BEGIN
  48           I1 := IDENT_INT(11);
  49
  50           FAILED ("EXCEPTION NOT RAISED FOR OUT OF RANGE INT ASSNMT");
  51
  52      EXCEPTION
  53      WHEN CONSTRAINT_ERROR =>
  54           IF I1 /= 5 THEN
  55                FAILED ("VALUE ALTERED BEFORE INT RANGE EXCEPTION");
  56           END IF;
  57
  58      END;
  59
  60 -------------------------
  61
  62      DECLARE
  63           I2 : INTEGER RANGE 0..10 := 5;
  64
  65      BEGIN
  66           I2 := IDENT_INT(10);
  67
  68      EXCEPTION
  69      WHEN CONSTRAINT_ERROR =>
  70           FAILED ("EXCEPTION RAISED ON LEGAL INTEGER ASSIGNMENT");
  71      END;
  72
  73 -------------------------
  74
  75      DECLARE
  76           B1 : BOOLEAN RANGE TRUE..TRUE := TRUE;
  77
  78      BEGIN
  79           B1 := IDENT_BOOL(FALSE);
  80
  81           FAILED ("EXCEPTION NOT RAISED FOR OUT OF RANGE BOOL ASSNMT");
  82
  83      EXCEPTION
  84      WHEN CONSTRAINT_ERROR =>
  85           IF B1 /= TRUE THEN
  86                FAILED ("VALUE ALTERED BEFORE BOOLEAN RANGE EXCEPTION");
  87           END IF;
  88      END;
  89
  90 -------------------------
  91
  92      DECLARE
  93           B2 : BOOLEAN := TRUE;
  94
  95      BEGIN
  96           B2 := IDENT_BOOL(FALSE);
  97
  98      EXCEPTION
  99      WHEN CONSTRAINT_ERROR =>
 100           FAILED ("EXCEPTION RAISED ON LEGAL BOOLEAN ASSNMNT");
 101
 102      END;
 103
 104 -------------------------
 105
 106      DECLARE
 107           C1 : CHARACTER RANGE 'B'..'Z' := 'M';
 108
 109      BEGIN
 110           C1 := IDENT_CHAR('A');
 111           FAILED ("EXCEPTION NOT RAISED FOR OUT OF RANGE CHAR ASSNMNT");
 112
 113      EXCEPTION
 114      WHEN CONSTRAINT_ERROR =>
 115           IF C1 /= 'M' THEN
 116                FAILED ("VALUE ALTERED BEFORE CHARACTER RANGE " &
 117                        "EXCEPTION");
 118           END IF;
 119
 120      END;
 121
 122 -------------------------
 123
 124      DECLARE
 125           C2 : CHARACTER RANGE 'B'..'Z' := 'M';
 126
 127      BEGIN
 128           C2 := IDENT_CHAR('B');
 129
 130      EXCEPTION
 131      WHEN CONSTRAINT_ERROR =>
 132           FAILED ("EXCEPTION RAISED OF LEGAL CHARACTER ASSNMNT");
 133
 134      END;
 135
 136 -------------------------
 137
 138      DECLARE
 139           TYPE DAY IS (SUN, MON, TUE, WED, THU, FRI, SAT);
 140           ALLDAYS : DAY := TUE;
 141           WORKDAY : DAY RANGE MON..FRI := TUE;
 142
 143      BEGIN
 144           IF EQUAL(3,3) THEN
 145                ALLDAYS := SUN;
 146           END IF;
 147           WORKDAY := ALLDAYS;
 148
 149           FAILED ("EXCEPTION NOT RAISED FOR OUT OF RANGE ENUM. " &
 150                   "ASSIGNMENT");
 151
 152      EXCEPTION
 153      WHEN CONSTRAINT_ERROR =>
 154           IF WORKDAY /= TUE THEN
 155                FAILED ("VALUE ALTERED BEFORE ENUM. RANGE EXCEPTION");
 156           END IF;
 157
 158      END;
 159
 160 -------------------------
 161
 162      DECLARE
 163           TYPE DAY IS (SUN, MON, TUE, WED, THU, FRI, SAT);
 164           ALLDAYS : DAY := TUE;
 165           WORKDAY : DAY RANGE MON..FRI := TUE;
 166
 167      BEGIN
 168           IF EQUAL(3,3) THEN
 169                ALLDAYS := FRI;
 170           END IF;
 171           WORKDAY := ALLDAYS;
 172
 173      EXCEPTION
 174      WHEN CONSTRAINT_ERROR =>
 175           FAILED ("EXCEPTION RAISED ON LEGAL ENUM. ASSNMNT");
 176
 177      END;
 178
 179 -------------------------
 180
 181      RESULT;
 182 END C52005D;