diff gcc/testsuite/ada/acats/tests/c3/c360002.a @ 111:04ced10e8804

gcc 7
author kono
date Fri, 27 Oct 2017 22:46:09 +0900
parents
children
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/gcc/testsuite/ada/acats/tests/c3/c360002.a	Fri Oct 27 22:46:09 2017 +0900
@@ -0,0 +1,268 @@
+-- C360002.A
+--
+--                             Grant of Unlimited Rights
+--
+--     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+--     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+--     unlimited rights in the software and documentation contained herein.
+--     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+--     this public release, the Government intends to confer upon all 
+--     recipients unlimited rights  equal to those held by the Government.  
+--     These rights include rights to use, duplicate, release or disclose the 
+--     released technical data and computer software in whole or in part, in 
+--     any manner and for any purpose whatsoever, and to have or permit others 
+--     to do so.
+--
+--                                    DISCLAIMER
+--
+--     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
+--     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
+--     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
+--     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
+--     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
+--     PARTICULAR PURPOSE OF SAID MATERIAL.
+--*
+--
+-- OBJECTIVE:
+--      Check that modular types may be used as array indices.
+--
+--      Check that if aliased appears in the component_definition of an
+--      array_type that each component of the array is aliased.
+--
+--      Check that references to aliased array objects produce correct
+--      results, and that out-of-bounds indexing correctly produces
+--      Constraint_Error.
+--
+-- TEST DESCRIPTION:
+--      This test defines several array types and subtypes indexed by modular
+--      types; some aliased some not, some with aliased components, some not.
+--
+--      It then checks that assignments move the correct data.
+--
+--
+-- CHANGE HISTORY:
+--      28 SEP 95   SAIC   Initial version
+--      23 APR 96   SAIC   Doc fixes, fixed constrained/unconstrained conflict
+--      13 FEB 97   PWB.CTA Removed illegal declarations and affected code
+--!
+
+------------------------------------------------------------------- C360002
+
+with Report;
+
+procedure C360002 is
+
+  Verbose : Boolean := Report.Ident_Bool( False );
+
+  type Mod_128 is mod 128;
+
+  function Ident_128( I: Integer ) return Mod_128 is
+  begin
+    return Mod_128( Report.Ident_Int( I ) );
+  end Ident_128;
+
+  type Unconstrained_Array
+       is array( Mod_128 range <> ) of Integer;
+
+  type Unconstrained_Array_Aliased
+       is array( Mod_128 range <> ) of aliased Integer;
+
+  type Access_All_Unconstrained_Array
+       is access all Unconstrained_Array;
+
+  type Access_All_Unconstrained_Array_Aliased
+       is access all Unconstrained_Array_Aliased;
+
+  subtype Array_01_10
+          is Unconstrained_Array(01..10);
+
+  subtype Array_11_20
+          is Unconstrained_Array(11..20);
+
+  subtype Array_Aliased_01_10
+          is Unconstrained_Array_Aliased(01..10);
+
+  subtype Array_Aliased_11_20
+          is Unconstrained_Array_Aliased(11..20);
+
+  subtype Access_All_01_10_Array
+          is Access_All_Unconstrained_Array(01..10);
+
+  subtype Access_All_01_10_Array_Aliased
+          is Access_All_Unconstrained_Array_Aliased(01..10);
+
+  subtype Access_All_11_20_Array
+          is Access_All_Unconstrained_Array(11..20);
+
+  subtype Access_All_11_20_Array_Aliased
+          is Access_All_Unconstrained_Array_Aliased(11..20);
+
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+  -- these 'filler' functions create unique values for every element that
+  -- is used and/or tested in this test.
+
+  Well_Bottom : Integer := 0;
+
+  function Filler( Size : Mod_128 ) return Unconstrained_Array is
+    It : Unconstrained_Array( 0..Size-1 );
+  begin
+    for Eyes in It'Range loop
+      It(Eyes) := Integer( Eyes ) + Well_Bottom;
+    end loop;
+    Well_Bottom := Well_Bottom + It'Length;
+    return It;
+  end Filler;
+
+  function Filler( Size : Mod_128 ) return Unconstrained_Array_Aliased is
+    It : Unconstrained_Array_Aliased( 0..Size-1 );
+  begin
+    for Ayes in It'Range loop
+      It(Ayes) := Integer( Ayes ) + Well_Bottom;
+    end loop;
+    Well_Bottom := Well_Bottom + It'Length;
+    return It;
+  end Filler;
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+  An_Integer : Integer;
+
+  type AAI is access all Integer;
+
+  An_Integer_Access : AAI;
+
+  Array_Item_01_10 : Array_01_10 := Filler(10); -- 0..9
+
+  Array_Item_11_20 : Array_11_20 := Filler(10); -- 10..19 (sliding)
+
+  Array_Aliased_Item_01_10 : Array_Aliased_01_10 := Filler(10); -- 20..29
+
+  Array_Aliased_Item_11_20 : Array_Aliased_11_20 := Filler(10); -- 30..39
+
+  Aliased_Array_Item_01_10 : aliased Array_01_10 := Filler(10); -- 40..49
+
+  Aliased_Array_Item_11_20 : aliased Array_11_20 := Filler(10); -- 50..59
+
+  Aliased_Array_Aliased_Item_01_10 : aliased Array_Aliased_01_10
+                                   := Filler(10);               -- 60..69
+
+  Aliased_Array_Aliased_Item_11_20 : aliased Array_Aliased_11_20
+                                   := Filler(10);               -- 70..79
+
+  Check_Item            : Access_All_Unconstrained_Array;
+
+  Check_Aliased_Item    : Access_All_Unconstrained_Array_Aliased;
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+  procedure Fail( Message : String; CI, SB : Integer ) is
+  begin
+    Report.Failed("Wrong value passed " & Message);
+    if Verbose then
+      Report.Comment("got" & Integer'Image(CI) &
+                     " should be" & Integer'Image(SB) );
+    end if;
+  end Fail;
+
+  procedure Check_Array_01_10( Checked_Item : Array_01_10;
+                               Low_SB       : Integer ) is
+  begin
+    for Index in Checked_Item'Range loop
+      if (Checked_Item(Index) /= (Low_SB +Integer(Index)-1)) then
+        Fail("unaliased 1..10", Checked_Item(Index),
+                                (Low_SB +Integer(Index)-1));
+      end if;
+    end loop;
+  end Check_Array_01_10;
+
+  procedure Check_Array_11_20( Checked_Item : Array_11_20;
+                               Low_SB       : Integer ) is
+  begin
+    for Index in Checked_Item'Range loop
+      if (Checked_Item(Index) /= (Low_SB +Integer(Index)-11)) then
+        Fail("unaliased 11..20", Checked_Item(Index),
+                                 (Low_SB +Integer(Index)-11));
+      end if;
+    end loop;
+ end Check_Array_11_20;
+
+  procedure Check_Single_Integer( The_Integer, SB : Integer;
+                                  Message         : String ) is
+  begin
+    if The_Integer /= SB then
+      Report.Failed("Wrong integer value for " & Message );
+    end if;
+  end Check_Single_Integer;
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+begin  -- Main test procedure.
+
+  Report.Test ("C360002", "Check that modular types may be used as array " &
+                          "indices.  Check that if aliased appears in " &
+                          "the component_definition of an array_type that " &
+                          "each component of the array is aliased.  Check " &
+                          "that references to aliased array objects " &
+                          "produce correct results, and that out of bound " &
+                          "references to aliased objects correctly " &
+                          "produce Constraint_Error" );
+  -- start with checks that the Filler assignments produced the expected
+  -- result.  This is a "case 0" test to check that nothing REALLY surprising
+  -- is happening
+
+  Check_Array_01_10( Array_Item_01_10, 0 );
+  Check_Array_11_20( Array_Item_11_20, 10 );
+
+  -- check that having the variable aliased makes no difference
+  Check_Array_01_10( Aliased_Array_Item_01_10, 40 );
+  Check_Array_11_20( Aliased_Array_Item_11_20, 50 );
+
+  -- now check that conversion between array types where the only
+  -- difference in the definitions is that the components are aliased works
+
+  Check_Array_01_10( Unconstrained_Array( Array_Aliased_Item_01_10 ), 20 );
+  Check_Array_11_20( Unconstrained_Array( Array_Aliased_Item_11_20 ), 30 );
+
+  -- check that conversion of an aliased object with aliased components
+  -- also works
+
+  Check_Array_01_10( Unconstrained_Array( Aliased_Array_Aliased_Item_01_10 ),
+                     60 );
+  Check_Array_11_20( Unconstrained_Array( Aliased_Array_Aliased_Item_11_20 ),
+                     70 );
+
+  -- check that the bounds will slide
+
+  Check_Array_01_10( Array_01_10( Array_Item_11_20 ), 10 );
+  Check_Array_11_20( Array_11_20( Array_Item_01_10 ),  0 );
+
+  -- point at some of the components and check them
+
+  An_Integer_Access := Array_Aliased_Item_01_10(5)'Access;
+
+  Check_Single_Integer( An_Integer_Access.all, 24,
+                       "Aliased component 'Access");
+
+  An_Integer_Access := Aliased_Array_Aliased_Item_01_10(7)'Access;
+
+  Check_Single_Integer( An_Integer_Access.all, 66,
+                       "Aliased Aliased component 'Access");
+
+  -- check some assignments
+
+  Array_Item_01_10 := Aliased_Array_Item_01_10;
+  Check_Array_01_10( Array_Item_01_10, 40 );
+
+  Aliased_Array_Item_01_10 := Aliased_Array_Item_11_20(11..20);
+  Check_Array_01_10( Aliased_Array_Item_01_10, 50 );
+
+  Aliased_Array_Aliased_Item_11_20(11..20)
+                                       := Aliased_Array_Aliased_Item_01_10;
+  Check_Array_11_20( Unconstrained_Array( Aliased_Array_Aliased_Item_11_20 ),
+                     60 );
+
+  Report.Result;
+
+end C360002;