Chapter 9: Object-Oriented Features - TOC - 9.3 TAGGED TYPE OPERATIONS

9.3.4 Equality

guideline

When you redefine the "=" operator on a tagged type, make sure that it has the expected behavior in extensions of this type and override it if necessary.

example

The following example is adapted from the discussion of equality and inheritance in Barnes (1996):

----------------------------------------------------------------------------
package Object_Package is

   Epsilon : constant Float := 0.01;

   type Object is tagged
      record
         X_Coordinate : Float;
         Y_Coordinate : Float;
      end record;

   function "=" (A, B : Object) return Boolean;

end Object_Package;
----------------------------------------------------------------------------
package body Object_Package is

   -- redefine equality to be when two objects are located within a delta
   -- of the same point
   function "=" (A, B : Object) return Boolean is
   begin
      return (A.X_Coordinate - B.X_Coordinate) ** 2
           + (A.Y_Coordinate - B.Y_Coordinate) ** 2 < Epsilon**2;
   end "=";

end Object_Package;

----------------------------------------------------------------------------
with Object_Package;  use Object_Package;
package Circle_Package_1 is
   type Circle is new Object with
      record
         Radius : Float;
      end record;
  function "=" (A, B : Circle) return Boolean;
end Circle_Package_1;
----------------------------------------------------------------------------
package body Circle_Package_1 is

   -- Equality is overridden, otherwise two circles must have exactly
   -- equal radii to be considered equal.
   function "=" (A, B : Circle) return Boolean is
   begin
      return (Object(A) = Object(B)) and
             (abs (A.Radius - B.Radius) < Epsilon);
   end "=";

end Circle_Package_1;
----------------------------------------------------------------------------
with Object_Package;  use Object_Package;
package Circle_Package_2 is

   type Circle is new Object with
      record
         Radius : Float;
      end record;

   -- don't override equality in this package

end Circle_Package_2;
----------------------------------------------------------------------------
with Object_Package;
with Circle_Package_1;
with Circle_Package_2;
with Ada.Text_IO;
procedure Equality_Test is
   use type Object_Package.Object;
   use type Circle_Package_1.Circle;
   use type Circle_Package_2.Circle;
   Object_1 : Object_Package.Object;
   Object_2 : Object_Package.Object;
   Circle_1 : Circle_Package_1.Circle;
   Circle_2 : Circle_Package_1.Circle;
   Circle_3 : Circle_Package_2.Circle;
   Circle_4 : Circle_Package_2.Circle;
begin
   Object_1 := (X_Coordinate => 1.000, Y_Coordinate => 2.000);
   Object_2 := (X_Coordinate => 1.005, Y_Coordinate => 2.000);
   -- These Objects are considered equal.  Equality has been redefined to be
   -- when two objects are located within a delta of the same point.
   if Object_1 = Object_2 then
      Ada.Text_IO.Put_Line ("Objects equal.");
   else
      Ada.Text_IO.Put_Line ("Objects not equal.");
   end if;
   Circle_1 := (X_Coordinate => 1.000, Y_Coordinate => 2.000, Radius => 5.000);
   Circle_2 := (X_Coordinate => 1.005, Y_Coordinate => 2.000, Radius => 5.005);
   -- These Circles are considered equal.  Equality has been redefined to be
   -- when the X-Y locations of the circles and their radii are both within
   -- the delta.
   if Circle_1 = Circle_2 then
      Ada.Text_IO.Put_Line ("Circles equal.");
   else
      Ada.Text_IO.Put_Line ("Circles not equal.");
   end if;
   Circle_3 := (X_Coordinate => 1.000, Y_Coordinate => 2.000, Radius => 5.000);
   Circle_4 := (X_Coordinate => 1.005, Y_Coordinate => 2.000, Radius => 5.005);
   -- These Circles are not considered equal because predefined equality of
   -- the extension component Radius will evaluate to False.
   if Circle_3 = Circle_4 then
      Ada.Text_IO.Put_Line ("Circles equal.");
   else
      Ada.Text_IO.Put_Line ("Circles not equal.");
   end if;
end Equality_Test;

rationale

Equality is applied to all components of a record. When you extend a tagged type and compare two objects of the derived type for equality, the parent components as well as the new extension components will be compared. Therefore, when you redefine equality on a tagged type and define extensions on this type, the parent components are compared using the redefined equality. The extension components are also compared, using either predefined equality or some other redefined equality if appropriate. The behavior of inherited equality differs from the behavior of other inherited operations. When other primitives are inherited, if you do not override the inherited primitive, it can only operate on the parent components of the object of the extended type. Equality, on the other hand, generally does the right thing.