c452001.a

来自「linux下编程用 编译软件」· A 代码 · 共 708 行 · 第 1/2 页

        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;