Subversion Repositories openrisc_me

-- C452001.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:

--      For a type extension, check that predefined equality is defined in

--      terms of the primitive equals operator of the parent type and any

--      tagged components of the extension part.

--

--      For other composite types, check that the primitive equality operator

--      of any matching tagged components is used to determine equality of the

--      enclosing type.

--

--      For private types, check that predefined equality is defined in

--      terms of the user-defined (primitive) operator of the full type if

--      the full type is tagged. The partial view of the type may be

--      tagged or untagged. Check that predefined equality for a private

--      type whose full view is untagged is defined in terms of the

--      predefined equality operator of its full type.

--

-- TEST DESCRIPTION:

--      Tagged types are declared and used as components in several

--      differing composite type declarations, both tagged and untagged.

--      To differentiate between predefined and primitive equality

--      operations, user-defined equality operators are declared for

--      each component type that is to contribute to the equality

--      operator of the composite type that houses it. All user-defined

--      equality operations are designed to yield the opposite result

--      from the predefined operator, given the same component values.

--

--      For cases where primitive equality is to be incorporated into

--      equality for the enclosing composite type, values are assigned

--      to the component type so that user-defined equality will return

--      True. If predefined equality is to be used instead, then the

--      same strategy results in the equality operator returning False.

--

--      When equality for a type incorporates the user-defined equality

--      operator of one of its component types, the resulting operator

--      is considered to be the predefined operator of the composite type.

--      This case is confirmed by defining an tagged component of an

--      untagged composite type, then using the resulting untagged type

--      as a component of another composite type. The user-defined operator

--      for the lowest level should still be called.

--

--      Three cases are set up to test private types:

--

--                        Case 1        Case 2      Case 3

--         partial view:  tagged       untagged    untagged

--         full view:     tagged        tagged     untagged

--

--      Types are declared for each of the above cases and user-defined

--      (primitive) operators are declared following the full type

--      declaration of each type (i.e., in the private part).

--

--      Values are assigned into objects of these types using the same

--      strategy outlined above. Cases 1 and 2 should execute the

--      user-defined operator. Case 3 should ignore the user-defined

--      operator and user predefined equality for the type.

--

--

-- CHANGE HISTORY:

--      06 Dec 94   SAIC    ACVC 2.0

--      19 Dec 94   SAIC    Removed RM references from objective text.

--      15 Nov 95   SAIC    Fixed for 2.0.1

--      04 NOV 96   SAIC    Typographical revision

--

--!

package c452001_0 is

   type Point is

      record

         X : Integer := 0;

         Y : Integer := 0;

      end record;

   type Circle is tagged

      record

         Center : Point;

         Radius : Integer;

      end record;

   function "=" (L, R : Circle) return Boolean;

   type Colors is (Red, Orange, Yellow, Green, Blue, Purple, Black, White);

   type Colored_Circle is new Circle

      with record

         Color : Colors := White;

      end record;

   function "=" (L, R : Colored_Circle) return Boolean;

   -- Override predefined equality for this tagged type. Predefined

   -- equality should incorporate user-defined (primitive) equality

   -- from type Circle. See C340001 for a test of that feature.

   -- Equality is overridden to ensure that predefined equality

   -- incorporates this user-defined function for

   -- any composite type with Colored_Circle as a component type.

   -- (i.e., the type extension is recognized as a tagged type for

   -- the purpose of defining predefined equality for the composite type).

end C452001_0;

package body c452001_0 is

   function "=" (L, R : Circle) return Boolean is

   begin

      return L.Radius = R.Radius; -- circles are same size

   end "=";

   function "=" (L, R : Colored_Circle) return Boolean is

   begin

      return Circle(L) = Circle(R);

   end "=";

end C452001_0;

with C452001_0;

