[Ada] Implement AI12-0101
diff mbox series

Message ID 20191213095501.GA13885@adacore.com
State New
Headers show
Series
  • [Ada] Implement AI12-0101
Related show

Commit Message

Pierre-Marie de Rodat Dec. 13, 2019, 9:55 a.m. UTC
This AI simply relaxes a legality rule, legalizing a construct that was
previously illegal.

In particular, it deletes the second sentence of 4.5.2(9.8)

   In addition, if the untagged record type has a nonlimited partial
   view, then the declaration shall occur in the visible part of the
   enclosing package.

which disallowed certain user-defined equality declarations occurring in
a private part. Implementation of this AI includes getting the runtime
behavior right for the previously-illegal cases, in particular with
respect to AI05-0123.

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

2019-12-13  Steve Baird  <baird@adacore.com>

gcc/ada/

	* exp_ch4.adb (Expand_N_Op_Eq.Is_Equality): Move this function
	from within Expand_N_Op_Eq.Find_Equality out to immediately
	within Expand_N_Op_Eq in order to give it greater visibility.
	Add a new Typ parameter (defaulted to Empty) which, if
	non-empty, means the function will return False in the case of
	an equality op for some other type.
	* (Expand_N_Op_Eq.User_Defined_Primitive_Equality_Op): A new
	function. Given an untagged record type, finds the corresponding
	user-defined primitive equality op (if any).  May return Empty.
	Ignores visibility.
	* (Expand_N_Op): For Ada2012 or later, check for presence of a
	user-defined primitive equality op before falling back on the
	usual predefined component-by-component comparison. If found,
	then call the user-defined op instead.

Patch
diff mbox series

--- gcc/ada/exp_ch4.adb
+++ gcc/ada/exp_ch4.adb
@@ -7520,10 +7520,21 @@  package body Exp_Ch4 is
       --  build and analyze call, adding conversions if the operation is
       --  inherited.
 
+      function Is_Equality (Subp : Entity_Id;
+                            Typ  : Entity_Id := Empty) return Boolean;
+      --  Determine whether arbitrary Entity_Id denotes a function with the
+      --  right name and profile for an equality op, specifically for the
+      --  base type Typ if Typ is nonempty.
+
       function Find_Equality (Prims : Elist_Id) return Entity_Id;
       --  Find a primitive equality function within primitive operation list
       --  Prims.
 
+      function User_Defined_Primitive_Equality_Op
+        (Typ : Entity_Id) return Entity_Id;
+      --  Find a user-defined primitive equality function for a given untagged
+      --  record type, ignoring visibility. Return Empty if no such op found.
+
       function Has_Unconstrained_UU_Component (Typ : Entity_Id) return Boolean;
       --  Determines whether a type has a subcomponent of an unconstrained
       --  Unchecked_Union subtype. Typ is a record type.
@@ -7772,6 +7783,43 @@  package body Exp_Ch4 is
          Analyze_And_Resolve (N, Standard_Boolean, Suppress => All_Checks);
       end Build_Equality_Call;
 
+      -----------------
+      -- Is_Equality --
+      -----------------
+
+      function Is_Equality (Subp : Entity_Id;
+                            Typ  : Entity_Id := Empty) return Boolean is
+         Formal_1 : Entity_Id;
+         Formal_2 : Entity_Id;
+      begin
+         --  The equality function carries name "=", returns Boolean, and has
+         --  exactly two formal parameters of an identical type.
+
+         if Ekind (Subp) = E_Function
+           and then Chars (Subp) = Name_Op_Eq
+           and then Base_Type (Etype (Subp)) = Standard_Boolean
+         then
+            Formal_1 := First_Formal (Subp);
+            Formal_2 := Empty;
+
+            if Present (Formal_1) then
+               Formal_2 := Next_Formal (Formal_1);
+            end if;
+
+            return
+              Present (Formal_1)
+                and then Present (Formal_2)
+                and then No (Next_Formal (Formal_2))
+                and then Base_Type (Etype (Formal_1)) =
+                         Base_Type (Etype (Formal_2))
+                and then
+                  (not Present (Typ)
+                    or else Implementation_Base_Type (Etype (Formal_1)) = Typ);
+         end if;
+
+         return False;
+      end Is_Equality;
+
       -------------------
       -- Find_Equality --
       -------------------
