|
111
|
1 -- C36204C.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 -- OBJECTIVE:
|
|
|
26 -- CHECK THAT THE 'RANGE ATTRIBUTE CAN BE USED TO DECLARE OBJECTS
|
|
|
27 -- AND IN A SUBTYPE AND TYPE DECLARATION.
|
|
|
28
|
|
|
29 -- HISTORY:
|
|
|
30 -- LB 08/13/86 CREATED ORIGINAL TEST.
|
|
|
31 -- BCB 08/18/87 CHANGED HEADER TO STANDARD HEADER FORMAT.
|
|
|
32 -- REARRANGED STATEMENTS SO TEST IS CALLED FIRST.
|
|
|
33 -- ELIMINATED DEAD VARIABLE OPTIMIZATION. CHECKED
|
|
|
34 -- RANGE VALUES FOR A SMALL INTEGER.
|
|
|
35
|
|
|
36 WITH REPORT; USE REPORT;
|
|
|
37 PROCEDURE C36204C IS
|
|
|
38
|
|
|
39 BEGIN
|
|
|
40 TEST("C36204C","USING 'RANGE TO DECLARE OBJECTS AND " &
|
|
|
41 "IN A SUBTYPE AND TYPE DECLARATION " &
|
|
|
42 "RETURNS THE CORRECT VALUES.");
|
|
|
43
|
|
|
44 DECLARE
|
|
|
45
|
|
|
46 ARR : ARRAY(IDENT_INT(4) .. IDENT_INT(10)) OF INTEGER;
|
|
|
47 OBJ1 : ARRAY(ARR'RANGE) OF BOOLEAN;
|
|
|
48
|
|
|
49 SUBTYPE SMALL_INT IS INTEGER RANGE ARR'RANGE ;
|
|
|
50 SML : SMALL_INT;
|
|
|
51
|
|
|
52 TYPE OTHER_ARR IS ARRAY(ARR'RANGE) OF CHARACTER;
|
|
|
53 OBJ2 : OTHER_ARR;
|
|
|
54
|
|
|
55 TYPE ARR_TYPE IS ARRAY(INTEGER RANGE IDENT_INT(1) ..
|
|
|
56 IDENT_INT(10)) OF INTEGER;
|
|
|
57 TYPE ARR_PTR IS ACCESS ARR_TYPE;
|
|
|
58 PTR : ARR_PTR := NEW ARR_TYPE'(ARR_TYPE'RANGE => 0);
|
|
|
59
|
|
|
60 FUNCTION F RETURN ARR_TYPE IS
|
|
|
61 AR : ARR_TYPE := (ARR_TYPE'RANGE => 0);
|
|
|
62 BEGIN
|
|
|
63 RETURN AR;
|
|
|
64 END F;
|
|
|
65
|
|
|
66 BEGIN
|
|
|
67 BEGIN
|
|
|
68 IF OBJ1'FIRST /= IDENT_INT(4) THEN
|
|
|
69 FAILED("INCORRECT RANGE VALUE FOR AN OBJECT " &
|
|
|
70 "DECLARATION 1");
|
|
|
71 END IF;
|
|
|
72 EXCEPTION
|
|
|
73 WHEN OTHERS =>
|
|
|
74 FAILED("EXCEPTION RAISED WHEN CHECKING " &
|
|
|
75 "OBJECT DECLARATION 1");
|
|
|
76 END;
|
|
|
77
|
|
|
78 BEGIN
|
|
|
79 IF OBJ1'LAST /= IDENT_INT(10) THEN
|
|
|
80 FAILED("INCORRECT RANGE VALUE FOR AN OBJECT " &
|
|
|
81 "DECLARATION 2");
|
|
|
82 END IF;
|
|
|
83 EXCEPTION
|
|
|
84 WHEN OTHERS =>
|
|
|
85 FAILED("EXCEPTION RAISED WHEN CHECKING " &
|
|
|
86 "OBJECT DECLARATION 2");
|
|
|
87 END;
|
|
|
88
|
|
|
89 BEGIN
|
|
|
90 IF SMALL_INT'FIRST /= 4 THEN
|
|
|
91 FAILED("INCORRECT RANGE VALUE FOR A SMALL " &
|
|
|
92 "INTEGER DECLARATION 1");
|
|
|
93 END IF;
|
|
|
94 EXCEPTION
|
|
|
95 WHEN OTHERS =>
|
|
|
96 FAILED("EXCEPTION RAISED WHEN CHECKING SMALL" &
|
|
|
97 " INTEGER DECLARATION 1");
|
|
|
98 END;
|
|
|
99
|
|
|
100 BEGIN
|
|
|
101 IF SMALL_INT'LAST /= 10 THEN
|
|
|
102 FAILED("INCORRECT RANGE VALUE FOR A SMALL " &
|
|
|
103 "INTEGER DECLARATION 2");
|
|
|
104 END IF;
|
|
|
105 EXCEPTION
|
|
|
106 WHEN OTHERS =>
|
|
|
107 FAILED("EXCEPTION RAISED WHEN CHECKING SMALL" &
|
|
|
108 " INTEGER DECLARATION 2");
|
|
|
109 END;
|
|
|
110
|
|
|
111 BEGIN
|
|
|
112 SML := IDENT_INT(3) ;
|
|
|
113 IF SML = 3 THEN
|
|
|
114 COMMENT("VARIABLE SML OPTIMIZED VALUE 1");
|
|
|
115 END IF;
|
|
|
116 FAILED("NO EXCEPTION RAISED FOR OUT-OF RANGE " &
|
|
|
117 "VALUE 1");
|
|
|
118 EXCEPTION
|
|
|
119 WHEN CONSTRAINT_ERROR =>
|
|
|
120 NULL;
|
|
|
121 WHEN OTHERS =>
|
|
|
122 FAILED("WRONG EXCEPTION RAISED FOR OUT-OF " &
|
|
|
123 "RANGE VALUE 1");
|
|
|
124 END;
|
|
|
125
|
|
|
126 BEGIN
|
|
|
127 SML := IDENT_INT(11) ;
|
|
|
128 IF SML = 11 THEN
|
|
|
129 COMMENT("VARIABLE SML OPTIMIZED VALUE 2");
|
|
|
130 END IF;
|
|
|
131 FAILED("NO EXCEPTION RAISED FOR OUT-OF RANGE " &
|
|
|
132 "VALUE 2");
|
|
|
133 EXCEPTION
|
|
|
134 WHEN CONSTRAINT_ERROR =>
|
|
|
135 NULL;
|
|
|
136 WHEN OTHERS =>
|
|
|
137 FAILED("WRONG EXCEPTION RAISED FOR OUT-OF " &
|
|
|
138 "RANGE VALUE 2");
|
|
|
139 END;
|
|
|
140
|
|
|
141 BEGIN
|
|
|
142 IF OBJ2'FIRST /= IDENT_INT(4) THEN
|
|
|
143 FAILED("INCORRECT RANGE VALUE FOR A TYPE " &
|
|
|
144 "DECLARATION 1");
|
|
|
145 END IF;
|
|
|
146 EXCEPTION
|
|
|
147 WHEN OTHERS =>
|
|
|
148 FAILED("EXCEPTION RAISED WHEN CHECKING A " &
|
|
|
149 "TYPE DECLARATION 1");
|
|
|
150 END;
|
|
|
151
|
|
|
152 BEGIN
|
|
|
153 IF OBJ2'LAST /= IDENT_INT(10) THEN
|
|
|
154 FAILED("INCORRECT RANGE VALUE FOR A TYPE " &
|
|
|
155 "DECLARATION 2");
|
|
|
156 END IF;
|
|
|
157 EXCEPTION
|
|
|
158 WHEN OTHERS =>
|
|
|
159 FAILED("EXCEPTION RAISED WHEN CHECKING A " &
|
|
|
160 "TYPE DECLARATION 2");
|
|
|
161 END;
|
|
|
162
|
|
|
163 BEGIN
|
|
|
164 IF PTR'FIRST /= IDENT_INT(1) THEN
|
|
|
165 FAILED("INCORRECT RANGE VALUE FOR AN ACCESS " &
|
|
|
166 "TYPE DECLARATION 1");
|
|
|
167 END IF;
|
|
|
168 EXCEPTION
|
|
|
169 WHEN OTHERS =>
|
|
|
170 FAILED("EXCEPTION RAISED WHEN CHECKING AN " &
|
|
|
171 "ACCESS TYPE DECLARATION 1");
|
|
|
172 END;
|
|
|
173
|
|
|
174 BEGIN
|
|
|
175 IF PTR'LAST /= IDENT_INT(10) THEN
|
|
|
176 FAILED("INCORRECT RANGE VALUE FOR AN ACCESS " &
|
|
|
177 "TYPE DECLARATION 2");
|
|
|
178 END IF;
|
|
|
179 EXCEPTION
|
|
|
180 WHEN OTHERS =>
|
|
|
181 FAILED("EXCEPTION RAISED WHEN CHECKING AN " &
|
|
|
182 "ACCESS TYPE DECLARATION 2");
|
|
|
183 END;
|
|
|
184
|
|
|
185 DECLARE
|
|
|
186 OBJ_F1 : INTEGER RANGE F'RANGE ;
|
|
|
187 BEGIN
|
|
|
188 OBJ_F1 := IDENT_INT(0) ;
|
|
|
189 IF OBJ_F1 = 0 THEN
|
|
|
190 COMMENT("VARIABLE OBJ_F1 OPTIMIZED VALUE 1");
|
|
|
191 END IF;
|
|
|
192 FAILED("NO EXCEPTION RAISED FOR OUT-OF RANGE " &
|
|
|
193 "VALUE 3");
|
|
|
194 EXCEPTION
|
|
|
195 WHEN CONSTRAINT_ERROR =>
|
|
|
196 NULL;
|
|
|
197 WHEN OTHERS =>
|
|
|
198 FAILED("WRONG EXCEPTION RAISED FOR OUT-OF " &
|
|
|
199 "RANGE VALUE 3");
|
|
|
200 END;
|
|
|
201
|
|
|
202 DECLARE
|
|
|
203 OBJ_F2 : INTEGER RANGE F'RANGE ;
|
|
|
204 BEGIN
|
|
|
205 OBJ_F2 := IDENT_INT(11) ;
|
|
|
206 IF OBJ_F2 = 11 THEN
|
|
|
207 COMMENT("VARIABLE OBJ_F2 OPTIMIZED VALUE 1");
|
|
|
208 END IF;
|
|
|
209 FAILED("NO EXCEPTION RAISED FOR OUT-OF RANGE " &
|
|
|
210 "VALUE 4");
|
|
|
211 EXCEPTION
|
|
|
212 WHEN CONSTRAINT_ERROR =>
|
|
|
213 NULL;
|
|
|
214 WHEN OTHERS =>
|
|
|
215 FAILED("WRONG EXCEPTION RAISED FOR OUT-OF " &
|
|
|
216 "RANGE VALUE 4");
|
|
|
217 END;
|
|
|
218 END;
|
|
|
219 RESULT;
|
|
|
220
|
|
|
221 END C36204C;
|