package C452001_1 is

   type Planet is tagged record

      Name : String (1..15);

      Representation : C452001_0.Colored_Circle;

   end record;

   -- Type Planet will be used to check that predefined equality

   -- for a tagged type with a tagged component incorporates

   -- user-defined equality for the component type.

   type TC_Planet is new Planet with null record;

   -- A "copy" of Planet. Used to create a type extension. An "="

   -- operator will be defined for this type that should be

   -- incorporated by the type extension.

   function "=" (Arg1, Arg2 : in TC_Planet) return Boolean;

   type Craters is array (1..3) of C452001_0.Colored_Circle;

   -- An array type (untagged) with tagged components

   type Moon is new TC_Planet

     with record

        Crater : Craters;

     end record;

   -- A tagged record type. Extended component type is untagged,

   -- but its predefined equality operator should incorporate

   -- the user-defined operator of its tagged component type.

end C452001_1;

package body C452001_1 is

   function "=" (Arg1, Arg2 : in TC_Planet) return Boolean is

   begin

      return Arg1.Name = Arg2.Name;

   end "=";

end C452001_1;

package C452001_2 is

   -- Untagged record types

   -- Equality should not be incorporated

   type Spacecraft_Design is (Mariner, Pioneer, Viking, Voyager);

   type Spacecraft is record

     Design      : Spacecraft_Design;

     Operational : Boolean;

   end record;

   function "=" (L : in Spacecraft; R : in Spacecraft) return Boolean;

   type Mission is record

      Craft       : Spacecraft;

      Launch_Date : Natural;

   end record;

   type Inventory is array (Positive range <>) of Spacecraft;

end C452001_2;

package body C452001_2 is

   function "=" (L : in Spacecraft; R : in Spacecraft) return Boolean is

   begin

      return L.Design = R.Design;

   end "=";

end C452001_2;

package C452001_3 is

   type Tagged_Partial_Tagged_Full is tagged private;

   procedure Change (Object : in out Tagged_Partial_Tagged_Full;

                    Value  : in Boolean);

   type Untagged_Partial_Tagged_Full is private;

   procedure Change (Object : in out Untagged_Partial_Tagged_Full;

                    Value  : in Integer);

   type Untagged_Partial_Untagged_Full is private;

   procedure Change (Object : in out Untagged_Partial_Untagged_Full;

                    Value  : in Duration);

private

   type Tagged_Partial_Tagged_Full is

      tagged record

         B : Boolean := True;

         C : Character := ' ';

      end record;

   -- predefined equality checks that all components are equal

   function "=" (L, R : in Tagged_Partial_Tagged_Full) return Boolean;

   -- primitive equality checks that records equate in component C only

   type Untagged_Partial_Tagged_Full is

      tagged record

         I : Integer := 0;

         P : Positive := 1;

      end record;

   -- predefined equality checks that all components are equal

   function "=" (L, R : in Untagged_Partial_Tagged_Full) return Boolean;

   -- primitive equality checks that records equate in component P only

   type Untagged_Partial_Untagged_Full is

      record

         D : Duration := 0.0;

         S : String (1..12) := "Ada 9X rules";

      end record;

   -- predefined equality checks that all components are equal

   function "=" (L, R : in Untagged_Partial_Untagged_Full) return Boolean;

   -- primitive equality checks that records equate in component S only

end C452001_3;

with Report;

package body C452001_3 is

   procedure Change (Object : in out Tagged_Partial_Tagged_Full;

                    Value  : in Boolean) is

   begin

      Object := (Report.Ident_Bool(Value), Object.C);

   end Change;

   procedure Change (Object : in out Untagged_Partial_Tagged_Full;

                    Value  : in Integer) is

   begin

      Object := (Report.Ident_Int(Value), Object.P);

   end Change;

   procedure Change (Object : in out Untagged_Partial_Untagged_Full;

                    Value  : in Duration) is

   begin

      Object := (Value, Report.Ident_Str(Object.S));

   end Change;

   function "=" (L, R : in Tagged_Partial_Tagged_Full) return Boolean is

   begin

      return L.C = R.C;

   end "=";

   function "=" (L, R : in Untagged_Partial_Tagged_Full) return Boolean is

   begin

      return L.P = R.P;

   end "=";

   function "=" (L, R : in Untagged_Partial_Untagged_Full) return Boolean is

   begin

      return R.S = L.S;

   end "=";