@@ -7781,9 +7829,6 @@  package body Exp_Ch4 is
          --  Find an equality in a possible alias chain starting from primitive
          --  operation Prim.
 
-         function Is_Equality (Id : Entity_Id) return Boolean;
-         --  Determine whether arbitrary entity Id denotes an equality
-
          ---------------------------
          -- Find_Aliased_Equality --
          ---------------------------
@@ -7807,39 +7852,6 @@  package body Exp_Ch4 is
             return Empty;
          end Find_Aliased_Equality;
 
-         -----------------
-         -- Is_Equality --
-         -----------------
-
-         function Is_Equality (Id : Entity_Id) return Boolean is
-            Formal_1 : Entity_Id;
-            Formal_2 : Entity_Id;
-
-         begin
-            --  The equality function carries name "=", returns Boolean, and
-            --  has exactly two formal parameters of an identical type.
-
-            if Ekind (Id) = E_Function
-              and then Chars (Id) = Name_Op_Eq
-              and then Base_Type (Etype (Id)) = Standard_Boolean
-            then
-               Formal_1 := First_Formal (Id);
-               Formal_2 := Empty;
-
-               if Present (Formal_1) then
-                  Formal_2 := Next_Formal (Formal_1);
-               end if;
-
-               return
-                 Present (Formal_1)
-                   and then Present (Formal_2)
-                   and then Etype (Formal_1) = Etype (Formal_2)
-                   and then No (Next_Formal (Formal_2));
-            end if;
-
-            return False;
-         end Is_Equality;
-
          --  Local variables
 
          Eq_Prim   : Entity_Id;
@@ -7869,6 +7881,47 @@  package body Exp_Ch4 is
          return Eq_Prim;
       end Find_Equality;
 
+      ----------------------------------------
+      -- User_Defined_Primitive_Equality_Op --
+      ----------------------------------------
+
+      function User_Defined_Primitive_Equality_Op
+        (Typ : Entity_Id) return Entity_Id
+      is
+         Enclosing_Scope : constant Node_Id := Scope (Typ);
+         E : Entity_Id;
+      begin
+         --  Prune this search by somehow not looking at decls that precede
+         --  the declaration of the first view of Typ (which might be a partial
+         --  view)???
+
+         for Private_Entities in Boolean loop
+            if Private_Entities then
+               if Ekind (Enclosing_Scope) /= E_Package then
+                  exit;
+               end if;
+               E := First_Private_Entity (Enclosing_Scope);
+
+            else
+               E := First_Entity (Enclosing_Scope);
+            end if;
+
+            while Present (E) loop
+               if Is_Equality (E, Typ) then
+                  return E;
+               end if;
+               E := Next_Entity (E);
+            end loop;
+         end loop;
+
+         if Is_Derived_Type (Typ) then
+            return User_Defined_Primitive_Equality_Op
+                     (Implementation_Base_Type (Etype (Typ)));
+         end if;
+
+         return Empty;
+      end User_Defined_Primitive_Equality_Op;
+
       ------------------------------------
       -- Has_Unconstrained_UU_Component --
       ------------------------------------
@@ -8190,6 +8243,15 @@  package body Exp_Ch4 is
                  (Find_Equality (Primitive_Operations (Typl)));
             end if;
 
+         --  See AI12-0101 (which only removes a legality rule) and then
+         --  AI05-0123 (which then applies in the previously illegal case).
+         --  AI12-0101 is a binding interpretation.
+
+         elsif Ada_Version >= Ada_2012
+           and then Present (User_Defined_Primitive_Equality_Op (Typl))
+         then
+            Build_Equality_Call (User_Defined_Primitive_Equality_Op (Typl));
+
          --  Ada 2005 (AI-216): Program_Error is raised when evaluating the
          --  predefined equality operator for a type which has a subcomponent
          --  of an Unchecked_Union type whose nominal subtype is unconstrained.