1-- C36104A.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 CONSTRAINT_ERROR IS RAISED OR NOT, AS APPROPRIATE, 26-- DURING DISCRETE_RANGE ELABORATIONS/EVALUATIONS IN LOOPS, 27-- ARRAY_TYPE_DEFINITIONS, ARRAY AGGREGATES, SLICES, 28-- AND INDEX CONSTRAINTS IN OBJECT AND TYPE DECLARATIONS, 29-- WHERE AN EXPLICIT (SUB)TYPE IS INCLUDED IN EACH DISCRETE_RANGE. 30-- MEMBERSHIP OPERATORS ARE CHECKED HERE, ALSO, TO ENSURE THAT 31-- EXCEPTIONS ARE NOT RAISED FOR NULL RANGES. 32-- ONLY STATIC CASES ARE CHECKED HERE. 33 34-- DAT 2/3/81 35-- JRK 2/25/81 36-- VKG 1/21/83 37-- L.BROWN 7/15/86 1) ADDED ACCESS TYPES. 38-- 2) DELETED "NULL INDEX RANGES, CONSTRAINT_ERROR 39-- RAISED" SECTION. 40-- 3) DELETED ANY MENTION OF CASE STATEMENT CHOICES 41-- AND VARIANT CHOICES IN THE ABOVE COMMENT. 42-- EDS 7/16/98 AVOID OPTIMIZATION 43 44WITH REPORT; 45PROCEDURE C36104A IS 46 47 USE REPORT; 48 49 TYPE WEEK IS (SUN, MON, TUE, WED, THU, FRI, SAT); 50 TYPE WEEK_ARRAY IS ARRAY (WEEK RANGE <>) OF WEEK; 51 SUBTYPE WORK_WEEK IS WEEK RANGE MON .. FRI; 52 SUBTYPE MID_WEEK IS WORK_WEEK RANGE TUE .. THU; 53 54 TYPE INT_10 IS NEW INTEGER RANGE -10 .. 10; 55 TYPE I_10 IS NEW INT_10; 56 SUBTYPE I_5 IS I_10 RANGE -5 .. 5; 57 TYPE I_5_ARRAY IS ARRAY (I_5 RANGE <>) OF I_5; 58 59BEGIN 60 TEST ("C36104A", "CONSTRAINT_ERROR IS RAISED OR NOT IN STATIC " 61 & "DISCRETE_RANGES WITH EXPLICIT TYPE_MARKS"); 62 63 -- NON-NULL RANGES, CONSTRAINT_ERROR RAISED. 64 65 BEGIN 66 DECLARE 67 TYPE A IS ARRAY (I_5 RANGE 0 .. 6) OF I_5; 68 -- ABOVE DECLARATION RAISES CONSTRAINT_ERROR. 69 BEGIN 70 DECLARE 71 -- DEFINE AN OBJECT OF TYPE A AND USE IT TO AVOID 72 -- OPTIMIZATION OF SUBTYPE 73 A1 : A := (OTHERS => I_5(IDENT_INT(1))); 74 BEGIN 75 FAILED ("CONSTRAINT_ERROR NOT RAISED 1 " & 76 I_5'IMAGE(A1(1)) ); --USE A1 77 END; 78 EXCEPTION 79 --MAKE SURE THAT CONSTRAINT_ERROR FROM ABOVE STATEMENTS 80 --REPORT FAILED. 81 WHEN OTHERS => FAILED ("UNHANDLED EXCEPTION RAISED 1"); 82 END; 83 EXCEPTION 84 WHEN CONSTRAINT_ERROR => NULL; 85 WHEN OTHERS => 86 FAILED ("WRONG EXCEPTION RAISED 1"); 87 END; 88 89 BEGIN 90 FOR I IN MID_WEEK RANGE MON .. MON LOOP 91 FAILED ("CONSTRAINT_ERROR NOT RAISED 3"); 92 END LOOP; 93 FAILED ("CONSTRAINT_ERROR NOT RAISED 3"); 94 EXCEPTION 95 WHEN CONSTRAINT_ERROR => NULL; 96 WHEN OTHERS => 97 FAILED ("WRONG EXCEPTION RAISED 3"); 98 END; 99 100 BEGIN 101 DECLARE 102 TYPE P IS ACCESS I_5_ARRAY (I_5 RANGE 0 .. 6); 103 -- ABOVE DECLARATION RAISES CONSTRAINT_ERROR. 104 BEGIN 105 DECLARE 106 TYPE PA IS NEW P; 107 -- DEFINE AN OBJECT OF TYPE PA AND USE IT TO AVOID 108 -- OPTIMIZATION OF TYPE 109 PA1 : PA := NEW I_5_ARRAY'(0 .. I_5(IDENT_INT(6)) => 110 I_5(IDENT_INT(1))); 111 BEGIN 112 FAILED ("CONSTRAINT_ERROR NOT RAISED 4 " & 113 I_5'IMAGE(PA1(1))); --USE PA1 114 END; 115 EXCEPTION 116 WHEN OTHERS => FAILED ("UNHANDLED EXCEPTION RAISED 4"); 117 END; 118 EXCEPTION 119 WHEN CONSTRAINT_ERROR => NULL; 120 WHEN OTHERS => 121 FAILED ("WRONG EXCEPTION RAISED 4"); 122 END; 123 124 DECLARE 125 W : WEEK_ARRAY (MID_WEEK); 126 BEGIN 127 W := (MID_WEEK RANGE MON .. WED => WED); 128 -- CONSTRAINT_ERROR RAISED. 129 FAILED ("CONSTRAINT_ERROR NOT RAISED 7 " & 130 MID_WEEK'IMAGE(W(WED))); --USE W 131 EXCEPTION 132 WHEN CONSTRAINT_ERROR => NULL; 133 WHEN OTHERS => 134 FAILED ("WRONG EXCEPTION RAISED 7"); 135 END; 136 137 DECLARE 138 W : WEEK_ARRAY (WORK_WEEK); 139 BEGIN 140 W := (W'RANGE => WED); -- OK. 141 W (MON .. WED) := W (MID_WEEK RANGE MON .. WED); -- EXCEPTION. 142 FAILED ("CONSTRAINT_ERROR NOT RAISED 8 " & 143 MID_WEEK'IMAGE(W(WED))); --USE W 144 EXCEPTION 145 WHEN CONSTRAINT_ERROR => NULL; 146 WHEN OTHERS => 147 FAILED ("WRONG EXCEPTION RAISED 8"); 148 END; 149 150 BEGIN 151 DECLARE 152 W : WEEK_ARRAY (MID_WEEK RANGE MON .. FRI); 153 -- ELABORATION OF ABOVE RAISES CONSTRAINT_ERROR. 154 BEGIN 155 W := (W'RANGE => WED); -- OK. 156 FAILED ("CONSTRAINT_ERROR NOT RAISED 9 " & 157 MID_WEEK'IMAGE(W(WED))); --USE W 158 EXCEPTION 159 WHEN OTHERS => FAILED ("UNHANDLED EXCEPTION RAISED 9"); 160 END; 161 EXCEPTION 162 WHEN CONSTRAINT_ERROR => NULL; 163 WHEN OTHERS => 164 FAILED ("WRONG EXCEPTION RAISED 9"); 165 END; 166 167 BEGIN 168 DECLARE 169 TYPE W IS NEW WEEK_ARRAY (MID_WEEK RANGE SUN .. TUE); 170 -- RAISES CONSTRAINT_ERROR. 171 BEGIN 172 DECLARE 173 W1 : W := (OTHERS => WED); 174 BEGIN 175 FAILED ("CONSTRAINT_ERROR NOT RAISED 10 " & 176 MID_WEEK'IMAGE(W1(WED))); --USE W1 177 END; 178 EXCEPTION 179 WHEN OTHERS => FAILED ("UNHANDLED EXCEPTION RAISED 10"); 180 END; 181 EXCEPTION 182 WHEN CONSTRAINT_ERROR => NULL; 183 WHEN OTHERS => 184 FAILED ("WRONG EXCEPTION RAISED 10"); 185 END; 186 187 BEGIN 188 DECLARE 189 SUBTYPE W IS WEEK_ARRAY (MID_WEEK RANGE MON .. WED); 190 -- RAISES CONSTRAINT_ERROR. 191 BEGIN 192 DECLARE 193 W1 : W := (OTHERS => (WED)); 194 BEGIN 195 FAILED ("CONSTRAINT_ERROR NOT RAISED 8 " & 196 MID_WEEK'IMAGE(W1(WED))); --USE W1 197 END; 198 EXCEPTION 199 WHEN OTHERS => FAILED ("UNHANDLED EXCEPTION RAISED 8"); 200 END; 201 EXCEPTION 202 WHEN CONSTRAINT_ERROR => NULL; 203 WHEN OTHERS => 204 FAILED ("WRONG EXCEPTION RAISED 11"); 205 END; 206 207 -- NULL DISCRETE/INDEX RANGES, EXCEPTION NOT RAISED. 208 209 BEGIN 210 DECLARE 211 TYPE A IS ARRAY (I_5 RANGE -5 .. -6) OF I_5; 212 A1 : A; 213 BEGIN 214 IF A1'FIRST /= I_5(IDENT_INT(-5)) THEN 215 FAILED ("'FIRST OF NULL ARRAY INCORRECT"); 216 END IF; 217 END; 218 EXCEPTION 219 WHEN OTHERS => FAILED ("EXCEPTION RAISED 1"); 220 END; 221 222 BEGIN 223 FOR I IN MID_WEEK RANGE SAT .. SUN LOOP 224 FAILED("LOOP WAS EXECUTED WITH NULL DISCRETE/INDEX RANGES"); 225 END LOOP; 226 FOR I IN MID_WEEK RANGE FRI .. WED LOOP 227 FAILED("LOOP WAS EXECUTED WITH NULL DISCRETE/INDEX RANGES"); 228 END LOOP; 229 FOR I IN MID_WEEK RANGE MON .. SUN LOOP 230 FAILED("LOOP WAS EXECUTED WITH NULL DISCRETE/INDEX RANGES"); 231 END LOOP; 232 FOR I IN I_5 RANGE 10 .. -10 LOOP 233 FAILED("LOOP WAS EXECUTED WITH NULL DISCRETE/INDEX RANGES"); 234 END LOOP; 235 FOR I IN I_5 RANGE 10 .. 9 LOOP 236 FAILED("LOOP WAS EXECUTED WITH NULL DISCRETE/INDEX RANGES"); 237 END LOOP; 238 FOR I IN I_5 RANGE -10 .. -11 LOOP 239 FAILED("LOOP WAS EXECUTED WITH NULL DISCRETE/INDEX RANGES"); 240 END LOOP; 241 FOR I IN I_5 RANGE -10 .. -20 LOOP 242 FAILED("LOOP WAS EXECUTED WITH NULL DISCRETE/INDEX RANGES"); 243 END LOOP; 244 FOR I IN I_5 RANGE 6 .. 5 LOOP 245 FAILED("LOOP WAS EXECUTED WITH NULL DISCRETE/INDEX RANGES"); 246 END LOOP; 247 EXCEPTION 248 WHEN OTHERS => FAILED ("EXCEPTION RAISED 3"); 249 END; 250 251 BEGIN 252 DECLARE 253 TYPE P IS ACCESS I_5_ARRAY (-5 .. -6); 254 PA1 : P := NEW I_5_ARRAY (-5 .. -6); 255 BEGIN 256 IF PA1'LENGTH /= IDENT_INT(0) THEN 257 FAILED ("'LENGTH OF NULL ARRAY INCORRECT"); 258 END IF; 259 END; 260 EXCEPTION 261 WHEN OTHERS => 262 FAILED ("EXCEPTION RAISED 5"); 263 END; 264 265 DECLARE 266 TYPE NARR IS ARRAY(INTEGER RANGE <>) OF INTEGER; 267 SUBTYPE SNARR IS INTEGER RANGE 1 .. 2; 268 W : NARR(SNARR) := (1,2); 269 BEGIN 270 IF W = (SNARR RANGE IDENT_INT(4) .. 2 => 5) THEN 271 FAILED("EVALUATION OF EXPRESSION IS INCORRECT"); 272 END IF; 273 EXCEPTION 274 WHEN OTHERS => FAILED ("EXCEPTION RAISED 7"); 275 END; 276 277 DECLARE 278 W : WEEK_ARRAY (MID_WEEK); 279 BEGIN 280 W := (W'RANGE => WED); -- OK. 281 W (TUE .. MON) := W (MID_WEEK RANGE MON .. SUN); 282 EXCEPTION 283 WHEN OTHERS => FAILED ("EXCEPTION RAISED 8"); 284 END; 285 286 BEGIN 287 DECLARE 288 W : WEEK_ARRAY (MID_WEEK RANGE MON .. SUN); 289 BEGIN 290 IF (W'FIRST /= MON) THEN 291 FAILED ("'FIRST OF NULL ARRAY INCORRECT"); 292 END IF; 293 END; 294 EXCEPTION 295 WHEN OTHERS => FAILED ("EXCEPTION RAISED 9"); 296 END; 297 298 BEGIN 299 DECLARE 300 TYPE W IS NEW WEEK_ARRAY (MID_WEEK RANGE TUE .. MON); 301 W1 : W; 302 BEGIN 303 IF (W1'FIRST /= TUE) THEN 304 FAILED ("'FIRST OF NULL ARRAY INCORRECT"); 305 END IF; 306 END; 307 EXCEPTION 308 WHEN OTHERS => FAILED ("EXCEPTION RAISED 10"); 309 END; 310 311 BEGIN 312 DECLARE 313 SUBTYPE W IS WEEK_ARRAY (MID_WEEK RANGE TUE .. MON); 314 W1 : W; 315 BEGIN 316 IF (W1'FIRST /= TUE) THEN 317 FAILED ("'FIRST OF NULL ARRAY INCORRECT"); 318 END IF; 319 END; 320 EXCEPTION 321 WHEN OTHERS => FAILED ("EXCEPTION RAISED 12"); 322 END; 323 324 -- NULL MEMBERSHIP RANGES, EXCEPTION NOT RAISED. 325 326 BEGIN 327 IF SUN IN SAT .. SUN 328 OR SAT IN FRI .. WED 329 OR WED IN THU .. TUE 330 OR THU IN MON .. SUN 331 OR FRI IN SAT .. FRI 332 OR WED IN FRI .. MON 333 THEN 334 FAILED ("INCORRECT 'IN' EVALUATION 1"); 335 END IF; 336 337 IF INTEGER'(0) IN 10 .. -10 338 OR INTEGER'(0) IN 10 .. 9 339 OR INTEGER'(0) IN -10 .. -11 340 OR INTEGER'(0) IN -10 .. -20 341 OR INTEGER'(0) IN 6 .. 5 342 OR INTEGER'(0) IN 5 .. 3 343 OR INTEGER'(0) IN 7 .. 3 344 THEN 345 FAILED ("INCORRECT 'IN' EVALUATION 2"); 346 END IF; 347 348 IF WED NOT IN THU .. TUE 349 AND INTEGER'(0) NOT IN 4 .. -4 350 THEN NULL; 351 ELSE FAILED ("INCORRECT 'NOT IN' EVALUATION"); 352 END IF; 353 EXCEPTION 354 WHEN OTHERS => FAILED ("EXCEPTION RAISED 52"); 355 END; 356 357 358 RESULT; 359END C36104A; 360