end C452001_3;

with C452001_0;

with C452001_1;

with C452001_2;

with C452001_3;

with Report;

procedure C452001 is

   Mars_Aphelion : C452001_1.Planet :=

      (Name           => "Mars           ",

       Representation => (Center => (Report.Ident_Int(20),

                                     Report.Ident_Int(0)),

                          Radius => Report.Ident_Int(4),

                          Color  => C452001_0.Red));

   Mars_Perihelion : C452001_1.Planet :=

      (Name           => "Mars           ",

       Representation => (Center => (Report.Ident_Int(-20),

                                     Report.Ident_Int(0)),

                          Radius => Report.Ident_Int(4),

                          Color  => C452001_0.Red));

   -- Mars_Perihelion = Mars_Aphelion if user-defined equality from

   -- the tagged type Colored_Circle was incorporated into

   -- predefined equality for the tagged type Planet. User-defined

   -- equality for Colored_Circle checks only that the Radii are equal.

   Blue_Mars : C452001_1.Planet :=

      (Name           => "Mars           ",

       Representation => (Center => (Report.Ident_Int(10),

                                     Report.Ident_Int(10)),

                          Radius => Report.Ident_Int(4),

                          Color  => C452001_0.Blue));

   -- Blue_Mars should equal Mars_Perihelion, because Names and

   -- Radii are equal (all other components are not).

   Green_Mars : C452001_1.Planet :=

      (Name           => "Mars           ",

       Representation => (Center => (Report.Ident_Int(10),

                                     Report.Ident_Int(10)),

                          Radius => Report.Ident_Int(4),

                          Color  => C452001_0.Green));

   -- Blue_Mars should equal Green_Mars. They differ only in the

   -- Color component. All user-defined equality operations return

   -- True, but records are not equal by predefined equality.

   -- Blue_Mars should equal Mars_Perihelion, because Names and

   -- Radii are equal (all other components are not).

   Moon_Craters : C452001_1.Craters :=

      ((Center => (Report.Ident_Int(9), Report.Ident_Int(11)),

        Radius => Report.Ident_Int(1),

        Color  => C452001_0.Black),

       (Center => (Report.Ident_Int(10), Report.Ident_Int(10)),

        Radius => Report.Ident_Int(1),

        Color  => C452001_0.Black),

       (Center => (Report.Ident_Int(11), Report.Ident_Int(9)),

        Radius => Report.Ident_Int(1),

        Color  => C452001_0.Black));

   Alternate_Moon_Craters : C452001_1.Craters :=

      ((Center => (Report.Ident_Int(9), Report.Ident_Int(9)),

        Radius => Report.Ident_Int(1),

        Color  => C452001_0.Yellow),

       (Center => (Report.Ident_Int(10), Report.Ident_Int(10)),

        Radius => Report.Ident_Int(1),

        Color  => C452001_0.Purple),

       (Center => (Report.Ident_Int(11), Report.Ident_Int(11)),

        Radius => Report.Ident_Int(1),

        Color  => C452001_0.Purple));

   -- Moon_Craters = Alternate_Moon_Craters if user-defined equality from

   -- the tagged type Colored_Circle was incorporated into

   -- predefined equality for the untagged type Craters. User-defined

   -- equality checks only that the Radii are equal.

   New_Moon : C452001_1.Moon :=

      (Name           => "Moon           ",

       Representation => (Center => (Report.Ident_Int(10),

                                     Report.Ident_Int(8)),

                          Radius => Report.Ident_Int(3),

                          Color  => C452001_0.Black),

       Crater         => Moon_Craters);

   Full_Moon : C452001_1.Moon :=

      (Name           => "Moon           ",

       Representation => (Center => (Report.Ident_Int(10),

                                     Report.Ident_Int(8)),

                          Radius => Report.Ident_Int(3),

                          Color  => C452001_0.Black),

       Crater         => Alternate_Moon_Craters);

   -- New_Moon = Full_Moon if user-defined equality from

   -- the tagged type Colored_Circle was incorporated into

   -- predefined equality for the untagged type Craters. This

   -- equality test should call user-defined equality for type

   -- TC_Planet (checks that Names are equal), then predefined

   -- equality for Craters (ultimately calls user-defined equality

   -- for type Circle, checking that Radii of craters are equal).

   Mars_Moon : C452001_1.Moon :=

      (Name           => "Phobos         ",

       Representation => (Center => (Report.Ident_Int(10),

                                     Report.Ident_Int(8)),

                          Radius => Report.Ident_Int(3),

                          Color  => C452001_0.Black),

       Crater         => Alternate_Moon_Craters);

   -- Mars_Moon /= Full_Moon since the Names differ.

   Alternate_Moon_Craters_2 : C452001_1.Craters :=

      ((Center => (Report.Ident_Int(10), Report.Ident_Int(10)),

        Radius => Report.Ident_Int(1),

        Color  => C452001_0.Red),

       (Center => (Report.Ident_Int(9), Report.Ident_Int(9)),

        Radius => Report.Ident_Int(1),

        Color  => C452001_0.Red),

       (Center => (Report.Ident_Int(10), Report.Ident_Int(9)),

        Radius => Report.Ident_Int(1),

        Color  => C452001_0.Red));

   Harvest_Moon : C452001_1.Moon :=

      (Name           => "Moon           ",

       Representation => (Center => (Report.Ident_Int(11),

                                     Report.Ident_Int(7)),

                          Radius => Report.Ident_Int(4),

                          Color  => C452001_0.Orange),

       Crater         => Alternate_Moon_Craters_2);

   -- Only the fields that are employed by the user-defined equality

   -- operators are the same. Everything else differs. Equality should

   -- still return True.

   Viking_1_Orbiter : C452001_2.Mission :=

      (Craft => (Design      => C452001_2.Viking,

                 Operational => Report.Ident_Bool(False)),

       Launch_Date => 1975);

   Viking_1_Lander : C452001_2.Mission :=

      (Craft => (Design      => C452001_2.Viking,

                 Operational => Report.Ident_Bool(True)),

       Launch_Date => 1975);

   -- Viking_1_Orbiter /= Viking_1_Lander if predefined equality

   -- from the untagged type Spacecraft is used for equality

   -- of matching components in type Mission. If user-defined

   -- equality for type Spacecraft is incorporated, which it

   -- should not be by 4.5.2(21), then Viking_1_Orbiter = Viking_1_Lander.

   Voyagers : C452001_2.Inventory (1..2):=

    ((C452001_2.Voyager, Operational => Report.Ident_Bool(True)),

     (C452001_2.Voyager, Operational => Report.Ident_Bool(False)));

   Jupiter_Craft : C452001_2.Inventory (1..2):=

    ((C452001_2.Voyager, Operational => Report.Ident_Bool(True)),

     (C452001_2.Voyager, Operational => Report.Ident_Bool(True)));

   -- Voyagers /= Jupiter_Craft if predefined equality

   -- from the untagged type Spacecraft is used for equality

   -- of matching components in type Inventory. If user-defined

   -- equality for type Spacecraft is incorporated, which it

   -- should not be by 4.5.2(21), then Voyagers = Jupiter_Craft.

   TPTF_1 : C452001_3.Tagged_Partial_Tagged_Full;

   TPTF_2 : C452001_3.Tagged_Partial_Tagged_Full;

   -- With differing values for Boolean component, user-defined

   -- (primitive) equality returns True, predefined equality

   -- returns False. Since full type is tagged, primitive equality

   -- should be used.

   UPTF_1 : C452001_3.Untagged_Partial_Tagged_Full;

   UPTF_2 : C452001_3.Untagged_Partial_Tagged_Full;

   -- With differing values for Boolean component, user-defined

   -- (primitive) equality returns True, predefined equality

   -- returns False. Since full type is tagged, primitive equality

   -- should be used.

   UPUF_1 : C452001_3.Untagged_Partial_Untagged_Full;

   UPUF_2 : C452001_3.Untagged_Partial_Untagged_Full;

   -- With differing values for Duration component, user-defined

   -- (primitive) equality returns True, predefined equality

   -- returns False. Since full type is untagged, predefined equality

   -- should be used.

   -- Use type clauses make "=" and "/=" operators directly visible

   use type C452001_1.Planet;

   use type C452001_1.Craters;

   use type C452001_1.Moon;

   use type C452001_2.Mission;

   use type C452001_2.Inventory;

   use type C452001_3.Tagged_Partial_Tagged_Full;

   use type C452001_3.Untagged_Partial_Tagged_Full;

   use type C452001_3.Untagged_Partial_Untagged_Full;

