-- C432005.A
--
--                             Grant of Unlimited Rights
--
--     AdaCore 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, AdaCore intends to confer upon all
--     recipients unlimited rights equal to those held by the Ada Conformity
--     Assessment Authority. 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. ADACORE 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.
--
--     This test is based on one submitted by AdaCore; AdaCore retains
--     the copyright on the test.
--
--*
--  OBJECTIVE:
--      Check that the ancestor expression type in an extension aggregate can
--      be limited.
--
--      Check that the ancestor subtype mark in an extension aggregate can be
--      limited.
--
--  CHANGE HISTORY:
--      2 Feb 2004 JM  Initial Version.
--     20 Sep 2007 RLB Reduced the test to just test the above objectives.
--
--!
package C432005_0 is

   --  Protected object and Task types used to check that the limited
   --  components are properly initialized (and thus they are fully
   --  operational).

   protected type T_PO is
      entry     Set (Value : in  Integer);
      procedure Get (Value : out Integer);
   private
      Data : Integer := 0;
   end T_PO;

   task type T_Task is
      entry Set (Value : in  Integer);
      entry Get (Value : out Integer);
   end T_Task;

end C432005_0;

-- ----------------------------------------------------------------------------
with Report;
package body C432005_0 is

   protected body T_PO is
      entry Set (Value : in Integer) when True is
      begin
         Data := Value;
      end Set;
      procedure Get (Value : out Integer) is
      begin
         Value := Data;
      end Get;
   end T_PO;

   task body T_Task is
      Data : Integer := 0;
   begin
      accept Set (Value : in Integer) do
         Data := Value;
      end Set;
      accept Get (Value : out Integer) do
         Value := Data;
      end Get;
   end T_Task;

end C432005_0;

-- ----------------------------------------------------------------------------
with Report;
with C432005_0; use C432005_0;
procedure C432005 is

   procedure Check (P : in out T_PO; S : String := "") is
      Value : Integer;
   begin
      --  Check the protected object component
      P.Set (Value => 123);
      P.Get (Value);
      if Value /= 123 then
         Report.Failed (S & " : wrong value in PO component");
      end if;
   end Check;

   procedure Check (T : in out T_Task; S : String := "") is
      Value : Integer;
   begin
      --  Check the task component
      T.Set (Value => 123);
      T.Get (Value);
      if Value /= 123 then
         Report.Failed (S & " : wrong value in task component");
      end if;
   end Check;

begin
   Report.Test ("C432005", "Check that the ancestor expression type in an " &
                           "extension aggregate can be limited. Check that " &
                           "the ancestor subtype mark in an extension " &
                           "aggregate can be limited.");

   declare
      type T10 is tagged limited record
         A : Natural := Report.Ident_Int(999);
      end record;
      type T20 is new T10 with record
         P20 : T_PO;
         T20 : T_Task;
      end record;
      type T30 is new T20 with record
         P30 : T_PO;
         T30 : T_Task;
      end record;

      O1 : T20 := (T10 with P20 => <>, T20 => <>);
      O2 : T20 := (T10'(A => Report.Ident_Int(2)) with P20 => <>, T20 => <>);

      O3 : T30 := (T20 with P30 => <>, T30 => <>);
      O4 : T30 := (T20'(A => Report.Ident_Int(4), P20 => <>, T20 => <>)
                   with P30 => <>, T30 => <>);
   begin
      if O1.A /= 999 then
         Report.Failed ("Wrong value for O1.A");
      end if;
      Check (O1.P20, "O1.P20");
      Check (O1.T20, "O1.T20");

      if O2.A /= 2 then
         Report.Failed ("Wrong value for O2.A");
      end if;
      Check (O2.P20, "O2.P20");
      Check (O2.T20, "O2.T20");

      if O3.A /= 999 then
         Report.Failed ("Wrong value for O3.A");
      end if;
      Check (O3.P20, "O3.P20");
      Check (O3.T20, "O3.T20");
      Check (O3.P30, "O3.P30");
      Check (O3.T30, "O3.T30");

      if O4.A /= 4 then
         Report.Failed ("Wrong value for O4.A");
      end if;
      Check (O4.P20, "O4.P20");
      Check (O4.T20, "O4.T20");
      Check (O4.P30, "O4.P30");
      Check (O4.T30, "O4.T30");
   end;

   Report.Result;
end C432005;