gcc/testsuite/ada/acats/tests/c4/c460010.a

   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
  50 with Report;
  51 pragma Elaborate (Report);
  52
  53 package 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
  66 end C460010_0;
  67
  68
  69      --==================================================================--
  70
  71
  72 with Report;
  73 pragma Elaborate (Report);
  74
  75 package 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
  91 end C460010_1;
  92
  93
  94      --==================================================================--
  95
  96
  97 -- Generic equality function:
  98
  99 generic
 100    type Operand_Type is private;
 101 function C460010_2 (L, R : Operand_Type) return Boolean;
 102
 103
 104 function C460010_2 (L, R : Operand_Type) return Boolean is
 105 begin
 106    return L = R;
 107 end C460010_2;
 108
 109
 110      --==================================================================--
 111
 112
 113 with C460010_0;
 114 with C460010_1;
 115 with C460010_2;
 116
 117 with Report;
 118
 119 procedure C460010 is
 120
 121    generic function Generic_Equality renames C460010_2;
 122
 123 begin
 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
 354 end C460010;