-- F452A00.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.
--*
--
-- FOUNDATION DESCRIPTION:
--     This foundation provides basic operations to test whether equality of
--     a type is the same inside and outside of this foundation.
--
--     The language requires that the equality operations of
--     language-defined types act as if they are predefined, that is, the
--     operation remain the same inside of a generic (where some predefined
--     operation code reemerge) and that they participate in the predefined
--     equality of all composite types containing it as a part (including
--     arrays). This is only true for record types; for other kinds of types,
--     any user-defined "=" is ignored inside of a generic and in composition
--     of of equality.
--
--     Note that the three formal objects always be independent objects and
--     must have the relationship
--       Obj1 = Obj2 /= Obj3
--     If not, the test may fail incorrectly or miss errors.

-- CHANGE HISTORY:
--     25 JAN 2001   PHL   Initial version.
--     19 Dec 2018   RLB   Created foundation from part of submitted test.

generic
    Subtest : String;
    type T is private;

    -- Obj1 = Obj2 /= Obj3, and they are all created independently.
    Obj1 : in T;
    Obj2 : in out T;
    Obj3 : in out T;
package F452A00 is

    type A is array (Boolean range <>) of T;

    type R (D : Boolean) is
        record
            C1 : Character;
            case D is
                when False =>
                    C2 : A (False .. D);
                    C3 : Float;
                when True =>
                    C4 : Boolean;
                    C5 : T;
            end case;
        end record;

    procedure Check;

end F452A00;

with Report;
use Report;
package body F452A00 is

    Cnt : Natural := 0;

    procedure Fill_False (X : out R; Obj : T) is
    begin
        X.C1 := Ident_Char ('a');
        X.C2 := (Ident_Bool (False) .. Ident_Bool (False) => Obj);
        X.C3 := 5.0;
    end Fill_False;

    procedure Fill_True (X : out R; Obj : T) is
    begin
        X.C1 := Ident_Char ('b');
        X.C4 := Ident_Bool (True);
        X.C5 := Obj;
    end Fill_True;

    procedure Fill (X : out T) is
    begin
        Cnt := Cnt + 1;
        case Cnt mod 3 is
            when 0 =>
                X := Obj3;
            when 1 =>
                X := Obj1;
            when 2 =>
                X := Obj2;
            when others =>
                Failed (Subtest & " - Something went wrong in case statement");
        end case;
    end Fill;

    procedure Check is

    begin
        Comment (Subtest & " - Checking reemergence of equality");
        if Obj1 /= Obj2 or Obj1 = Obj3 or Obj2 = Obj3 then
            Failed
               (Subtest &
                " - predefined equality reemerged in generic instantiation");
        end if;

        Comment (Subtest & " - Checking composability of equality");

        Rec:
            declare
                X1 : R := (D  => False,
                           C1 => Ident_Char ('a'),
                           C2 => (others => Obj1),
                           C3 => 5.0);
                X2 : R (Ident_Bool (False));
                X3 : R (False);

                Y1 : R (Ident_Bool (True));
                Y2 : constant R := (D  => True,
                                    C1 => Ident_Char ('b'),
                                    C4 => Ident_Bool (True),
                                    C5 => Obj2);
                Y3 : R (True);
            begin
                Fill_False (X2, Obj2);
                Fill_False (X3, Obj3);
                Fill_True (Y1, Obj1);
                Fill_True (Y3, Obj3);
                if X1 /= X2 or X1 = X3 or X2 = X3 or
                   Y1 /= Y2 or Y1 = Y3 or Y2 = Y3 then
                    Failed
                       (Subtest &
                        " - Equality does not compose properly for records");
                end if;
            end Rec;

        Arr:
            declare
                type A is array (Positive range <>) of T;

                X1 : A (Ident_Int (10) .. Ident_Int (12)) :=
                         (Obj1, Obj2, Obj3);
                X2 : A (Ident_Int (7) .. Ident_Int (9));
                X3 : constant A (1 .. 3) := (Obj2, Obj2, Obj2);
            begin
                Fill (X2 (X2'First));
                Fill (X2 (X2'First + 1));
                Fill (X2 (X2'First + 2));
                if X1 /= X2 or X1 = X3 or X2 = X3 then
                    Failed (Subtest &
                          " - Equality does not compose properly for arrays");
                end if;
            end Arr;

    end Check;

end F452A00;