1-- C32115B.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 WHEN A VARIABLE OR CONSTANT HAVING AN UNCONSTRAINED 27-- ACCESS TYPE IS DECLARED WITH AN INITIAL NON-NULL ACCESS VALUE, 28-- CONSTRAINT_ERROR IS RAISED IF AN INDEX BOUND OR A DISCRIMINANT 29-- VALUE OF THE DESIGNATED OBJECT DOES NOT EQUAL THE CORRESPONDING 30-- VALUE SPECIFIED FOR THE ACCESS SUBTYPE OF THE OBJECT. 31 32-- HISTORY: 33-- JET 08/05/87 CREATED ORIGINAL TEST BASED ON C32115A BY RJW 34-- BUT WITH UNCONSTRAINED ACCESS TYPES AND 35-- CONSTRAINED VARIABLE/CONSTANT DECLARATIONS. 36-- KAS 12/4/95 FIXED TYPO IN CALL TO REPORT.TEST 37 38WITH REPORT; USE REPORT; 39 40PROCEDURE C32115B IS 41 42 PACKAGE PKG IS 43 TYPE PRIV (D : INTEGER) IS PRIVATE; 44 45 PRIVATE 46 TYPE PRIV (D : INTEGER) IS 47 RECORD 48 NULL; 49 END RECORD; 50 END PKG; 51 52 USE PKG; 53 54 TYPE ACCP IS ACCESS PRIV; 55 56 TYPE REC (D : INTEGER) IS 57 RECORD 58 NULL; 59 END RECORD; 60 61 TYPE ACCR IS ACCESS REC; 62 63 TYPE ARR IS ARRAY (NATURAL RANGE <>) OF INTEGER; 64 65 TYPE ACCA IS ACCESS ARR; 66 67 TYPE ACCN IS ACCESS ARR; 68 69BEGIN 70 TEST ("C32115B", "CHECK THAT WHEN CONSTRAINED VARIABLE OR " & 71 "CONSTANT HAVING AN UNCONSTRAINED ACCESS TYPE " & 72 "IS DECLARED WITH AN INITIAL NON-NULL ACCESS " & 73 "VALUE, CONSTRAINT_ERROR IS RAISED IF AN " & 74 "INDEX BOUND OR A DISCRIMINANT VALUE OF THE " & 75 "DESIGNATED OBJECT DOES NOT EQUAL THE " & 76 "CORRESPONDING VALUE SPECIFIED FOR THE " & 77 "ACCESS SUBTYPE OF THE OBJECT" ); 78 79 BEGIN 80 DECLARE 81 AC1 : CONSTANT ACCP(1) := NEW PRIV (IDENT_INT (2)); 82 BEGIN 83 FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & 84 "OF CONSTANT 'AC1'" ); 85 IF AC1 /= NULL THEN 86 COMMENT ("DEFEAT 'AC1' OPTIMIZATION"); 87 END IF; 88 END; 89 EXCEPTION 90 WHEN CONSTRAINT_ERROR => 91 NULL; 92 WHEN OTHERS => 93 FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & 94 "OF CONSTANT 'AC1'" ); 95 END; 96 97 BEGIN 98 DECLARE 99 AC2 : ACCP(1) := NEW PRIV (IDENT_INT (2)); 100 BEGIN 101 FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & 102 "OF VARIABLE 'AC2'" ); 103 IF AC2 /= NULL THEN 104 COMMENT ("DEFEAT 'AC2' OPTIMIZATION"); 105 END IF; 106 END; 107 EXCEPTION 108 WHEN CONSTRAINT_ERROR => 109 NULL; 110 WHEN OTHERS => 111 FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & 112 "OF VARIABLE 'AC2'" ); 113 END; 114 115 BEGIN 116 DECLARE 117 AC3 : CONSTANT ACCP(1) := NEW PRIV (IDENT_INT (0)); 118 BEGIN 119 FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & 120 "OF CONSTANT 'AC3'" ); 121 IF AC3 /= NULL THEN 122 COMMENT ("DEFEAT 'AC3' OPTIMIZATION"); 123 END IF; 124 END; 125 EXCEPTION 126 WHEN CONSTRAINT_ERROR => 127 NULL; 128 WHEN OTHERS => 129 FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & 130 "OF CONSTANT 'AC3'" ); 131 END; 132 133 BEGIN 134 DECLARE 135 AC4 : ACCP(1) := NEW PRIV (IDENT_INT (0)); 136 BEGIN 137 FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & 138 "OF VARIABLE 'AC4'" ); 139 IF AC4 /= NULL THEN 140 COMMENT ("DEFEAT 'AC4' OPTIMIZATION"); 141 END IF; 142 END; 143 EXCEPTION 144 WHEN CONSTRAINT_ERROR => 145 NULL; 146 WHEN OTHERS => 147 FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & 148 "OF VARIABLE 'AC4'" ); 149 END; 150 151 BEGIN 152 DECLARE 153 AC5 : CONSTANT ACCR(2) := NEW REC(IDENT_INT (1)); 154 BEGIN 155 FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & 156 "OF CONSTANT 'AC5'" ); 157 IF AC5 /= NULL THEN 158 COMMENT ("DEFEAT 'AC5' OPTIMIZATION"); 159 END IF; 160 END; 161 EXCEPTION 162 WHEN CONSTRAINT_ERROR => 163 NULL; 164 WHEN OTHERS => 165 FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & 166 "OF CONSTANT 'AC5'" ); 167 END; 168 169 BEGIN 170 DECLARE 171 AC6 : ACCR(2) := NEW REC (IDENT_INT (1)); 172 BEGIN 173 FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & 174 "OF VARIABLE 'AC6'" ); 175 IF AC6 /= NULL THEN 176 COMMENT ("DEFEAT 'AC6' OPTIMIZATION"); 177 END IF; 178 END; 179 EXCEPTION 180 WHEN CONSTRAINT_ERROR => 181 NULL; 182 WHEN OTHERS => 183 FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & 184 "OF VARIABLE 'AC6'" ); 185 END; 186 187 BEGIN 188 DECLARE 189 AC7 : CONSTANT ACCR(2) := NEW REC(IDENT_INT (3)); 190 BEGIN 191 FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & 192 "OF CONSTANT 'AC7'" ); 193 IF AC7 /= NULL THEN 194 COMMENT ("DEFEAT 'AC7' OPTIMIZATION"); 195 END IF; 196 END; 197 EXCEPTION 198 WHEN CONSTRAINT_ERROR => 199 NULL; 200 WHEN OTHERS => 201 FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & 202 "OF CONSTANT 'AC7'" ); 203 END; 204 205 BEGIN 206 DECLARE 207 AC8 : ACCR(2) := NEW REC (IDENT_INT (3)); 208 BEGIN 209 FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & 210 "OF VARIABLE 'AC8'" ); 211 IF AC8 /= NULL THEN 212 COMMENT ("DEFEAT 'AC8' OPTIMIZATION"); 213 END IF; 214 END; 215 EXCEPTION 216 WHEN CONSTRAINT_ERROR => 217 NULL; 218 WHEN OTHERS => 219 FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & 220 "OF VARIABLE 'AC8'" ); 221 END; 222 223 BEGIN 224 DECLARE 225 AC9 : CONSTANT ACCA(1 .. 2) := 226 NEW ARR(IDENT_INT(1) .. IDENT_INT (1)); 227 BEGIN 228 FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & 229 "OF CONSTANT 'AC9'" ); 230 IF AC9 /= NULL THEN 231 COMMENT ("DEFEAT 'AC9' OPTIMIZATION"); 232 END IF; 233 END; 234 EXCEPTION 235 WHEN CONSTRAINT_ERROR => 236 NULL; 237 WHEN OTHERS => 238 FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & 239 "OF CONSTANT 'AC9'" ); 240 END; 241 242 BEGIN 243 DECLARE 244 AC10 : ACCA (1..2) := 245 NEW ARR(IDENT_INT (1) .. IDENT_INT (1)); 246 BEGIN 247 FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & 248 "OF VARIABLE 'AC10'" ); 249 IF AC10 /= NULL THEN 250 COMMENT ("DEFEAT 'AC10' OPTIMIZATION"); 251 END IF; 252 END; 253 EXCEPTION 254 WHEN CONSTRAINT_ERROR => 255 NULL; 256 WHEN OTHERS => 257 FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & 258 "OF VARIABLE 'AC10'" ); 259 END; 260 261 BEGIN 262 DECLARE 263 AC11 : CONSTANT ACCA(1..2) := 264 NEW ARR(IDENT_INT (0) .. IDENT_INT (2)); 265 BEGIN 266 FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & 267 "OF CONSTANT 'AC11'" ); 268 IF AC11 /= NULL THEN 269 COMMENT ("DEFEAT 'AC11' OPTIMIZATION"); 270 END IF; 271 END; 272 EXCEPTION 273 WHEN CONSTRAINT_ERROR => 274 NULL; 275 WHEN OTHERS => 276 FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & 277 "OF CONSTANT 'AC11'" ); 278 END; 279 280 BEGIN 281 DECLARE 282 AC12 : ACCA(1..2) := 283 NEW ARR(IDENT_INT (0) .. IDENT_INT (2)); 284 BEGIN 285 FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & 286 "OF VARIABLE 'AC12'" ); 287 IF AC12 /= NULL THEN 288 COMMENT ("DEFEAT 'AC12' OPTIMIZATION"); 289 END IF; 290 END; 291 EXCEPTION 292 WHEN CONSTRAINT_ERROR => 293 NULL; 294 WHEN OTHERS => 295 FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & 296 "OF VARIABLE 'AC12'" ); 297 END; 298 299 BEGIN 300 DECLARE 301 AC13 : CONSTANT ACCA (1..2) := 302 NEW ARR(IDENT_INT (2) .. IDENT_INT (3)); 303 BEGIN 304 FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & 305 "OF CONSTANT 'AC13'" ); 306 IF AC13 /= NULL THEN 307 COMMENT ("DEFEAT 'AC13' OPTIMIZATION"); 308 END IF; 309 END; 310 EXCEPTION 311 WHEN CONSTRAINT_ERROR => 312 NULL; 313 WHEN OTHERS => 314 FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & 315 "OF CONSTANT 'AC13'" ); 316 END; 317 318 BEGIN 319 DECLARE 320 AC14 : ACCA(1..2) := 321 NEW ARR(IDENT_INT (2) .. IDENT_INT (3)); 322 BEGIN 323 FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & 324 "OF VARIABLE 'AC14'" ); 325 IF AC14 /= NULL THEN 326 COMMENT ("DEFEAT 'AC14' OPTIMIZATION"); 327 END IF; 328 END; 329 EXCEPTION 330 WHEN CONSTRAINT_ERROR => 331 NULL; 332 WHEN OTHERS => 333 FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & 334 "OF VARIABLE 'AC14'" ); 335 END; 336 337 BEGIN 338 DECLARE 339 AC15 : CONSTANT ACCN(1..0) := 340 NEW ARR(IDENT_INT (0) .. IDENT_INT (0)); 341 BEGIN 342 FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & 343 "OF CONSTANT 'AC15'" ); 344 IF AC15 /= NULL THEN 345 COMMENT ("DEFEAT 'AC15' OPTIMIZATION"); 346 END IF; 347 END; 348 EXCEPTION 349 WHEN CONSTRAINT_ERROR => 350 NULL; 351 WHEN OTHERS => 352 FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & 353 "OF CONSTANT 'AC15'" ); 354 END; 355 356 BEGIN 357 DECLARE 358 AC16 : ACCN(1..0) := 359 NEW ARR(IDENT_INT (0) .. IDENT_INT (0)); 360 BEGIN 361 FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & 362 "OF VARIABLE 'AC16'" ); 363 IF AC16 /= NULL THEN 364 COMMENT ("DEFEAT 'AC16' OPTIMIZATION"); 365 END IF; 366 END; 367 EXCEPTION 368 WHEN CONSTRAINT_ERROR => 369 NULL; 370 WHEN OTHERS => 371 FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & 372 "OF VARIABLE 'AC16'" ); 373 END; 374 375 RESULT; 376END C32115B; 377