old-autovect-branch/gcc/testsuite/ada/acats/tests/c5/c55b15a.ada

   1 -- C55B15A.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 IF A DISCRETE_RANGE OF THE FORM  'ST RANGE L..R'
  26 --    RAISES AN EXCEPTION BECAUSE  L  OR  R  IS A NON-STATIC
  27 --    EXPRESSION WHOSE VALUE IS OUTSIDE  THE RANGE OF VALUES
  28 --    ASSOCIATED WITH  ST  (OR BECAUSE  ST'FIRST  IS NON-STATIC
  29 --    AND  L  IS STATIC AND LESS THAN  ST'FIRST ; SIMILARLY FOR
  30 --     ST'LAST  AND  R ), CONTROL DOES NOT ENTER THE LOOP.
  31
  32 -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
  33 -- ***       remove incompatibilities associated with the transition   -- 9X
  34 -- ***       to Ada 9X.                                                -- 9X
  35 -- ***                                                                 -- 9X
  36
  37 -- RM  04/13/81
  38 -- SPS 11/01/82
  39 -- BHS 07/13/84
  40 -- EG  10/28/85  FIX NUMERIC_ERROR/CONSTRAINT_ERROR ACCORDING TO
  41 --               AI-00387.
  42 -- MRM 03/30/93  REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY
  43 -- GJD 11/15/95  REMOVED CASE OF POTENTIALLY STATICALLY INCOMPATIBLE RANGE.
  44
  45 WITH SYSTEM;
  46 WITH REPORT;
  47 PROCEDURE  C55B15A  IS
  48
  49      USE  REPORT ;
  50
  51 BEGIN
  52
  53      TEST( "C55B15A" , "WHEN  'FOR  I  IN  ST RANGE L..R  LOOP' "     &
  54                        "RAISES AN EXCEPTION, CONTROL DOES NOT ENTER " &
  55                        "THE BODY OF THE LOOP" );
  56
  57      -------------------------------------------------------------------
  58      ----------------- STATIC (SUB)TYPE, DYNAMIC RANGE -----------------
  59
  60      DECLARE
  61
  62           SUBTYPE  ST  IS  INTEGER RANGE 1..4 ;
  63
  64           FIRST   :  CONSTANT INTEGER := IDENT_INT( 1) ;
  65           SECOND  :  CONSTANT INTEGER := IDENT_INT( 2) ;
  66           THIRD   :  CONSTANT INTEGER := IDENT_INT( 3) ;
  67           FOURTH  :  CONSTANT INTEGER := IDENT_INT( 4) ;
  68           FIFTH   :  CONSTANT INTEGER := IDENT_INT( 5) ;
  69           TENTH   :  CONSTANT INTEGER := IDENT_INT(10) ;
  70           ZEROTH  :  CONSTANT INTEGER := IDENT_INT( 0) ;
  71
  72      BEGIN
  73
  74           BEGIN
  75
  76                FOR  I  IN  ST RANGE 3..TENTH  LOOP
  77                     FAILED( "EXCEPTION NOT RAISED (I1)" );
  78                END LOOP;
  79
  80           EXCEPTION
  81
  82                WHEN  CONSTRAINT_ERROR => NULL ;
  83                WHEN  OTHERS           =>
  84                     FAILED( "WRONG EXCEPTION RAISED (I1)" );
  85
  86           END ;
  87
  88
  89           BEGIN
  90
  91                FOR  I  IN  ST RANGE 0..THIRD  LOOP
  92                     FAILED( "EXCEPTION NOT RAISED (I2)" );
  93                END LOOP;
  94
  95           EXCEPTION
  96
  97                WHEN  CONSTRAINT_ERROR => NULL ;
  98                WHEN  OTHERS           =>
  99                     FAILED( "WRONG EXCEPTION RAISED (I2)" );
 100
 101           END ;
 102      END ;
 103
 104
 105      -------------------------------------------------------------------
 106      ----------------- DYNAMIC (SUB)TYPE, STATIC RANGE -----------------
 107
 108      DECLARE
 109
 110           TYPE  ENUM   IS  ( AMINUS , A,B,C,D,E,  F,G,H,I,J );
 111
 112           SUBTYPE  ST  IS  ENUM RANGE ENUM'VAL( IDENT_INT( 1) ) ..
 113                                       ENUM'VAL( IDENT_INT( 4) ) ;
 114
 115           FIRST   :  CONSTANT ENUM := A ;
 116           SECOND  :  CONSTANT ENUM := B ;
 117           THIRD   :  CONSTANT ENUM := C ;
 118           FOURTH  :  CONSTANT ENUM := D ;
 119           FIFTH   :  CONSTANT ENUM := E ;
 120           TENTH   :  CONSTANT ENUM := J ;
 121           ZEROTH  :  CONSTANT ENUM := AMINUS ;
 122
 123      BEGIN
 124
 125           BEGIN
 126
 127                FOR  I  IN  ST RANGE C..TENTH  LOOP
 128                     FAILED( "EXCEPTION NOT RAISED (E1)" );
 129                END LOOP;
 130
 131           EXCEPTION
 132
 133                WHEN  CONSTRAINT_ERROR => NULL ;
 134                WHEN  OTHERS           =>
 135                     FAILED( "WRONG EXCEPTION RAISED (E1)" );
 136
 137           END ;
 138
 139
 140           BEGIN
 141
 142                FOR  I  IN  ST RANGE AMINUS..THIRD  LOOP
 143                     FAILED( "EXCEPTION NOT RAISED (E2)" );
 144                END LOOP;
 145
 146           EXCEPTION
 147
 148                WHEN  CONSTRAINT_ERROR => NULL ;
 149                WHEN  OTHERS           =>
 150                     FAILED( "WRONG EXCEPTION RAISED (E2)" );
 151
 152           END ;
 153
 154      END ;
 155
 156
 157      DECLARE
 158
 159           SUBTYPE  ST  IS  CHARACTER RANGE IDENT_CHAR( 'A' ) ..
 160                                            IDENT_CHAR( 'D' ) ;
 161
 162           FIRST   :  CONSTANT CHARACTER := 'A' ;
 163           SECOND  :  CONSTANT CHARACTER := 'B' ;
 164           THIRD   :  CONSTANT CHARACTER := 'C' ;
 165           FOURTH  :  CONSTANT CHARACTER := 'D' ;
 166           FIFTH   :  CONSTANT CHARACTER := 'E' ;
 167           TENTH   :  CONSTANT CHARACTER := 'J' ;
 168           ZEROTH  :  CONSTANT CHARACTER := '0' ;--ZERO; PRECEDES LETTERS
 169
 170      BEGIN
 171
 172           BEGIN
 173
 174                FOR  I  IN  ST RANGE 'C'..TENTH  LOOP
 175                     FAILED( "EXCEPTION NOT RAISED (C1)" );
 176                END LOOP;
 177
 178           EXCEPTION
 179
 180                WHEN  CONSTRAINT_ERROR => NULL ;
 181                WHEN  OTHERS           =>
 182                     FAILED( "WRONG EXCEPTION RAISED (C1)" );
 183
 184           END ;
 185
 186
 187           BEGIN
 188
 189                FOR  I  IN  ST RANGE '0'..THIRD  LOOP -- ZERO..'C'
 190                     FAILED( "EXCEPTION NOT RAISED (C2)" );
 191                END LOOP;
 192
 193           EXCEPTION
 194
 195                WHEN  CONSTRAINT_ERROR => NULL ;
 196                WHEN  OTHERS           =>
 197                     FAILED( "WRONG EXCEPTION RAISED (C2)" );
 198
 199           END ;
 200
 201      END ;
 202
 203
 204      RESULT ;
 205
 206
 207 END  C55B15A ;