path: root/gcc/testsuite/ada/acats-4/tests/c4/c433008.a

-- C433008.A
--
--                             Grant of Unlimited Rights
--
--     The Ada Conformity Assessment Authority (ACAA) holds unlimited
--     rights in the software and documentation contained herein. Unlimited
--     rights are the same as those granted by the U.S. Government for older
--     parts of the Ada Conformity Assessment Test Suite, and are defined
--     in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
--     intends to confer upon all recipients unlimited rights equal to those
--     held by the ACAA. 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 ACAA 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.
--
--                                     Notice
--
--     The ACAA has created and maintains the Ada Conformity Assessment Test
--     Suite for the purpose of conformity assessments conducted in accordance
--     with the International Standard ISO/IEC 18009 - Ada: Conformity
--     assessment of a language processor. This test suite should not be used
--     to make claims of conformance unless used in accordance with
--     ISO/IEC 18009 and any applicable ACAA procedures.
--
--*
-- OBJECTIVE:
--      Check that the constraint of the applicable index constraint of a
--      conditional_expression is used to determine the bounds of the body
--      expression array aggregate with an others choice.
--
-- TEST DESCRIPTION:
--      Tests paragraph 4.3.3(15.1/3).  Test that the correct index constraint
--      is used within a conditional expression.
--      Both arrays with an integer type index and arrays with an
--      enumeration type index are tested.
--      Both arrays with static bounds and arrays with dynamic bounds are
--      tested.
--      Aggregates are commonly used. Thus, we assume that almost all cases
--      will eventually appear in actual usage and thus do not try to describe
--      a specific usage scenario.
--      We generally try to avoid arrays beginning with a low bound of 0 or 1
--      in case anyone more familiar with another language has made
--      assumptions. We mix use of if expressions and case expressions.
--
-- CHANGE HISTORY:
--      2022-10-12   JAC      Initial pre-release version.
--      2022-12-29   RLB      Created Ada 2012 version by removing
--                            Ada 2022 features. Added expression function and
--                            return statement cases.
--
--!

with Report;

