1-- C460009.A 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-- 26-- OBJECTIVE: 27-- Check that Constraint_Error is raised in cases of null arrays when: 28-- 1. an assignment is made to a null array if the length of each 29-- dimension of the operand does not match the length of 30-- the corresponding dimension of the target subtype. 31-- 2. an array actual parameter does not match the length of 32-- corresponding dimensions of the formal in out parameter where 33-- the actual parameter has the form of a type conversion. 34-- 3. an array actual parameter does not match the length of 35-- corresponding dimensions of the formal out parameter where 36-- the actual parameter has the form of a type conversion. 37-- 38-- TEST DESCRIPTION: 39-- This transition test creates examples where array of null ranges 40-- raises Constraint_Error if any of the lengths mismatch. 41-- 42-- Inspired by C52103S.ADA, C64105E.ADA, and C64105F.ADA. 43-- 44-- 45-- CHANGE HISTORY: 46-- 21 Mar 96 SAIC Initial version for ACVC 2.1. 47-- 21 Sep 96 SAIC ACVC 2.1: Added new case. 48-- 49--! 50 51with Report; 52 53procedure C460009 is 54 55 subtype Int is Integer range 1 .. 3; 56 57begin 58 59 Report.Test("C460009","Check that Constraint_Error is raised in " & 60 "cases of null arrays if any of the lengths mismatch " & 61 "in assignments and parameter passing"); 62 63 --------------------------------------------------------------------------- 64 declare 65 66 type Arr_Int1 is array (Int range <>) of Integer; 67 Arr_Obj1 : Arr_Int1 (2 .. Report.Ident_Int(1)); -- null array object 68 69 begin 70 71 -- Same lengths, no Constraint_Error raised. 72 Arr_Obj1 := (Report.Ident_Int(3) .. 2 => Report.Ident_Int(1)); 73 74 Report.Comment ("Dead assignment prevention in Arr_Obj1 => " & 75 Integer'Image (Arr_Obj1'Last)); 76 77 exception 78 79 when Constraint_Error => 80 Report.Failed ("Arr_Obj1 - Constraint_Error exception raised"); 81 when others => 82 Report.Failed ("Arr_Obj1 - others exception raised"); 83 84 end; 85 86 --------------------------------------------------------------------------- 87 declare 88 89 type Arr_Int2 is array (Int range <>, Int range <>) of Integer; 90 Arr_Obj2 : Arr_Int2 (1 .. Report.Ident_Int(2), 91 Report.Ident_Int(3) .. Report.Ident_Int(2)); 92 -- null array object 93 begin 94 95 -- Same lengths, no Constraint_Error raised. 96 Arr_Obj2 := Arr_Int2'(Report.Ident_Int(2) .. 3 => 97 (Report.Ident_Int(2) .. Report.Ident_Int(1) => 98 Report.Ident_Int(1))); 99 100 Report.Comment ("Dead assignment prevention in Arr_Obj2 => " & 101 Integer'Image (Arr_Obj2'Last)); 102 103 exception 104 105 when Constraint_Error => 106 Report.Failed ("Arr_Obj2 - Constraint_Error exception raised"); 107 when others => 108 Report.Failed ("Arr_Obj2 - others exception raised"); 109 110 end; 111 112 --------------------------------------------------------------------------- 113 declare 114 115 type Arr_Int3 is array (Int range <>, Int range <>) of Integer; 116 Arr_Obj3 : Arr_Int3 (1 .. Report.Ident_Int(2), 117 Report.Ident_Int(3) .. Report.Ident_Int(2)); 118 -- null array object 119 120 begin 121 122 -- Lengths mismatch, Constraint_Error raised. 123 Arr_Obj3 := Arr_Int3'(Report.Ident_Int(3) .. 2 => 124 (Report.Ident_Int(1) .. Report.Ident_Int(3) => 125 Report.Ident_Int(1))); 126 127 Report.Comment ("Dead assignment prevention in Arr_Obj3 => " & 128 Integer'Image (Arr_Obj3'Last)); 129 130 Report.Failed ("Constraint_Error not raised in Arr_Obj3"); 131 132 exception 133 134 when Constraint_Error => null; -- exception expected. 135 when others => 136 Report.Failed ("Arr_Obj3 - others exception raised"); 137 138 end; 139 140 --------------------------------------------------------------------------- 141 declare 142 143 type Arr_Int4 is array (Int range <>, Int range <>, Int range <>) of 144 Integer; 145 Arr_Obj4 : Arr_Int4 (1 .. Report.Ident_Int(2), 146 Report.Ident_Int(1) .. Report.Ident_Int(3), 147 Report.Ident_Int(3) .. Report.Ident_Int(2)); 148 -- null array object 149 begin 150 151 -- Lengths mismatch, Constraint_Error raised. 152 Arr_Obj4 := Arr_Int4'(Report.Ident_Int(1) .. 3 => 153 (Report.Ident_Int(1) .. Report.Ident_Int(2) => 154 (Report.Ident_Int(3) .. Report.Ident_Int(2) => 155 Report.Ident_Int(1)))); 156 157 Report.Comment ("Dead assignment prevention in Arr_Obj4 => " & 158 Integer'Image (Arr_Obj4'Last)); 159 160 Report.Failed ("Constraint_Error not raised in Arr_Obj4"); 161 162 exception 163 164 when Constraint_Error => null; -- exception expected. 165 when others => 166 Report.Failed ("Arr_Obj4 - others exception raised"); 167 168 end; 169 170 --------------------------------------------------------------------------- 171 declare 172 173 type Arr_Int5 is array (Int range <>) of Integer; 174 Arr_Obj5 : Arr_Int5 (2 .. Report.Ident_Int(1)); -- null array object 175 176 begin 177 178 -- Only lengths of two null ranges are different, no Constraint_Error 179 -- raised. 180 Arr_Obj5 := (Report.Ident_Int(3) .. 1 => Report.Ident_Int(1)); 181 182 Report.Comment ("Dead assignment prevention in Arr_Obj5 => " & 183 Integer'Image (Arr_Obj5'Last)); 184 185 exception 186 187 when Constraint_Error => 188 Report.Failed ("Arr_Obj5 - Constraint_Error exception raised"); 189 when others => 190 Report.Failed ("Arr_Obj5 - others exception raised"); 191 192 end; 193 194 --------------------------------------------------------------------------- 195 declare 196 subtype Str is String (Report.Ident_Int(5) .. 4); 197 -- null string 198 Str_Obj : Str; 199 200 begin 201 202 -- Same lengths, no Constraint_Error raised. 203 Str_Obj := (Report.Ident_Int(1) .. 0 => 'Z'); 204 Str_Obj(2 .. 1) := ""; 205 Str_Obj(4 .. 2) := (others => 'X'); 206 Str_Obj(Report.Ident_Int(6) .. 3) := ""; 207 Str_Obj(Report.Ident_Int(0) .. Report.Ident_Int(-1)) := (others => 'Y'); 208 209 exception 210 211 when Constraint_Error => 212 Report.Failed ("Str_Obj - Constraint_Error exception raised"); 213 when others => 214 Report.Failed ("Str_Obj - others exception raised"); 215 216 end; 217 218 --------------------------------------------------------------------------- 219 declare 220 221 type Arr_Char5 is array (Int range <>, Int range <>) of Character; 222 subtype Formal is Arr_Char5 223 (Report.Ident_Int(2) .. 0, 1 .. Report.Ident_Int(3)); 224 Arr_Obj5 : Arr_Char5 (Report.Ident_Int(2) .. Report.Ident_Int(1), 225 Report.Ident_Int(1) .. Report.Ident_Int(2)) 226 := (Report.Ident_Int(2) .. Report.Ident_Int(1) => 227 (Report.Ident_Int(1) .. Report.Ident_Int(2) => ' ')); 228 229 procedure Proc5 (P : in out Formal) is 230 begin 231 Report.Failed ("No exception raised in Proc5"); 232 233 exception 234 235 when Constraint_Error => 236 Report.Failed ("Constraint_Error exception raised in Proc5"); 237 when others => 238 Report.Failed ("Others exception raised in Proc5"); 239 end; 240 241 begin 242 243 -- Lengths mismatch in the type conversion, Constraint_Error raised. 244 Proc5 (Formal(Arr_Obj5)); 245 246 Report.Failed ("Constraint_Error not raised in the call Proc5"); 247 248 exception 249 250 when Constraint_Error => null; -- exception expected. 251 when others => 252 Report.Failed ("Arr_Obj5 - others exception raised"); 253 254 end; 255 256 --------------------------------------------------------------------------- 257 declare 258 259 type Formal is array 260 (Report.Ident_Int(1) .. 3, 3 .. Report.Ident_Int(1)) of Character; 261 262 type Actual is array 263 (Report.Ident_Int(5) .. 3, 3 .. Report.Ident_Int(5)) of Character; 264 265 Arr_Obj6 : Actual := (5 .. 3 => (3 .. 5 => ' ')); 266 267 procedure Proc6 (P : in out Formal) is 268 begin 269 Report.Failed ("No exception raised in Proc6"); 270 271 exception 272 273 when Constraint_Error => 274 Report.Failed ("Constraint_Error exception raised in Proc6"); 275 when others => 276 Report.Failed ("Others exception raised in Proc6"); 277 end; 278 279 begin 280 281 -- Lengths mismatch in the type conversion, Constraint_Error raised. 282 Proc6 (Formal(Arr_Obj6)); 283 284 Report.Failed ("Constraint_Error not raised in the call Proc6"); 285 286 exception 287 288 when Constraint_Error => null; -- exception expected. 289 when others => 290 Report.Failed ("Arr_Obj6 - others exception raised"); 291 292 end; 293 294 --------------------------------------------------------------------------- 295 declare 296 297 type Formal is array (Int range <>, Int range <>) of Character; 298 type Actual is array (Positive range 5 .. 2, 299 Positive range 1 .. 3) of Character; 300 301 Arr_Obj7 : Actual := (5 .. 2 => (1 .. 3 => ' ')); 302 303 procedure Proc7 (P : in out Formal) is 304 begin 305 if P'Last /= 2 and P'Last(2) /= 3 then 306 Report.Failed ("Wrong bounds passed for Arr_Obj7"); 307 end if; 308 309 -- Lengths mismatch, Constraint_Error raised. 310 P := (1 .. 3 => (3 .. 0 => ' ')); 311 312 Report.Comment ("Dead assignment prevention in Proc7 => " & 313 Integer'Image (P'Last)); 314 315 Report.Failed ("No exception raised in Proc7"); 316 317 exception 318 319 when Constraint_Error => null; -- exception expected. 320 when others => 321 Report.Failed ("Others exception raised in Proc7"); 322 end; 323 324 begin 325 326 -- Same lengths, no Constraint_Error raised. 327 Proc7 (Formal(Arr_Obj7)); 328 329 if Arr_Obj7'Last /= 2 and Arr_Obj7'Last(2) /= 3 then 330 Report.Failed ("Bounds changed for Arr_Obj7"); 331 end if; 332 333 exception 334 335 when Constraint_Error => 336 Report.Failed ("Constraint_Error exception raised after call Proc7"); 337 when others => 338 Report.Failed ("Arr_Obj7 - others exception raised"); 339 340 end; 341 342 --------------------------------------------------------------------------- 343 declare 344 345 type Arr_Char8 is array (Int range <>, Int range <>) of Character; 346 subtype Formal is Arr_Char8 347 (Report.Ident_Int(2) .. 0, 1 .. Report.Ident_Int(3)); 348 Arr_Obj8 : Arr_Char8 (Report.Ident_Int(2) .. Report.Ident_Int(1), 349 Report.Ident_Int(1) .. Report.Ident_Int(2)); 350 351 procedure Proc8 (P : out Formal) is 352 begin 353 Report.Failed ("No exception raised in Proc8"); 354 355 exception 356 357 when Constraint_Error => 358 Report.Failed ("Constraint_Error exception raised in Proc8"); 359 when others => 360 Report.Failed ("Others exception raised in Proc8"); 361 end; 362 363 begin 364 365 -- Lengths mismatch in the type conversion, Constraint_Error raised. 366 Proc8 (Formal(Arr_Obj8)); 367 368 Report.Failed ("Constraint_Error not raised in the call Proc8"); 369 370 exception 371 372 when Constraint_Error => null; -- exception expected. 373 when others => 374 Report.Failed ("Arr_Obj8 - others exception raised"); 375 376 end; 377 378 --------------------------------------------------------------------------- 379 declare 380 381 type Formal is array 382 (Report.Ident_Int(1) .. 3, 3 .. Report.Ident_Int(1)) of Character; 383 384 type Actual is array 385 (Report.Ident_Int(5) .. 3, 3 .. Report.Ident_Int(5)) of Character; 386 387 Arr_Obj9 : Actual; 388 389 procedure Proc9 (P : out Formal) is 390 begin 391 Report.Failed ("No exception raised in Proc9"); 392 393 exception 394 395 when Constraint_Error => 396 Report.Failed ("Constraint_Error exception raised in Proc9"); 397 when others => 398 Report.Failed ("Others exception raised in Proc9"); 399 end; 400 401 begin 402 403 -- Lengths mismatch in the type conversion, Constraint_Error raised. 404 Proc9 (Formal(Arr_Obj9)); 405 406 Report.Failed ("Constraint_Error not raised in the call Proc9"); 407 408 exception 409 410 when Constraint_Error => null; -- exception expected. 411 when others => 412 Report.Failed ("Arr_Obj9 - others exception raised"); 413 414 end; 415 416 --------------------------------------------------------------------------- 417 declare 418 419 type Formal is array (Int range <>, Int range <>) of Character; 420 type Actual is array (Positive range 5 .. 2, 421 Positive range 1 .. 3) of Character; 422 423 Arr_Obj10 : Actual; 424 425 procedure Proc10 (P : out Formal) is 426 begin 427 if P'Last /= 2 and P'Last(2) /= 3 then 428 Report.Failed ("Wrong bounds passed for Arr_Obj10"); 429 end if; 430 431 -- Lengths mismatch, Constraint_Error raised. 432 P := (1 .. 3 => (3 .. 1 => ' ')); 433 434 Report.Comment ("Dead assignment prevention in Proc10 => " & 435 Integer'Image (P'Last)); 436 437 Report.Failed ("No exception raised in Proc10"); 438 439 exception 440 441 when Constraint_Error => null; -- exception expected. 442 when others => 443 Report.Failed ("Others exception raised in Proc10"); 444 end; 445 446 begin 447 448 -- Same lengths, no Constraint_Error raised. 449 Proc10 (Formal(Arr_Obj10)); 450 451 if Arr_Obj10'Last /= 2 and Arr_Obj10'Last(2) /= 3 then 452 Report.Failed ("Bounds changed for Arr_Obj10"); 453 end if; 454 455 exception 456 457 when Constraint_Error => 458 Report.Failed ("Constraint_Error exception raised after call Proc10"); 459 when others => 460 Report.Failed ("Arr_Obj10 - others exception raised"); 461 462 end; 463 464 --------------------------------------------------------------------------- 465 Report.Result; 466 467end C460009; 468