Patchwork [Ada] Primitive equality for composite types

login
register
mail settings
Submitter Arnaud Charlet
Date Oct. 7, 2010, 9:27 a.m.
Message ID <20101007092708.GA31438@adacore.com>
Download mbox | patch
Permalink /patch/67022/
State New
Headers show

Comments

Arnaud Charlet - Oct. 7, 2010, 9:27 a.m.
In Ada2012 (and retroactively in older versions of the language)  equality of
composite untagged types composes, and an equality operation for a record type
is expanded into calls to individual equality operations for each component
type. The primitive equality is obtained from the list of primitive operations
of the component type, but this list collects all operations that have one
argument of the type, while the desired equality must have both arguments of
the type, and a boolean result. Prior to this patch, the compiler could select
a heterogeneous operation where only the first argument had the right type.

The following must compile quietly in Ada2005 mode:

with Ada.Containers.Vectors;
with Types;
procedure Test1 is
   use Types;
   type Node_Info is record
      Maximum_Channels  : Natural    := 0; -- Max # calls for a non-Agent node.
      Maximum_Agents    : Natural    := 0; -- Max # agents for a non-Line node.
      Active            : Boolean                                := False;
      Load              : Float                                  := 0.0;
      Node_Version      : Types.Version_Type;
      Agents_Registered : Natural                                := 0;
      Agents_Connected  : Natural                                := 0;
      Agents_On_Phone   : Natural                                := 0;
      Lines_In_Use      : Natural                                := 0;
      Restart           : Boolean                                := True;
   end record;


   package Node_Lists is new
     Ada.Containers.Vectors (Index_Type => Positive, Element_Type => Node_Info);
begin
   null;
end Test1;

package Types is
   pragma Pure;

   type Stage_Type is (Pre_Alpha, Alpha, Beta, Gamma, Final);
   type Build_Type is (Debug, Release);

   type Version_Type is record
      Major    : Natural;
      Minor    : Natural;
      Revision : Natural;
      Stage    : Stage_Type;
      Build    : Build_Type;
   end record;

   function "<"  (Left : Version_Type; Right : Stage_Type) return Boolean;
   function ">"  (Left : Version_Type; Right : Stage_Type) return Boolean;
   function "<=" (Left : Version_Type; Right : Stage_Type) return Boolean;
   function ">=" (Left : Version_Type; Right : Stage_Type) return Boolean;
   function "="  (Left : Version_Type; Right : Stage_Type) return Boolean;
   function "="  (Left : Version_Type; Right : Build_Type) return Boolean;
   function "<"  (Left : Version_Type; Right : Version_Type) return Boolean;
   function ">"  (Left : Version_Type; Right : Version_Type) return Boolean;
end Types;

Tested on x86_64-pc-linux-gnu, committed on trunk

2010-10-07  Ed Schonberg  <schonberg@adacore.com>

	* exp_ch4.adb (Expand_Composite_Equality): When looking for a primitive
	equality operation for a record component, verify that both formals
	have the same type, and the result type is boolean.

Patch

Index: exp_ch4.adb
===================================================================
--- exp_ch4.adb	(revision 165080)
+++ exp_ch4.adb	(working copy)
@@ -2193,7 +2193,14 @@  package body Exp_Ch4 is
             begin
                Prim := First_Elmt (Collect_Primitive_Operations (Full_Type));
                while Present (Prim) loop
-                  if Chars (Node (Prim)) = Name_Op_Eq then
+
+                  --  Locate primitive equality with the right signature
+
+                  if Chars (Node (Prim)) = Name_Op_Eq
+                    and then Etype (First_Formal (Node (Prim))) =
+                               Etype (Next_Formal (First_Formal (Node (Prim))))
+                    and then Etype (Node (Prim)) = Standard_Boolean
+                  then
                      if Is_Abstract_Subprogram (Node (Prim)) then
                         return
                           Make_Raise_Program_Error (Loc,