gcc/testsuite/ada/acats/tests/c3/c360002.a

   1 -- C360002.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 modular types may be used as array indices.
  28 --
  29 --      Check that if aliased appears in the component_definition of an
  30 --      array_type that each component of the array is aliased.
  31 --
  32 --      Check that references to aliased array objects produce correct
  33 --      results, and that out-of-bounds indexing correctly produces
  34 --      Constraint_Error.
  35 --
  36 -- TEST DESCRIPTION:
  37 --      This test defines several array types and subtypes indexed by modular
  38 --      types; some aliased some not, some with aliased components, some not.
  39 --
  40 --      It then checks that assignments move the correct data.
  41 --
  42 --
  43 -- CHANGE HISTORY:
  44 --      28 SEP 95   SAIC   Initial version
  45 --      23 APR 96   SAIC   Doc fixes, fixed constrained/unconstrained conflict
  46 --      13 FEB 97   PWB.CTA Removed illegal declarations and affected code
  47 --!
  48
  49 ------------------------------------------------------------------- C360002
  50
  51 with Report;
  52
  53 procedure C360002 is
  54
  55   Verbose : Boolean := Report.Ident_Bool( False );
  56
  57   type Mod_128 is mod 128;
  58
  59   function Ident_128( I: Integer ) return Mod_128 is
  60   begin
  61     return Mod_128( Report.Ident_Int( I ) );
  62   end Ident_128;
  63
  64   type Unconstrained_Array
  65        is array( Mod_128 range <> ) of Integer;
  66
  67   type Unconstrained_Array_Aliased
  68        is array( Mod_128 range <> ) of aliased Integer;
  69
  70   type Access_All_Unconstrained_Array
  71        is access all Unconstrained_Array;
  72
  73   type Access_All_Unconstrained_Array_Aliased
  74        is access all Unconstrained_Array_Aliased;
  75
  76   subtype Array_01_10
  77           is Unconstrained_Array(01..10);
  78
  79   subtype Array_11_20
  80           is Unconstrained_Array(11..20);
  81
  82   subtype Array_Aliased_01_10
  83           is Unconstrained_Array_Aliased(01..10);
  84
  85   subtype Array_Aliased_11_20
  86           is Unconstrained_Array_Aliased(11..20);
  87
  88   subtype Access_All_01_10_Array
  89           is Access_All_Unconstrained_Array(01..10);
  90
  91   subtype Access_All_01_10_Array_Aliased
  92           is Access_All_Unconstrained_Array_Aliased(01..10);
  93
  94   subtype Access_All_11_20_Array
  95           is Access_All_Unconstrained_Array(11..20);
  96
  97   subtype Access_All_11_20_Array_Aliased
  98           is Access_All_Unconstrained_Array_Aliased(11..20);
  99
 100
 101 -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
 102
 103   -- these 'filler' functions create unique values for every element that
 104   -- is used and/or tested in this test.
 105
 106   Well_Bottom : Integer := 0;
 107
 108   function Filler( Size : Mod_128 ) return Unconstrained_Array is
 109     It : Unconstrained_Array( 0..Size-1 );
 110   begin
 111     for Eyes in It'Range loop
 112       It(Eyes) := Integer( Eyes ) + Well_Bottom;
 113     end loop;
 114     Well_Bottom := Well_Bottom + It'Length;
 115     return It;
 116   end Filler;
 117
 118   function Filler( Size : Mod_128 ) return Unconstrained_Array_Aliased is
 119     It : Unconstrained_Array_Aliased( 0..Size-1 );
 120   begin
 121     for Ayes in It'Range loop
 122       It(Ayes) := Integer( Ayes ) + Well_Bottom;
 123     end loop;
 124     Well_Bottom := Well_Bottom + It'Length;
 125     return It;
 126   end Filler;
 127
 128 -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
 129
 130   An_Integer : Integer;
 131
 132   type AAI is access all Integer;
 133
 134   An_Integer_Access : AAI;
 135
 136   Array_Item_01_10 : Array_01_10 := Filler(10); -- 0..9
 137
 138   Array_Item_11_20 : Array_11_20 := Filler(10); -- 10..19 (sliding)
 139
 140   Array_Aliased_Item_01_10 : Array_Aliased_01_10 := Filler(10); -- 20..29
 141
 142   Array_Aliased_Item_11_20 : Array_Aliased_11_20 := Filler(10); -- 30..39
 143
 144   Aliased_Array_Item_01_10 : aliased Array_01_10 := Filler(10); -- 40..49
 145
 146   Aliased_Array_Item_11_20 : aliased Array_11_20 := Filler(10); -- 50..59
 147
 148   Aliased_Array_Aliased_Item_01_10 : aliased Array_Aliased_01_10
 149                                    := Filler(10);               -- 60..69
 150
 151   Aliased_Array_Aliased_Item_11_20 : aliased Array_Aliased_11_20
 152                                    := Filler(10);               -- 70..79
 153
 154   Check_Item            : Access_All_Unconstrained_Array;
 155
 156   Check_Aliased_Item    : Access_All_Unconstrained_Array_Aliased;
 157
 158 -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
 159
 160   procedure Fail( Message : String; CI, SB : Integer ) is
 161   begin
 162     Report.Failed("Wrong value passed " & Message);
 163     if Verbose then
 164       Report.Comment("got" & Integer'Image(CI) &
 165                      " should be" & Integer'Image(SB) );
 166     end if;
 167   end Fail;
 168
 169   procedure Check_Array_01_10( Checked_Item : Array_01_10;
 170                                Low_SB       : Integer ) is
 171   begin
 172     for Index in Checked_Item'Range loop
 173       if (Checked_Item(Index) /= (Low_SB +Integer(Index)-1)) then
 174         Fail("unaliased 1..10", Checked_Item(Index),
 175                                 (Low_SB +Integer(Index)-1));
 176       end if;
 177     end loop;
 178   end Check_Array_01_10;
 179
 180   procedure Check_Array_11_20( Checked_Item : Array_11_20;
 181                                Low_SB       : Integer ) is
 182   begin
 183     for Index in Checked_Item'Range loop
 184       if (Checked_Item(Index) /= (Low_SB +Integer(Index)-11)) then
 185         Fail("unaliased 11..20", Checked_Item(Index),
 186                                  (Low_SB +Integer(Index)-11));
 187       end if;
 188     end loop;
 189  end Check_Array_11_20;
 190
 191   procedure Check_Single_Integer( The_Integer, SB : Integer;
 192                                   Message         : String ) is
 193   begin
 194     if The_Integer /= SB then
 195       Report.Failed("Wrong integer value for " & Message );
 196     end if;
 197   end Check_Single_Integer;
 198
 199 -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
 200
 201 begin  -- Main test procedure.
 202
 203   Report.Test ("C360002", "Check that modular types may be used as array " &
 204                           "indices.  Check that if aliased appears in " &
 205                           "the component_definition of an array_type that " &
 206                           "each component of the array is aliased.  Check " &
 207                           "that references to aliased array objects " &
 208                           "produce correct results, and that out of bound " &
 209                           "references to aliased objects correctly " &
 210                           "produce Constraint_Error" );
 211   -- start with checks that the Filler assignments produced the expected
 212   -- result.  This is a "case 0" test to check that nothing REALLY surprising
 213   -- is happening
 214
 215   Check_Array_01_10( Array_Item_01_10, 0 );
 216   Check_Array_11_20( Array_Item_11_20, 10 );
 217
 218   -- check that having the variable aliased makes no difference
 219   Check_Array_01_10( Aliased_Array_Item_01_10, 40 );
 220   Check_Array_11_20( Aliased_Array_Item_11_20, 50 );
 221
 222   -- now check that conversion between array types where the only
 223   -- difference in the definitions is that the components are aliased works
 224
 225   Check_Array_01_10( Unconstrained_Array( Array_Aliased_Item_01_10 ), 20 );
 226   Check_Array_11_20( Unconstrained_Array( Array_Aliased_Item_11_20 ), 30 );
 227
 228   -- check that conversion of an aliased object with aliased components
 229   -- also works
 230
 231   Check_Array_01_10( Unconstrained_Array( Aliased_Array_Aliased_Item_01_10 ),
 232                      60 );
 233   Check_Array_11_20( Unconstrained_Array( Aliased_Array_Aliased_Item_11_20 ),
 234                      70 );
 235
 236   -- check that the bounds will slide
 237
 238   Check_Array_01_10( Array_01_10( Array_Item_11_20 ), 10 );
 239   Check_Array_11_20( Array_11_20( Array_Item_01_10 ),  0 );
 240
 241   -- point at some of the components and check them
 242
 243   An_Integer_Access := Array_Aliased_Item_01_10(5)'Access;
 244
 245   Check_Single_Integer( An_Integer_Access.all, 24,
 246                        "Aliased component 'Access");
 247
 248   An_Integer_Access := Aliased_Array_Aliased_Item_01_10(7)'Access;
 249
 250   Check_Single_Integer( An_Integer_Access.all, 66,
 251                        "Aliased Aliased component 'Access");
 252
 253   -- check some assignments
 254
 255   Array_Item_01_10 := Aliased_Array_Item_01_10;
 256   Check_Array_01_10( Array_Item_01_10, 40 );
 257
 258   Aliased_Array_Item_01_10 := Aliased_Array_Item_11_20(11..20);
 259   Check_Array_01_10( Aliased_Array_Item_01_10, 50 );
 260
 261   Aliased_Array_Aliased_Item_11_20(11..20)
 262                                        := Aliased_Array_Aliased_Item_01_10;
 263   Check_Array_11_20( Unconstrained_Array( Aliased_Array_Aliased_Item_11_20 ),
 264                      60 );
 265
 266   Report.Result;
 267
 268 end C360002;