1-- C37008A.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 SPECIFYING AN INVALID DEFAULT INITIALIZATION 26-- RAISES CONSTRAINT_ERROR WHEN AN OBJECT IS DECLARED. 27 28-- DAT 3/6/81 29-- SPS 10/26/82 30-- RJW 1/9/86 - REVISED COMMENTS. ADDED 'IDENT_INT'. 31-- EDS 7/22/98 AVOID OPTIMIZATION 32 33WITH REPORT; 34USE REPORT; 35PROCEDURE C37008A IS 36BEGIN 37 TEST ("C37008A", "CHECK THAT INVALID DEFAULT RECORD" 38 & " COMPONENT INITIALIZATIONS RAISE" 39 & " CONSTRAINT_ERROR"); 40 41 BEGIN 42 DECLARE 43 TYPE R1 IS RECORD 44 C1 : INTEGER RANGE 1 .. 5 := IDENT_INT (0); 45 END RECORD; 46 REC1 : R1; 47 BEGIN 48 FAILED ("NO EXCEPTION RAISED 1 " & INTEGER'IMAGE(REC1.C1)); 49 END; 50 EXCEPTION 51 WHEN CONSTRAINT_ERROR => NULL; 52 WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED 1"); 53 END; 54 55 BEGIN 56 DECLARE 57 TYPE R IS RECORD 58 C : CHARACTER RANGE 'A' .. 'Y' := 'Z'; 59 END RECORD; 60 REC2 : R; 61 BEGIN 62 FAILED ("NO EXCEPTION RAISED 1A " & (REC2.C)); 63 END; 64 EXCEPTION 65 WHEN CONSTRAINT_ERROR => NULL; 66 WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED 1A"); 67 END; 68 69 BEGIN 70 DECLARE 71 TYPE R2 IS RECORD 72 C2 : BOOLEAN RANGE FALSE .. FALSE := TRUE; 73 END RECORD; 74 REC3 : R2; 75 BEGIN 76 FAILED ("NO EXCEPTION RAISED 2 " & BOOLEAN'IMAGE(REC3.C2)); 77 END; 78 EXCEPTION 79 WHEN CONSTRAINT_ERROR => NULL; 80 WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED 2"); 81 END; 82 83 BEGIN 84 DECLARE 85 TYPE E IS (E1, E2, E3); 86 TYPE R IS RECORD 87 C : E RANGE E2 .. E3 := E1; 88 END RECORD; 89 REC4 : R; 90 BEGIN 91 FAILED ("NO EXCEPTION RAISED 2A " & E'IMAGE(REC4.C)); 92 END; 93 EXCEPTION 94 WHEN CONSTRAINT_ERROR => NULL; 95 WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED 2A"); 96 END; 97 98 BEGIN 99 DECLARE 100 TYPE R3 IS RECORD 101 C3 : INTEGER RANGE 1 .. 5; 102 END RECORD; 103 REC5 : R3; 104 TYPE R3A IS RECORD 105 C3A : R3 := (OTHERS => IDENT_INT (6)); 106 END RECORD; 107 REC6 : R3A; 108 BEGIN 109 FAILED ("NO EXCEPTION RAISED 3 " & 110 INTEGER'IMAGE(REC6.C3A.C3)); 111 END; 112 EXCEPTION 113 WHEN CONSTRAINT_ERROR => NULL; 114 WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED 3"); 115 END; 116 117 BEGIN 118 DECLARE 119 TYPE ARR IS ARRAY (1..3) OF INTEGER RANGE 8..9; 120 TYPE R4 IS RECORD 121 C4 : ARR 122 := (1 => 8, 2 => 9, 3 => 10); 123 END RECORD; 124 REC7 : R4; 125 BEGIN 126 FAILED ("NO EXCEPTION RAISED 4 " & 127 INTEGER'IMAGE(REC7.C4(1))); 128 END; 129 EXCEPTION 130 WHEN CONSTRAINT_ERROR => NULL; 131 WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED 4"); 132 END; 133 134 BEGIN 135 DECLARE 136 TYPE A IS ARRAY (NATURAL RANGE <> ) 137 OF INTEGER RANGE 1 .. 5; 138 139 TYPE AA IS ACCESS A; 140 141 TYPE R5 IS RECORD 142 C5 : AA := NEW A' (4, 5, 6); 143 END RECORD; 144 REC8 : R5; 145 BEGIN 146 FAILED ("NO EXCEPTION RAISED 5 " & 147 INTEGER'IMAGE(REC8.C5(1))); 148 END; 149 EXCEPTION 150 WHEN CONSTRAINT_ERROR => NULL; 151 WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED 5"); 152 END; 153 154 BEGIN 155 DECLARE 156 TYPE A IS ARRAY (NATURAL RANGE <> ) 157 OF INTEGER RANGE 1 .. 5; 158 159 TYPE AA IS ACCESS A (1 .. 3); 160 161 TYPE R6 IS RECORD 162 C6 : AA := NEW A' (4, 4, 4, 4); 163 END RECORD; 164 REC9 : R6; 165 BEGIN 166 FAILED ("NO EXCEPTION RAISED 6 " & 167 INTEGER'IMAGE(REC9.C6(1))); 168 END; 169 EXCEPTION 170 WHEN CONSTRAINT_ERROR => NULL; 171 WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED 6"); 172 END; 173 174 BEGIN 175 DECLARE 176 TYPE AI IS ACCESS INTEGER RANGE 6 .. 8; 177 178 TYPE R7 IS RECORD 179 C7 : AI := NEW INTEGER' (5); 180 END RECORD; 181 REC10 : R7; 182 BEGIN 183 FAILED ("NO EXCEPTION RAISED 7 " & 184 INTEGER'IMAGE(REC10.C7.ALL)); 185 END; 186 EXCEPTION 187 WHEN CONSTRAINT_ERROR => NULL; 188 WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED 7"); 189 END; 190 191 BEGIN 192 DECLARE 193 TYPE UA IS ARRAY (NATURAL RANGE <> ) 194 OF INTEGER RANGE 3 .. 5; 195 196 SUBTYPE CA IS UA (7 .. 8); 197 198 TYPE R8 IS RECORD 199 C8 : CA := (6 .. 8 => 4); 200 END RECORD; 201 REC11 : R8; 202 BEGIN 203 FAILED ("NO EXCEPTION RAISED 8 " & 204 INTEGER'IMAGE(REC11.C8(7))); 205 END; 206 EXCEPTION 207 WHEN CONSTRAINT_ERROR => NULL; 208 WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED 8"); 209 END; 210 211 BEGIN 212 DECLARE 213 TYPE UA IS ARRAY (NATURAL RANGE <> ) 214 OF INTEGER RANGE 3 .. IDENT_INT(5); 215 216 TYPE R9 IS RECORD 217 C9 : UA (11 .. 11) := (11 => 6); 218 END RECORD; 219 REC12 : R9; 220 BEGIN 221 FAILED ("NO EXCEPTION RAISED 9 " & 222 INTEGER'IMAGE(REC12.C9(11))); 223 END; 224 EXCEPTION 225 WHEN CONSTRAINT_ERROR => NULL; 226 WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED 9"); 227 END; 228 229 BEGIN 230 DECLARE 231 TYPE A IS ARRAY (NATURAL RANGE <> ) 232 OF INTEGER RANGE 1 .. IDENT_INT (5); 233 234 TYPE AA IS ACCESS A; 235 236 TYPE R10 IS RECORD 237 C10 : AA := NEW A '(4, 5, 6); 238 END RECORD; 239 REC13 : R10; 240 BEGIN 241 FAILED ("NO EXCEPTION RAISED 10 " & 242 INTEGER'IMAGE(REC13.C10(1))); 243 END; 244 EXCEPTION 245 WHEN CONSTRAINT_ERROR => NULL; 246 WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED 10"); 247 END; 248 249 BEGIN 250 DECLARE 251 TYPE A IS ARRAY (NATURAL RANGE <> ) 252 OF INTEGER RANGE 1 .. 5; 253 254 TYPE AA IS ACCESS A (IDENT_INT (1) .. IDENT_INT (3)); 255 256 TYPE R11 IS RECORD 257 C11 : AA := NEW A '(4, 4, 4, 4); 258 END RECORD; 259 REC14 : R11; 260 BEGIN 261 FAILED ("NO EXCEPTION RAISED 11 " & 262 INTEGER'IMAGE(REC14.C11(1))); 263 END; 264 EXCEPTION 265 WHEN CONSTRAINT_ERROR => NULL; 266 WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED 11"); 267 END; 268 269 RESULT; 270END C37008A; 271