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