diff gcc/testsuite/ada/acats/tests/c4/c452001.a @ 111:04ced10e8804

gcc 7
author kono
date Fri, 27 Oct 2017 22:46:09 +0900
parents
children
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/gcc/testsuite/ada/acats/tests/c4/c452001.a	Fri Oct 27 22:46:09 2017 +0900
@@ -0,0 +1,707 @@
+-- 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;