begin

   Report.Test ("C452001", "Equality of private types and " &

                           "composite types with tagged components");

   -------------------------------------------------------------------

   -- Tagged type with tagged component.

   -------------------------------------------------------------------

   if not (Mars_Aphelion = Mars_Perihelion) then

      Report.Failed ("User-defined equality for tagged component " &

                     "was not incorporated into predefined equality " &

                     "for enclosing tagged record type");

   end if;

   if Mars_Aphelion /= Mars_Perihelion then

      Report.Failed ("User-defined equality for tagged component " &

                     "was not incorporated into predefined inequality " &

                     "for enclosing tagged record type");

   end if;

   if not (Blue_Mars = Mars_Perihelion) then

      Report.Failed ("Equality test for tagged record type " &

                     "incorporates record components " &

                     "other than those used by user-defined equality");

   end if;

   if Blue_Mars /= Mars_Perihelion then

      Report.Failed ("Inequality test for tagged record type " &

                     "incorporates record components " &

                     "other than those used by user-defined equality");

   end if;

   if Blue_Mars /= Green_Mars then

      Report.Failed ("Records are unequal even though they only differ " &

                     "in a component not used by user-defined equality");

   end if;

   if not (Blue_Mars = Green_Mars) then

      Report.Failed ("Records are not equal even though they only differ " &

                     "in a component not used by user-defined equality");

   end if;

   -------------------------------------------------------------------

   -- Untagged (array) type with tagged component.

   -------------------------------------------------------------------

   if not (Moon_Craters = Alternate_Moon_Craters) then

      Report.Failed ("User-defined equality for tagged component " &

                     "was not incorporated into predefined equality " &

                     "for enclosing array type");

   end if;

   if Moon_Craters /= Alternate_Moon_Craters then

      Report.Failed ("User-defined equality for tagged component " &

                     "was not incorporated into predefined inequality " &

                     "for enclosing array type");

   end if;

   -------------------------------------------------------------------

   -- Tagged type with untagged composite component. Untagged

   -- component itself has tagged components.

   -------------------------------------------------------------------

   if not (New_Moon = Full_Moon) then

      Report.Failed ("User-defined equality for tagged component " &

                     "was not incorporated into predefined equality " &

                     "for array component of tagged record type");

   end if;

   if New_Moon /= Full_Moon then

      Report.Failed ("User-defined equality for tagged component " &

                     "was not incorporated into predefined inequality " &

                     "for array component of tagged record type");

   end if;

   if Mars_Moon = Full_Moon then

      Report.Failed ("User-defined equality for tagged component " &

                     "was not incorporated into predefined equality " &

                     "for array component of tagged record type");

   end if;

   if not (Mars_Moon /= Full_Moon) then

      Report.Failed ("User-defined equality for tagged component " &

                     "was not incorporated into predefined inequality " &

                     "for array component of tagged record type");

   end if;

   if not (Harvest_Moon = Full_Moon) then

      Report.Failed ("Equality test for record with array of tagged " &

                     "components incorporates record components " &

                     "other than those used by user-defined equality");

   end if;

   if Harvest_Moon /= Full_Moon then

      Report.Failed ("Inequality test for record with array of tagged " &

                     "components incorporates record components " &

                     "other than those used by user-defined equality");

   end if;

   -------------------------------------------------------------------

   -- Untagged types with no tagged components.

   -------------------------------------------------------------------

   -- Record type

   if Viking_1_Orbiter = Viking_1_Lander then

      Report.Failed ("User-defined equality for untagged composite " &

                     "component was incorporated into predefined " &

                     "equality for " &

                     "untagged record type");

   end if;

   if not (Viking_1_Orbiter /= Viking_1_Lander) then

      Report.Failed ("User-defined equality for untagged composite " &

                     "component was incorporated into predefined " &

                     "inequality for " &

                     "untagged record type");

   end if;

   -- Array type

   if Voyagers = Jupiter_Craft then

      Report.Failed ("User-defined equality for untagged composite " &

                     "component was incorporated into predefined " &

                     "equality for " &

                     "array type");

   end if;

   if not (Voyagers /= Jupiter_Craft) then

      Report.Failed ("User-defined equality for untagged composite " &

                     "component was incorporated into predefined " &

                     "inequality for " &

                     "array type");

   end if;

   -------------------------------------------------------------------

   -- Private types tests.

   -------------------------------------------------------------------

   -- Make objects differ from one another

   C452001_3.Change (TPTF_1, False);

   C452001_3.Change (UPTF_1, 999);

   C452001_3.Change (UPUF_1, 40.0);

   -------------------------------------------------------------------

   -- Partial type and full type are tagged. (Full type must be tagged

   -- if partial type is tagged)

   -------------------------------------------------------------------

   if not (TPTF_1 = TPTF_2) then

      Report.Failed ("Predefined equality for full type " &

                     "was used to determine equality of " &

                     "tagged private type " &

                     "instead of user-defined (primitive) equality");

   end if;

   if TPTF_1 /= TPTF_2 then

      Report.Failed ("Predefined equality for full type " &

                     "was used to determine inequality of " &

                     "tagged private type " &

                     "instead of user-defined (primitive) equality");

   end if;

   -------------------------------------------------------------------

   -- Partial type untagged, full type tagged.

   -------------------------------------------------------------------

   if not (UPTF_1 = UPTF_2) then

      Report.Failed ("Predefined equality for full type " &

                     "was used to determine equality of " &

                     "private type (untagged partial view, " &

                     "tagged full view) " &

                     "instead of user-defined (primitive) equality");

   end if;

   if UPTF_1 /= UPTF_2 then

      Report.Failed ("Predefined equality for full type " &

                     "was used to determine inequality of " &

                     "private type (untagged partial view, " &

                     "tagged full view) " &

                     "instead of user-defined (primitive) equality");

   end if;

   -------------------------------------------------------------------

   -- Partial type and full type are both untagged.

   -------------------------------------------------------------------

   if UPUF_1 = UPUF_2 then

      Report.Failed ("User-defined (primitive) equality for full type " &

                     "was used to determine equality of " &

                     "private type (untagged partial view, " &

                     "untagged full view) " &

                     "instead of predefined equality");

   end if;

   if not (UPUF_1 /= UPUF_2) then

      Report.Failed ("User-defined (primitive) equality for full type " &

                     "was used to determine inequality of " &

                     "private type (untagged partial view, " &

                     "untagged full view) " &

                     "instead of predefined equality");

   end if;

   -------------------------------------------------------------------

   Report.Result;

end C452001;