procedure C433008 is

   -- Array with integer type as index

   subtype Small_Float   is Float   range 0.0 .. 1_000.0;
   subtype Small_Integer is Integer range -10 .. 10;

   type One_D_Array_Type is array (Small_Integer range <>) of Small_Float;

   subtype Index_Type is Small_Integer range 2 .. 5;
   subtype One_D_Array_Static_4_Type is One_D_Array_Type (Index_Type);
   subtype Slid_Array_Type           is One_D_Array_Type (1 .. 4);

   Condition : constant Natural := Report.Ident_Int (2);

   -- Named array aggregate with others, target type constrained.
   -- Low bound from target
   My_One_D_Array_Static_4  : constant One_D_Array_Static_4_Type :=
     (if Condition > 4 then
        (1.0, 2.0, 3.0, others => 5.0)
      else
        (5.0, 4.0, 3.0, others => 2.0)
      );

   -- Named array aggregate with others, target type constrained.
   -- Low bound from target
   My_One_D_Array_Dynamic_4 : constant One_D_Array_Type
     (Report.Ident_Int (2) .. Report.Ident_Int (5)) :=
     (case Condition is
        when 1 =>
          (1.0, 2.0, 3.0, others => 5.0),
        when 2 =>
          (2.0, 3.0, 4.0, others => 1.0),
        when others =>
          (3.0, 4.0, 5.0, others => 2.0)
      );

   Slid_Array : Slid_Array_Type;


   -- Array with enumeration type as index

   type Colour_Type is (Red, Orange, Yellow, Green, Blue, Purple);

   type Colour_Array_Type is array (Colour_Type range <>) of Colour_Type;

   subtype Colour_Array_Static_Four_Type  is Colour_Array_Type (Red .. Green);

   Small_Palette_Static  : constant Colour_Array_Static_Four_Type :=
     (case Condition is
        when 1 =>
          (Purple, Blue,   Green,  others => Yellow),
        when 2 =>
          (Blue,   Green,  Yellow, others => Orange),
        when others =>
          (Green,  Yellow, Orange, others => Red)
      );

   subtype Colour_Array_Dynamic_Four_Type is Colour_Array_Type
     (Colour_Type'Val (Report.Ident_Int (0)) .. -- Red
      Colour_Type'Val (Report.Ident_Int (3)));  -- Green

   Small_Palette_Dynamic : constant Colour_Array_Dynamic_Four_Type :=
     (if Condition > 4 then
        (Orange, Yellow, Green,  others => Red)
      else
        (Red,    Orange, Yellow, others => Blue)
      );

   function Static_Palette (Code : in Natural)
      return Colour_Array_Static_Four_Type is
         (case Code is
            when 1 =>
              (Orange, Blue,   Green,  others => Yellow),
            when 2 =>
              (Blue,   Purple,  Yellow, others => Orange),
            when others =>
              (Green,  Yellow, Orange, others => Purple)
         );

   function Dynamic_Palette (Code : in Natural)
       return Colour_Array_Dynamic_Four_Type is
   begin
      return 
        (if Code > 4 then
           (Orange, Purple, Green,  others => Blue)
        else
           (Purple, Orange, Yellow, others => Red)
        );
   end Dynamic_Palette;


   procedure Check_One_D_Array_Static_4
     (One_D_Array_Static_4 : One_D_Array_Static_4_Type) is
   begin
      if One_D_Array_Static_4'First  /= 2 then
         Report.Failed
           ("'First not as expected, for parameter of an array type with an" &
            " integer type index of static bounds");
      end if;

      if One_D_Array_Static_4'Last   /= 5 then
         Report.Failed
           ("'Last not as expected, for parameter of an array type with an" &
            " integer type index of static bounds");
      end if;

      if One_D_Array_Static_4        /= (1.0, 2.0, 3.0, 5.0) then
         Report.Failed
           ("Values not as expected, for parameter of an array type with an" &
            " integer type index of static bounds");
      end if;

   end Check_One_D_Array_Static_4;

begin

   Report.Test
     ("C433008",
      "Check that the constraint of the applicable index constraint of a" &
      " conditional_expression is used to determine the bounds of the body" &
      " expression array aggregate with an others choice");


   -- Check object declarations
   -- Array with integer type as index

   if My_One_D_Array_Static_4'First  /= 2 then
      Report.Failed
        ("'First not as expected, for integer type index of static bounds");
   end if;

   if My_One_D_Array_Static_4'Last   /= 5 then
      Report.Failed
        ("'Last not as expected, for integer type index of static bounds");
   end if;

   if My_One_D_Array_Static_4        /= (5.0, 4.0, 3.0, 2.0) then
      Report.Failed
        ("Values not as expected, for integer type index of static bounds");
   end if;

   if My_One_D_Array_Dynamic_4'First /= 2 then
      Report.Failed
        ("'First not as expected, for integer type index of dynamic bounds");
   end if;

   if My_One_D_Array_Dynamic_4'Last  /= 5 then
      Report.Failed
        ("'Last not as expected, for integer type index of dynamic bounds");
   end if;

   if My_One_D_Array_Dynamic_4       /= (2.0, 3.0, 4.0, 1.0) then
      Report.Failed
        ("Values not as expected, for integer type index of dynamic bounds");
   end if;


   -- Array with enumeration type as index

   if Small_Palette_Static'First  /= Red then
      Report.Failed
        ("'First not as expected, for enumeration type index of " &
         "static bounds");
   end if;

   if Small_Palette_Static'Last   /= Green then
      Report.Failed
        ("'Last not as expected, for enumeration type index of " &
         "static bounds");
   end if;

   if Small_Palette_Static        /= (Blue, Green, Yellow, Orange) then
      Report.Failed
        ("Values not as expected, for enumeration type index of " &
         "static bounds");
   end if;

   if Small_Palette_Dynamic'First /= Red then
      Report.Failed
        ("'First not as expected, for enumeration type index of " &
         "dynamic bounds");
   end if;

   if Small_Palette_Dynamic'Last  /= Green then
      Report.Failed
        ("'Last not as expected, for enumeration type index of " &
         "dynamic bounds");
   end if;

   if Small_Palette_Dynamic          /= (Red, Orange, Yellow, Blue) then
      Report.Failed
        ("Values not as expected, for enumeration type index of " &
         "dynamic bounds");
   end if;


   -- Check parameter passing

   Check_One_D_Array_Static_4
     (if Condition < 3 then
        (1.0, 2.0, 3.0, others => 5.0)
      else
        (5.0, 4.0, 3.0, others => 2.0)
      );


   -- Check assignment.  Bounds should be from LHS

   Slid_Array :=
     (case Condition is
        when 1 =>
          (1.0, 2.0, 3.0, others => 5.0),
        when 2 =>
          (2.0, 3.0, 4.0, others => 1.0),
        when others =>
          (3.0, 4.0, 5.0, others => 2.0)
      );

   if Slid_Array'First /= 1 then
      Report.Failed
        ("'First not as expected, for assignment of an array with an integer" &
         " type index of static bounds");
   end if;

   if Slid_Array'Last  /= 4 then
      Report.Failed
        ("'Last not as expected, for assignment of an array with an integer" &
         " type index of static bounds");
   end if;

   if Slid_Array       /= (2.0, 3.0, 4.0, 1.0) then
      Report.Failed
        ("Values not as expected, for assignment of an array with an integer" &
         " type index of static bounds");
   end if;

   -- Check function calls. Bounds should be from the return subtype
   
   if Static_Palette (1)'First /= Red then
      Report.Failed
        ("'First not as expected, for result of function call of an array " &
         "with an enumeration type index of static bounds");
   end if;
   
   if Static_Palette (2)'Last /= Green then
      Report.Failed
        ("'Last not as expected, for result of function call of an array " &
         "with an enumeration type index of static bounds");
   end if;

   if Static_Palette (3) /= (Green, Yellow, Orange, Purple) then
      Report.Failed
        ("Values not as expected, for result of function call of an array " &
         "with an enumeration type index of static bounds");
   end if;

   if Dynamic_Palette (1)'First /= Red then
      Report.Failed
        ("'First not as expected, for result of function call of an array " &
         "with an enumeration type index of dynamic bounds");
   end if;
   
   if Dynamic_Palette (2)'Last /= Green then
      Report.Failed
        ("'Last not as expected, for result of function call of an array " &
         "with an enumeration type index of dynamic bounds");
   end if;

   if Dynamic_Palette (3) /= (Purple, Orange, Yellow, Red) then
      Report.Failed
        ("Values not as expected, for result of function call of an array " &
         "with an enumeration type index of dynamic bounds");
   end if;


   Report.Result;

end C433008;