1-- C460010.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, for an array aggregate without an others choice assigned 28-- to an object of a constrained array subtype, Constraint_Error is not 29-- raised if the length of each dimension of the aggregate equals the 30-- length of the corresponding dimension of the target object, even if 31-- the bounds of the corresponding index ranges do not match. 32-- 33-- TEST DESCRIPTION: 34-- The test verifies that sliding of array bounds is performed on array 35-- aggregates that are part of a larger aggregate, where the bounds of 36-- the corresponding index ranges do not match but the lengths of the 37-- corresponding dimensions are the same. Both aggregates containing 38-- named associations and positional associations are checked. Cases 39-- involving static and nonstatic index constraints, as well as pre- 40-- defined and modular integer index subtypes, are included. 41-- 42-- 43-- CHANGE HISTORY: 44-- 15 Apr 96 SAIC Prerelease version for ACVC 2.1. 45-- 20 Oct 96 SAIC Removed unnecessary parentheses and type 46-- conversions. 47-- 48--! 49 50with Report; 51pragma Elaborate (Report); 52 53package C460010_0 is 54 55 type Modular_Type is mod 10; -- Range 0 .. 9. 56 57 58 Two : Modular_Type := Modular_Type (Report.Ident_Int(2)); 59 Four : Modular_Type := Modular_Type (Report.Ident_Int(4)); 60 61 type Array_Modular_Index is array (Modular_Type range <>) of Integer; 62 63 subtype Array_Static_Modular_Constraint is Array_Modular_Index(2..4); 64 subtype Array_Nonstatic_Modular_Constraint is Array_Modular_Index(Two..Four); 65 66end C460010_0; 67 68 69 --==================================================================-- 70 71 72with Report; 73pragma Elaborate (Report); 74 75package C460010_1 is 76 77 One : Integer := Report.Ident_Int(1); 78 Ten : Integer := Report.Ident_Int(10); 79 80 subtype Integer_Subtype is Integer range One .. Ten; 81 82 83 Two : Integer := Report.Ident_Int(2); 84 Four : Integer := Report.Ident_Int(4); 85 86 type Array_Integer_Index is array (Integer_Subtype range <>) of Boolean; 87 88 subtype Array_Static_Integer_Constraint is Array_Integer_Index(2..4); 89 subtype Array_Nonstatic_Integer_Constraint is Array_Integer_Index(Two..Four); 90 91end C460010_1; 92 93 94 --==================================================================-- 95 96 97-- Generic equality function: 98 99generic 100 type Operand_Type is private; 101function C460010_2 (L, R : Operand_Type) return Boolean; 102 103 104function C460010_2 (L, R : Operand_Type) return Boolean is 105begin 106 return L = R; 107end C460010_2; 108 109 110 --==================================================================-- 111 112 113with C460010_0; 114with C460010_1; 115with C460010_2; 116 117with Report; 118 119procedure C460010 is 120 121 generic function Generic_Equality renames C460010_2; 122 123begin 124 Report.Test ("C460010", "Check that Constraint_Error is not raised if " & 125 "an array aggregate without an others choice is assigned " & 126 "to an object of a constrained array subtype, and the " & 127 "length of each dimension of the aggregate equals the " & 128 "length of the corresponding dimension of the target object"); 129 130 131 ---=---=---=---=---=---=---=---=---=---=--- 132 133 134 declare 135 type Arr is array (1..1) of C460010_0.Array_Static_Modular_Constraint; 136 function Equals is new Generic_Equality (Arr); 137 Target : Arr; 138 begin 139 ---=---=---=---=---=---=--- 140 CASE_1: 141 begin 142 Target := (1 => (1 => 1, 2 => 2, 3 => 3)); -- Named associations. 143 144 if not Equals (Target, Target) then 145 Report.Failed ("Avoid optimization"); -- Never executed. 146 end if; 147 exception 148 when Constraint_Error => 149 Report.Failed ("Constraint_Error raised: Case 1"); 150 when others => 151 Report.Failed ("Unexpected exception raised: Case 1"); 152 end CASE_1; 153 154 ---=---=---=---=---=---=--- 155 156 CASE_2: 157 begin 158 Target := (1 => (5, 10, 15)); -- Positional associations. 159 160 if not Equals (Target, Target) then 161 Report.Failed ("Avoid optimization"); -- Never executed. 162 end if; 163 exception 164 when Constraint_Error => 165 Report.Failed ("Constraint_Error raised: Case 2"); 166 when others => 167 Report.Failed ("Unexpected exception raised: Case 2"); 168 end CASE_2; 169 170 ---=---=---=---=---=---=--- 171 end; 172 173 174 ---=---=---=---=---=---=---=---=---=---=--- 175 176 177 declare 178 type Rec (Disc : C460010_0.Modular_Type := 4) is record 179 Arr : C460010_0.Array_Modular_Index(2 .. Disc); 180 end record; 181 182 function Equals is new Generic_Equality (Rec); 183 Target : Rec; 184 begin 185 ---=---=---=---=---=---=--- 186 CASE_3: 187 begin 188 Target := (Disc => 4, Arr => (1 => 1, 2 => 2, 3 => 3)); -- Named. 189 190 if not Equals (Target, Target) then 191 Report.Failed ("Avoid optimization"); -- Never executed. 192 end if; 193 exception 194 when Constraint_Error => 195 Report.Failed ("Constraint_Error raised: Case 3"); 196 when others => 197 Report.Failed ("Unexpected exception raised: Case 3"); 198 end CASE_3; 199 200 ---=---=---=---=---=---=--- 201 202 CASE_4: 203 begin 204 Target := (Disc => 4, Arr => (1 ,2, 3)); -- Positional. 205 206 if not Equals (Target, Target) then 207 Report.Failed ("Avoid optimization"); -- Never executed. 208 end if; 209 exception 210 when Constraint_Error => 211 Report.Failed ("Constraint_Error raised: Case 4"); 212 when others => 213 Report.Failed ("Unexpected exception raised: Case 4"); 214 end CASE_4; 215 216 ---=---=---=---=---=---=--- 217 end; 218 219 220 ---=---=---=---=---=---=---=---=---=---=--- 221 222 223 declare 224 type Arr is array (1..1) of C460010_0.Array_Nonstatic_Modular_Constraint; 225 function Equals is new Generic_Equality (Arr); 226 Target : Arr; 227 begin 228 ---=---=---=---=---=---=--- 229 CASE_5: 230 begin 231 Target := (1 => (1 => 1, 2 => 2, 3 => 3)); -- Named associations. 232 233 if not Equals (Target, Target) then 234 Report.Failed ("Avoid optimization"); -- Never executed. 235 end if; 236 exception 237 when Constraint_Error => 238 Report.Failed ("Constraint_Error raised: Case 5"); 239 when others => 240 Report.Failed ("Unexpected exception raised: Case 5"); 241 end CASE_5; 242 243 ---=---=---=---=---=---=--- 244 245 CASE_6: 246 begin 247 Target := (1 => ((5, 10, 15))); -- Positional associations. 248 249 if not Equals (Target, Target) then 250 Report.Failed ("Avoid optimization"); -- Never executed. 251 end if; 252 exception 253 when Constraint_Error => 254 Report.Failed ("Constraint_Error raised: Case 6"); 255 when others => 256 Report.Failed ("Unexpected exception raised: Case 6"); 257 end CASE_6; 258 259 ---=---=---=---=---=---=--- 260 end; 261 262 263 ---=---=---=---=---=---=---=---=---=---=--- 264 265 266 declare 267 type Arr is array (1..1) of C460010_1.Array_Static_Integer_Constraint; 268 function Equals is new Generic_Equality (Arr); 269 Target : Arr; 270 begin 271 ---=---=---=---=---=---=--- 272 CASE_7: 273 begin 274 Target := (1 => (1 => True, 2 => True, 3 => False)); -- Named. 275 276 if not Equals (Target, Target) then 277 Report.Failed ("Avoid optimization"); -- Never executed. 278 end if; 279 exception 280 when Constraint_Error => 281 Report.Failed ("Constraint_Error raised: Case 7"); 282 when others => 283 Report.Failed ("Unexpected exception raised: Case 7"); 284 end CASE_7; 285 286 ---=---=---=---=---=---=--- 287 288 CASE_8: 289 begin 290 Target := (1 => ((False, False, True))); -- Positional. 291 292 if not Equals (Target, Target) then 293 Report.Failed ("Avoid optimization"); -- Never executed. 294 end if; 295 exception 296 when Constraint_Error => 297 Report.Failed ("Constraint_Error raised: Case 8"); 298 when others => 299 Report.Failed ("Unexpected exception raised: Case 8"); 300 end CASE_8; 301 302 ---=---=---=---=---=---=--- 303 end; 304 305 306 ---=---=---=---=---=---=---=---=---=---=--- 307 308 309 declare 310 type Arr is array (1..1) of C460010_1.Array_Nonstatic_Integer_Constraint; 311 function Equals is new Generic_Equality (Arr); 312 Target : Arr; 313 begin 314 ---=---=---=---=---=---=--- 315 CASE_9: 316 begin 317 Target := (1 => (1 => True, 2 => True, 3 => False)); -- Named. 318 319 if not Equals (Target, Target) then 320 Report.Failed ("Avoid optimization"); -- Never executed. 321 end if; 322 exception 323 when Constraint_Error => 324 Report.Failed ("Constraint_Error raised: Case 9"); 325 when others => 326 Report.Failed ("Unexpected exception raised: Case 9"); 327 end CASE_9; 328 329 ---=---=---=---=---=---=--- 330 331 CASE_10: 332 begin 333 Target := (1 => (False, False, True)); -- Positional. 334 335 if not Equals (Target, Target) then 336 Report.Failed ("Avoid optimization"); -- Never executed. 337 end if; 338 exception 339 when Constraint_Error => 340 Report.Failed ("Constraint_Error raised: Case 10"); 341 when others => 342 Report.Failed ("Unexpected exception raised: Case 10"); 343 end CASE_10; 344 345 ---=---=---=---=---=---=--- 346 end; 347 348 349 ---=---=---=---=---=---=---=---=---=---=--- 350 351 352 Report.Result; 353 354end C460010; 355