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