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 45WITH SYSTEM; 46WITH REPORT; 47PROCEDURE C55B15A IS 48 49 USE REPORT ; 50 51BEGIN 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 207END C55B15A ; 208