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

   1 -- C37008A.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 SPECIFYING AN INVALID DEFAULT INITIALIZATION
  26 -- RAISES CONSTRAINT_ERROR WHEN AN OBJECT IS DECLARED.
  27
  28 -- DAT 3/6/81
  29 -- SPS 10/26/82
  30 -- RJW 1/9/86 -  REVISED COMMENTS. ADDED 'IDENT_INT'.
  31 -- EDS 7/22/98   AVOID OPTIMIZATION
  32
  33 WITH REPORT;
  34 USE REPORT;
  35 PROCEDURE C37008A IS
  36 BEGIN
  37      TEST ("C37008A", "CHECK THAT INVALID DEFAULT RECORD"
  38                     & " COMPONENT INITIALIZATIONS RAISE"
  39                     & " CONSTRAINT_ERROR");
  40
  41      BEGIN
  42           DECLARE
  43                TYPE R1 IS RECORD
  44                     C1 : INTEGER RANGE 1 .. 5 := IDENT_INT (0);
  45                END RECORD;
  46                REC1 : R1;
  47           BEGIN
  48                FAILED ("NO EXCEPTION RAISED 1 " & INTEGER'IMAGE(REC1.C1));
  49           END;
  50      EXCEPTION
  51           WHEN CONSTRAINT_ERROR => NULL;
  52           WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED 1");
  53      END;
  54
  55      BEGIN
  56           DECLARE
  57                TYPE R IS RECORD
  58                     C : CHARACTER RANGE 'A' .. 'Y' := 'Z';
  59                END RECORD;
  60                REC2 : R;
  61           BEGIN
  62                FAILED ("NO EXCEPTION RAISED 1A " & (REC2.C));
  63           END;
  64      EXCEPTION
  65           WHEN CONSTRAINT_ERROR => NULL;
  66           WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED 1A");
  67      END;
  68
  69      BEGIN
  70           DECLARE
  71                TYPE R2 IS RECORD
  72                     C2 : BOOLEAN RANGE FALSE .. FALSE := TRUE;
  73                END RECORD;
  74                REC3 : R2;
  75           BEGIN
  76                FAILED ("NO EXCEPTION RAISED 2 " & BOOLEAN'IMAGE(REC3.C2));
  77           END;
  78      EXCEPTION
  79           WHEN CONSTRAINT_ERROR => NULL;
  80           WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED 2");
  81      END;
  82
  83      BEGIN
  84           DECLARE
  85                TYPE E IS (E1, E2, E3);
  86                TYPE R IS RECORD
  87                     C : E RANGE E2 .. E3 := E1;
  88                END RECORD;
  89                REC4 : R;
  90           BEGIN
  91                FAILED ("NO EXCEPTION RAISED 2A " & E'IMAGE(REC4.C));
  92           END;
  93      EXCEPTION
  94           WHEN CONSTRAINT_ERROR => NULL;
  95           WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED 2A");
  96      END;
  97
  98      BEGIN
  99           DECLARE
 100                TYPE R3 IS RECORD
 101                     C3 : INTEGER RANGE 1 .. 5;
 102                END RECORD;
 103                REC5 : R3;
 104                TYPE R3A IS RECORD
 105                     C3A : R3 := (OTHERS => IDENT_INT (6));
 106                END RECORD;
 107                REC6 : R3A;
 108           BEGIN
 109                FAILED ("NO EXCEPTION RAISED 3 " &
 110                        INTEGER'IMAGE(REC6.C3A.C3));
 111           END;
 112      EXCEPTION
 113           WHEN CONSTRAINT_ERROR => NULL;
 114           WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED 3");
 115      END;
 116
 117      BEGIN
 118           DECLARE
 119                TYPE ARR IS ARRAY (1..3) OF INTEGER RANGE 8..9;
 120                TYPE R4 IS RECORD
 121                     C4 : ARR
 122                          := (1 => 8, 2 => 9, 3 => 10);
 123                END RECORD;
 124                REC7 : R4;
 125           BEGIN
 126                FAILED ("NO EXCEPTION RAISED 4 " &
 127                        INTEGER'IMAGE(REC7.C4(1)));
 128           END;
 129      EXCEPTION
 130           WHEN CONSTRAINT_ERROR => NULL;
 131           WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED 4");
 132      END;
 133
 134      BEGIN
 135           DECLARE
 136                TYPE A IS ARRAY (NATURAL RANGE <> )
 137                     OF INTEGER RANGE 1 .. 5;
 138
 139                TYPE AA IS ACCESS A;
 140
 141                TYPE R5 IS RECORD
 142                     C5 : AA := NEW A' (4, 5, 6);
 143                END RECORD;
 144                REC8 : R5;
 145           BEGIN
 146                FAILED ("NO EXCEPTION RAISED 5 " &
 147                        INTEGER'IMAGE(REC8.C5(1)));
 148           END;
 149      EXCEPTION
 150           WHEN CONSTRAINT_ERROR => NULL;
 151           WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED 5");
 152      END;
 153
 154      BEGIN
 155           DECLARE
 156                TYPE A IS ARRAY (NATURAL RANGE <> )
 157                     OF INTEGER RANGE 1 .. 5;
 158
 159                TYPE AA IS ACCESS A (1 .. 3);
 160
 161                TYPE R6 IS RECORD
 162                     C6 : AA := NEW A' (4, 4, 4, 4);
 163                END RECORD;
 164                REC9 : R6;
 165           BEGIN
 166                FAILED ("NO EXCEPTION RAISED 6 " &
 167                        INTEGER'IMAGE(REC9.C6(1)));
 168           END;
 169      EXCEPTION
 170           WHEN CONSTRAINT_ERROR => NULL;
 171           WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED 6");
 172      END;
 173
 174      BEGIN
 175           DECLARE
 176                TYPE AI IS ACCESS INTEGER RANGE 6 .. 8;
 177
 178                TYPE R7 IS RECORD
 179                     C7 : AI := NEW INTEGER' (5);
 180                END RECORD;
 181                REC10 : R7;
 182           BEGIN
 183                FAILED ("NO EXCEPTION RAISED 7 " &
 184                        INTEGER'IMAGE(REC10.C7.ALL));
 185           END;
 186      EXCEPTION
 187           WHEN CONSTRAINT_ERROR => NULL;
 188           WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED 7");
 189      END;
 190
 191      BEGIN
 192           DECLARE
 193                TYPE UA IS ARRAY (NATURAL RANGE <> )
 194                     OF INTEGER RANGE 3 .. 5;
 195
 196                SUBTYPE CA IS UA (7 .. 8);
 197
 198                TYPE R8 IS RECORD
 199                     C8 : CA := (6 .. 8 => 4);
 200                END RECORD;
 201                REC11 : R8;
 202           BEGIN
 203                FAILED ("NO EXCEPTION RAISED 8 " &
 204                        INTEGER'IMAGE(REC11.C8(7)));
 205           END;
 206      EXCEPTION
 207           WHEN CONSTRAINT_ERROR => NULL;
 208           WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED 8");
 209      END;
 210
 211      BEGIN
 212           DECLARE
 213                TYPE UA IS ARRAY (NATURAL RANGE <> )
 214                     OF INTEGER RANGE 3 .. IDENT_INT(5);
 215
 216                TYPE R9 IS RECORD
 217                     C9 : UA (11 .. 11) := (11 => 6);
 218                END RECORD;
 219                REC12 : R9;
 220           BEGIN
 221                FAILED ("NO EXCEPTION RAISED 9 " &
 222                        INTEGER'IMAGE(REC12.C9(11)));
 223           END;
 224      EXCEPTION
 225           WHEN CONSTRAINT_ERROR => NULL;
 226           WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED 9");
 227      END;
 228
 229      BEGIN
 230           DECLARE
 231                TYPE A IS ARRAY (NATURAL RANGE <> )
 232                     OF INTEGER RANGE 1 .. IDENT_INT (5);
 233
 234                TYPE AA IS ACCESS A;
 235
 236                TYPE R10 IS RECORD
 237                     C10 : AA := NEW A '(4, 5, 6);
 238                END RECORD;
 239                REC13 : R10;
 240           BEGIN
 241                FAILED ("NO EXCEPTION RAISED 10 " &
 242                        INTEGER'IMAGE(REC13.C10(1)));
 243           END;
 244      EXCEPTION
 245           WHEN CONSTRAINT_ERROR => NULL;
 246           WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED 10");
 247      END;
 248
 249      BEGIN
 250           DECLARE
 251                TYPE A IS ARRAY (NATURAL RANGE <> )
 252                     OF INTEGER RANGE 1 .. 5;
 253
 254                TYPE AA IS ACCESS A (IDENT_INT (1) .. IDENT_INT (3));
 255
 256                TYPE R11 IS RECORD
 257                     C11 : AA := NEW A '(4, 4, 4, 4);
 258                END RECORD;
 259                REC14 : R11;
 260           BEGIN
 261                FAILED ("NO EXCEPTION RAISED 11 " &
 262                        INTEGER'IMAGE(REC14.C11(1)));
 263           END;
 264      EXCEPTION
 265           WHEN CONSTRAINT_ERROR => NULL;
 266           WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED 11");
 267      END;
 268
 269      RESULT;
 270 END C37008A;