ada: Enforce matching of extra formals

This patch enforces matching of extra formals in overridden subprograms,
subprogram renamings, and subprograms to which attributes 'Access,
'Unchecked_Access, or 'Unrestricted_Access is applied (for these access
cases the subprogram is checked against its corresponding subprogram
type). This enforcement is an internal consistency check, not an
implementation of some language legality rule.

gcc/ada/

	* debug.adb
	(Debug_Flag_Underscore_XX): Switch -gnatd_X used temporarily to allow
	disabling extra formal checks.
	* exp_attr.adb
	(Expand_N_Attribute_Reference [access types]): Add extra formals
	to the subprogram referenced in the prefix of 'Unchecked_Access,
	'Unrestricted_Access or 'Access; required to check that its extra
	formals match the extra formals of the corresponding subprogram type.
	* exp_ch3.adb
	(Stream_Operation_OK): Declaration moved to the public part of the
	package.
	(Validate_Tagged_Type_Extra_Formals): New subprogram.
	(Expand_Freeze_Record_Type): Improve the code that takes care of
	adding the extra formals of dispatching primitives; extended to
	add also the extra formals to renamings of dispatching primitives.
	* exp_ch3.ads
	(Stream_Operation_OK): Declaration moved from the package body.
	* exp_ch6.adb
	(Check_BIP_Actuals): Complete documentation.
	(Has_BIP_Extra_Formal): Subprogram declaration moved to the public
	part of the package. In addition, a parameter has been added to
	disable an assertion that requires its use with frozen entities.
	(Duplicate_Params_Without_Extra_Actuals): New subprogram.
	(Check_Subprogram_Variant): Emit the call without duplicating the
	extra formals since they will be added when the call is analyzed.
	(Expand_Call_Helper): Ensure that the called subprogram has all its
	extra formals, enforce assertion checking extra formals on thunks,
	and mark calls from thunks as processed-BIP-calls to avoid adding
	their extra formals twice.
	(Is_Build_In_Place_Function): Return False for entities with foreign
	convention.
	(Is_Build_In_Place_Function_Call): Return True also for not BIP functions
	that have BIP formals since the extra actuals are required.
	(Make_Build_In_Place_Call_In_Object_Declaration): Occurrences of
	Is_Return_Object replaced by the local variable Is_OK_Return_Object
	that evaluates to False for scopes with foreign convention.
	(Might_Have_Tasks): Fix check of class-wide limited record types.
	(Needs_BIP_Task_Actuals): Remove assertion to allow calling this
	function in more contexts; in addition it returns False for functions
	returning objects with foreign convention.
	(Needs_BIP_Finalization_Master): Likewise.
	(Needs_BIP_Alloc_Form): Likewise.
	(Validate_Subprogram_Calls): Check that the number of actuals (including
	extra actuals) of calls in the subtree N match their corresponding
	formals.
	* exp_ch6.ads
	(Has_BIP_Extra_Formal): Subprogram declaration moved to the public
	part of the package. In addition, a parameter has been added to
	disable an assertion that requires its use with frozen entities.
	(Is_Build_In_Place_Function_Call): Complete documentation.
	(Validate_Subprogram_Calls): Check that the number of actuals (including
	extra actuals) of calls in the subtree N match their corresponding
	formals.
	* freeze.adb
	(Check_Itype): Add extra formals to anonymous access subprogram itypes.
	(Freeze_Expression): Improve code that disables the addition of extra
	formals to functions with foreign convention.
	(Check_Extra_Formals): Moved to package Sem_Ch6 as Extra_Formals_OK.
	(Freeze_Subprogram): Add extra formals to non-dispatching subprograms.
	* frontend.adb
	(Frontend): Validate all the subprogram calls; it can be disabled using
	switch -gnatd_X
	* sem_ch3.adb
	(Access_Subprogram_Declaration): Defer the addition of extra formals to
	the freezing point so that we know the convention.
	(Check_Anonymous_Access_Component): Likewise.
	(Derive_Subprogram): Fix documentation.
	* sem_ch6.adb
	(Has_Reliable_Extra_Formals): New subprogram.
	(Check_Anonymous_Return): Fix check of access to class-wide limited
	record types.
	(Check_Untagged_Equality): Placed in alphabetical order.
	(Extra_Formals_OK): Subprogram moved from freeze.adb.
	(Extra_Formals_Match_OK): New subprogram.
	(Has_BIP_Formals): New subprogram.
	(Has_Extra_Formals): New subprograms.
	(Needs_Accessibility_Check_Extra): New subprogram.
	(Parent_Subprogram): New subprogram.
	(Add_Extra_Formal): Minor code cleanup.
	(Create_Extra_Formals): Enforce matching extra formals on overridden
	and aliased entities.
	* sem_ch6.ads
	(Extra_Formals_Match_OK): New subprogram.
	(Extra_Formals_OK): Subprogram moved from freeze.adb.
	* sem_eval.adb
	(Compile_Time_Known_Value): Improve predicate to avoid assertion
	failure; found working on this ticket; this change does not
	affect the behavior of the compiler because this subprogram
	has an exception handler that returns False when the assertion
	fails.
	* sem_util.adb
	(Needs_Result_Accessibility_Level): Do not return False for dispatching
	operations compiled with Ada_Version < 2012 since they they may be
	overridden by primitives compiled with Ada_Version >= Ada_2012.

1 files changed, 905 insertions, 279 deletions

diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index d28de10..454db66 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -34,6 +34,7 @@ with Einfo.Utils;    use Einfo.Utils;
 with Elists;         use Elists;
 with Errout;         use Errout;
 with Expander;       use Expander;
+with Exp_Ch3;        use Exp_Ch3;
 with Exp_Ch6;        use Exp_Ch6;
 with Exp_Ch9;        use Exp_Ch9;
 with Exp_Dbug;       use Exp_Dbug;
@@ -200,6 +201,13 @@ package body Sem_Ch6 is
    --  This procedure makes S, a new overloaded entity, into the first visible
    --  entity with that name.
 
+   function Has_Reliable_Extra_Formals (E : Entity_Id) return Boolean;
+   --  E is the entity for a subprogram spec. Returns False for abstract
+   --  predefined dispatching primitives of Root_Controlled since they
+   --  cannot have extra formals (this is required to build the runtime);
+   --  it also returns False for predefined stream dispatching operations
+   --  not emitted by the frontend. Otherwise returns True.
+
    function Is_Non_Overriding_Operation
      (Prev_E : Entity_Id;
       New_E  : Entity_Id) return Boolean;
@@ -3352,7 +3360,8 @@ package body Sem_Ch6 is
                       or else
                         (Is_Class_Wide_Type (Designated_Type (Etype (Scop)))
                            and then
-                         Is_Limited_Record (Designated_Type (Etype (Scop)))))
+                         Is_Limited_Record
+                           (Etype (Designated_Type (Etype (Scop))))))
            and then Expander_Active
          then
             Decl := Build_Master_Declaration (Loc);
@@ -8471,6 +8480,253 @@ package body Sem_Ch6 is
         (New_Id, Old_Id, Type_Conformant, True, Result, Err_Loc);
    end Check_Type_Conformant;
 
+   -----------------------------
+   -- Check_Untagged_Equality --
+   -----------------------------
+
+   procedure Check_Untagged_Equality (Eq_Op : Entity_Id) is
+      Eq_Decl : constant Node_Id   := Unit_Declaration_Node (Eq_Op);
+      Typ     : constant Entity_Id := Etype (First_Formal (Eq_Op));
+
+      procedure Freezing_Point_Warning (N : Node_Id; S : String);
+      --  Output a warning about the freezing point N of Typ
+
+      function Is_Actual_Of_Instantiation
+        (E    : Entity_Id;
+         Inst : Node_Id) return Boolean;
+      --  Return True if E is an actual parameter of instantiation Inst
+
+      -----------------------------------
+      -- Output_Freezing_Point_Warning --
+      -----------------------------------
+
+      procedure Freezing_Point_Warning (N : Node_Id; S : String) is
+      begin
+         Error_Msg_String (1 .. S'Length) := S;
+         Error_Msg_Strlen := S'Length;
+
+         if Ada_Version >= Ada_2012 then
+            Error_Msg_NE ("type& is frozen by ~??", N, Typ);
+            Error_Msg_N
+              ("\an equality operator cannot be declared after this point??",
+               N);
+
+         else
+            Error_Msg_NE ("type& is frozen by ~ (Ada 2012)?y?", N, Typ);
+            Error_Msg_N
+              ("\an equality operator cannot be declared after this point"
+               & " (Ada 2012)?y?", N);
+         end if;
+      end Freezing_Point_Warning;
+
+      --------------------------------
+      -- Is_Actual_Of_Instantiation --
+      --------------------------------
+
+      function Is_Actual_Of_Instantiation
+        (E    : Entity_Id;
+         Inst : Node_Id) return Boolean
+      is
+         Assoc : Node_Id;
+
+      begin
+         if Present (Generic_Associations (Inst)) then
+            Assoc := First (Generic_Associations (Inst));
+
+            while Present (Assoc) loop
+               if Present (Explicit_Generic_Actual_Parameter (Assoc))
+                 and then
+                   Is_Entity_Name (Explicit_Generic_Actual_Parameter (Assoc))
+                 and then
+                   Entity (Explicit_Generic_Actual_Parameter (Assoc)) = E
+               then
+                  return True;
+               end if;
+
+               Next (Assoc);
+            end loop;
+         end if;
+
+         return False;
+      end Is_Actual_Of_Instantiation;
+
+      --  Local variable
+
+      Decl : Node_Id;
+
+   --  Start of processing for Check_Untagged_Equality
+
+   begin
+      --  This check applies only if we have a subprogram declaration or a
+      --  subprogram body that is not a completion, for an untagged record
+      --  type, and that is conformant with the predefined operator.
+
+      if (Nkind (Eq_Decl) /= N_Subprogram_Declaration
+           and then not (Nkind (Eq_Decl) = N_Subprogram_Body
+                          and then Acts_As_Spec (Eq_Decl)))
+        or else not Is_Record_Type (Typ)
+        or else Is_Tagged_Type (Typ)
+        or else not Is_User_Defined_Equality (Eq_Op)
+      then
+         return;
+      end if;
+
+      --  In Ada 2012 case, we will output errors or warnings depending on
+      --  the setting of debug flag -gnatd.E.
+
+      if Ada_Version >= Ada_2012 then
+         Error_Msg_Warn := Debug_Flag_Dot_EE;
+
+      --  In earlier versions of Ada, nothing to do unless we are warning on
+      --  Ada 2012 incompatibilities (Warn_On_Ada_2012_Incompatibility set).
+
+      else
+         if not Warn_On_Ada_2012_Compatibility then
+            return;
+         end if;
+      end if;
+
+      --  Cases where the type has already been frozen
+
+      if Is_Frozen (Typ) then
+
+         --  The check applies to a primitive operation, so check that type
+         --  and equality operation are in the same scope.
+
+         if Scope (Typ) /= Current_Scope then
+            return;
+
+         --  If the type is a generic actual (sub)type, the operation is not
+         --  primitive either because the base type is declared elsewhere.
+
+         elsif Is_Generic_Actual_Type (Typ) then
+            return;
+
+         --  Here we may have an error of declaration after freezing, but we
+         --  must make sure not to flag the equality operator itself causing
+         --  the freezing when it is a subprogram body.
+
+         else
+            Decl := Next (Declaration_Node (Typ));
+
+            while Present (Decl) and then Decl /= Eq_Decl loop
+
+               --  The declaration of an object of the type
+
+               if Nkind (Decl) = N_Object_Declaration
+                 and then Etype (Defining_Identifier (Decl)) = Typ
+               then
+                  Freezing_Point_Warning (Decl, "declaration");
+                  exit;
+
+               --  The instantiation of a generic on the type
+
+               elsif Nkind (Decl) in N_Generic_Instantiation
+                 and then Is_Actual_Of_Instantiation (Typ, Decl)
+               then
+                  Freezing_Point_Warning (Decl, "instantiation");
+                  exit;
+
+               --  A noninstance proper body, body stub or entry body
+
+               elsif Nkind (Decl) in N_Proper_Body
+                                   | N_Body_Stub
+                                   | N_Entry_Body
+                 and then not Is_Generic_Instance (Defining_Entity (Decl))
+               then
+                  Freezing_Point_Warning (Decl, "body");
+                  exit;
+
+               --  If we have reached the freeze node and immediately after we
+               --  have the body or generated code for the body, then it is the
+               --  body that caused the freezing and this is legal.
+
+               elsif Nkind (Decl) = N_Freeze_Entity
+                 and then Entity (Decl) = Typ
+                 and then (Next (Decl) = Eq_Decl
+                            or else
+                           Sloc (Next (Decl)) = Sloc (Eq_Decl))
+               then
+                  return;
+               end if;
+
+               Next (Decl);
+            end loop;
+
+            --  Here we have a definite error of declaration after freezing
+
+            if Ada_Version >= Ada_2012 then
+               Error_Msg_NE
+                 ("equality operator must be declared before type & is "
+                  & "frozen (RM 4.5.2 (9.8)) (Ada 2012)<<", Eq_Op, Typ);
+
+               --  In Ada 2012 mode with error turned to warning, output one
+               --  more warning to warn that the equality operation may not
+               --  compose. This is the consequence of ignoring the error.
+
+               if Error_Msg_Warn then
+                  Error_Msg_N ("\equality operation may not compose??", Eq_Op);
+               end if;
+
+            else
+               Error_Msg_NE
+                 ("equality operator must be declared before type& is "
+                  & "frozen (RM 4.5.2 (9.8)) (Ada 2012)?y?", Eq_Op, Typ);
+            end if;
+
+            --  If we have found no freezing point and the declaration of the
+            --  operator could not be reached from that of the type and we are
+            --  in a package body, this must be because the type is declared
+            --  in the spec of the package. Add a message tailored to this.
+
+            if No (Decl) and then In_Package_Body (Scope (Typ)) then
+               if Ada_Version >= Ada_2012 then
+                  if Nkind (Eq_Decl) = N_Subprogram_Body then
+                     Error_Msg_N
+                       ("\put declaration in package spec<<", Eq_Op);
+                  else
+                     Error_Msg_N
+                       ("\move declaration to package spec<<", Eq_Op);
+                  end if;
+
+               else
+                  if Nkind (Eq_Decl) = N_Subprogram_Body then
+                     Error_Msg_N
+                       ("\put declaration in package spec (Ada 2012)?y?",
+                        Eq_Op);
+                  else
+                     Error_Msg_N
+                       ("\move declaration to package spec (Ada 2012)?y?",
+                        Eq_Op);
+                  end if;
+               end if;
+            end if;
+         end if;
+
+      --  Now check for AI12-0352: the declaration of a user-defined primitive
+      --  equality operation for a record type T is illegal if it occurs after
+      --  a type has been derived from T.
+
+      else
+         Decl := Next (Declaration_Node (Typ));
+
+         while Present (Decl) and then Decl /= Eq_Decl loop
+            if Nkind (Decl) = N_Full_Type_Declaration
+              and then Etype (Defining_Identifier (Decl)) = Typ
+            then
+               Error_Msg_N
+                 ("equality operator cannot appear after derivation", Eq_Op);
+               Error_Msg_NE
+                 ("an equality operator for& cannot be declared after "
+                  & "this point??",
+                  Decl, Typ);
+            end if;
+
+            Next (Decl);
+         end loop;
+      end if;
+   end Check_Untagged_Equality;
+
    ---------------------------
    -- Can_Override_Operator --
    ---------------------------
@@ -8950,6 +9206,26 @@ package body Sem_Ch6 is
       --  BIP_xxx denotes an extra formal for a build-in-place function. See
       --  the full list in exp_ch6.BIP_Formal_Kind.
 
+      function Has_Extra_Formals (E : Entity_Id) return Boolean;
+      --  Determines if E has its extra formals
+
+      function Needs_Accessibility_Check_Extra
+        (E      : Entity_Id;
+         Formal : Node_Id) return Boolean;
+      --  Determines whether the given formal of E needs an extra formal for
+      --  supporting accessibility checking. Returns True for both anonymous
+      --  access formals and formals of named access types that are marked as
+      --  controlling formals. The latter case can occur when the subprogram
+      --  Expand_Dispatching_Call creates a subprogram-type and substitutes
+      --  the types of access-to-class-wide actuals for the anonymous access-
+      --  to-specific-type of controlling formals.
+
+      function Parent_Subprogram (Subp_Id : Entity_Id) return Entity_Id;
+      --  Subp_Id is a subprogram of a derived type; return its parent
+      --  subprogram if Subp_Id overrides a parent primitive or derives
+      --  from a parent primitive, and such parent primitive can have extra
+      --  formals. Otherwise return Empty.
+
       ----------------------
       -- Add_Extra_Formal --
       ----------------------
@@ -8960,10 +9236,7 @@ package body Sem_Ch6 is
          Scope        : Entity_Id;
          Suffix       : String) return Entity_Id
       is
-         EF : constant Entity_Id :=
-                Make_Defining_Identifier (Sloc (Assoc_Entity),
-                  Chars  => New_External_Name (Chars (Assoc_Entity),
-                                               Suffix => Suffix));
+         EF : Entity_Id;
 
       begin
          --  A little optimization. Never generate an extra formal for the
@@ -8974,6 +9247,10 @@ package body Sem_Ch6 is
             return Empty;
          end if;
 
+         EF := Make_Defining_Identifier (Sloc (Assoc_Entity),
+                 Chars => New_External_Name (Chars (Assoc_Entity),
+                                             Suffix => Suffix));
+
          Mutate_Ekind        (EF, E_In_Parameter);
          Set_Actual_Subtype  (EF, Typ);
          Set_Etype           (EF, Typ);
@@ -8995,49 +9272,266 @@ package body Sem_Ch6 is
          return EF;
       end Add_Extra_Formal;
 
+      -----------------------
+      -- Has_Extra_Formals --
+      -----------------------
+
+      function Has_Extra_Formals (E : Entity_Id) return Boolean is
+      begin
+         return Present (Extra_Formals (E))
+           or else
+             (Ekind (E) = E_Function
+                and then Present (Extra_Accessibility_Of_Result (E)));
+      end Has_Extra_Formals;
+
+      -------------------------------------
+      -- Needs_Accessibility_Check_Extra --
+      -------------------------------------
+
+      function Needs_Accessibility_Check_Extra
+        (E      : Entity_Id;
+         Formal : Node_Id) return Boolean is
+
+      begin
+         --  For dispatching operations this extra formal is not suppressed
+         --  since all the derivations must have matching formals.
+
+         --  For nondispatching operations it is suppressed if we specifically
+         --  suppress accessibility checks at the package level for either the
+         --  subprogram, or the package in which it resides. However, we do
+         --  not suppress it simply if the scope has accessibility checks
+         --  suppressed, since this could cause trouble when clients are
+         --  compiled with a different suppression setting. The explicit checks
+         --  at the package level are safe from this point of view.
+
+         if not Is_Dispatching_Operation (E)
+           and then
+             (Explicit_Suppress (E, Accessibility_Check)
+                or else Explicit_Suppress (Scope (E), Accessibility_Check))
+         then
+            return False;
+         end if;
+
+         --  Base_Type is applied to handle cases where there is a null
+         --  exclusion the formal may have an access subtype.
+
+         return
+           Ekind (Base_Type (Etype (Formal))) = E_Anonymous_Access_Type
+             or else
+               (Is_Controlling_Formal (Formal)
+                  and then Is_Access_Type (Base_Type (Etype (Formal))));
+      end Needs_Accessibility_Check_Extra;
+
+      -----------------------
+      -- Parent_Subprogram --
+      -----------------------
+
+      function Parent_Subprogram (Subp_Id : Entity_Id) return Entity_Id is
+         pragma Assert (not Is_Thunk (Subp_Id));
+         Ovr_E     : Entity_Id := Overridden_Operation (Subp_Id);
+         Ovr_Alias : Entity_Id;
+
+      begin
+         if Present (Ovr_E) then
+            Ovr_Alias := Ultimate_Alias (Ovr_E);
+
+            --  There is no real overridden subprogram if there is a mutual
+            --  reference between the E and its overridden operation. This
+            --  weird scenery occurs in the following cases:
+
+            --  1) Controlling function wrappers internally built by
+            --     Make_Controlling_Function_Wrappers.
+
+            --  2) Hidden overridden primitives of type extensions or private
+            --     extensions (cf. Find_Hidden_Overridden_Primitive). These
+            --     hidden primitives have suffix 'P'.
+
+            --  3) Overriding primitives of stub types (see the subprogram
+            --     Add_RACW_Primitive_Declarations_And_Bodies).
+
+            if Ovr_Alias = Subp_Id then
+               pragma Assert
+                 ((Is_Wrapper (Subp_Id)
+                     and then Has_Controlling_Result (Subp_Id))
+                   or else Has_Suffix (Ovr_E, 'P')
+                   or else Is_RACW_Stub_Type
+                             (Find_Dispatching_Type (Subp_Id)));
+
+               if Present (Overridden_Operation (Ovr_E)) then
+                  Ovr_E := Overridden_Operation (Ovr_E);
+
+               --  Ovr_E is an internal entity built by Derive_Subprogram and
+               --  we have no direct way to climb to the corresponding parent
+               --  subprogram but this internal entity has the extra formals
+               --  (if any) required for the purpose of checking the extra
+               --  formals of Subp_Id.
+
+               else
+                  pragma Assert (not Comes_From_Source (Ovr_E));
+               end if;
+
+            --  Use as our reference entity the ultimate renaming of the
+            --  overridden subprogram.
+
+            elsif Present (Alias (Ovr_E)) then
+               pragma Assert (No (Overridden_Operation (Ovr_Alias))
+                 or else Overridden_Operation (Ovr_Alias) /= Ovr_E);
+
+               Ovr_E := Ovr_Alias;
+            end if;
+         end if;
+
+         if Present (Ovr_E) and then Has_Reliable_Extra_Formals (Ovr_E) then
+            return Ovr_E;
+         else
+            return Empty;
+         end if;
+      end Parent_Subprogram;
+
       --  Local variables
 
-      Formal_Type : Entity_Id;
-      P_Formal    : Entity_Id;
+      Formal_Type      : Entity_Id;
+      May_Have_Alias   : Boolean;
+      Alias_Formal     : Entity_Id := Empty;
+      Alias_Subp       : Entity_Id := Empty;
+      Parent_Formal    : Entity_Id := Empty;
+      Parent_Subp      : Entity_Id := Empty;
+      Ref_E            : Entity_Id;
 
    --  Start of processing for Create_Extra_Formals
 
    begin
+      pragma Assert (Is_Subprogram_Or_Entry (E)
+        or else Ekind (E) in E_Subprogram_Type);
+
       --  We never generate extra formals if expansion is not active because we
       --  don't need them unless we are generating code.
 
       if not Expander_Active then
          return;
-      end if;
+
+      --  Enumeration literals have no extra formal; this case occurs when
+      --  a function renames it.
+
+      elsif Ekind (E) = E_Function
+        and then Ekind (Ultimate_Alias (E)) = E_Enumeration_Literal
+      then
+         return;
+
+      --  Initialization procedures don't have extra formals
+
+      elsif Is_Init_Proc (E) then
+         return;
 
       --  No need to generate extra formals in thunks whose target has no extra
       --  formals, but we can have two of them chained (interface and stack).
 
-      if Is_Thunk (E) and then No (Extra_Formals (Thunk_Target (E))) then
+      elsif Is_Thunk (E) and then No (Extra_Formals (Thunk_Target (E))) then
          return;
-      end if;
 
-      --  If this is a derived subprogram then the subtypes of the parent
-      --  subprogram's formal parameters will be used to determine the need
-      --  for extra formals.
+      --  If Extra_Formals were already created, don't do it again. This
+      --  situation may arise for subprogram types created as part of
+      --  dispatching calls (see Expand_Dispatching_Call).
 
-      if Is_Overloadable (E) and then Present (Alias (E)) then
-         P_Formal := First_Formal (Alias (E));
-      else
-         P_Formal := Empty;
+      elsif Has_Extra_Formals (E) then
+         return;
+
+      --  Extra formals of renamings of generic actual subprograms and
+      --  renamings of instances of generic subprograms are shared. The
+      --  check performed on the last formal is required to ensure that
+      --  this is the renaming built by Analyze_Instance_And_Renamings
+      --  (which shares all the formals); otherwise this would be wrong.
+
+      elsif Ekind (E) in E_Function | E_Procedure
+        and then Is_Generic_Instance (E)
+        and then Present (Alias (E))
+        and then Last_Formal (Ultimate_Alias (E)) = Last_Formal (E)
+      then
+         pragma Assert (Is_Generic_Instance (E)
+           = Is_Generic_Instance (Ultimate_Alias (E)));
+
+         Create_Extra_Formals (Ultimate_Alias (E));
+
+         --  Share the extra formals
+
+         Set_Extra_Formals (E, Extra_Formals (Ultimate_Alias (E)));
+
+         if Ekind (E) = E_Function then
+            Set_Extra_Accessibility_Of_Result (E,
+              Extra_Accessibility_Of_Result (Ultimate_Alias (E)));
+         end if;
+
+         pragma Assert (Extra_Formals_OK (E));
+         return;
       end if;
 
+      --  Locate the last formal; required by Add_Extra_Formal.
+
       Formal := First_Formal (E);
       while Present (Formal) loop
          Last_Extra := Formal;
          Next_Formal (Formal);
       end loop;
 
-      --  If Extra_Formals were already created, don't do it again. This
-      --  situation may arise for subprogram types created as part of
-      --  dispatching calls (see Expand_Dispatching_Call).
+      --  We rely on three entities to ensure consistency of extra formals of
+      --  entity E:
+      --
+      --    1. A reference entity (Ref_E). For thunks it is their target
+      --       primitive since this ensures that they have exactly the
+      --       same extra formals; otherwise it is the identity.
+      --
+      --    2. The parent subprogram; only for derived types and references
+      --       either the overridden subprogram or the internal entity built
+      --       by Derive_Subprogram that has the extra formals of the parent
+      --       subprogram; otherwise it is Empty. This entity ensures matching
+      --       extra formals in derived types.
+      --
+      --    3. For renamings, their ultimate alias; this ensures taking the
+      --       same decision in all the renamings (independently of the Ada
+      --       mode on which they are compiled). For example:
+      --
+      --          pragma Ada_2012;
+      --          function Id_A (I : access Integer) return access Integer;
+      --
+      --          pragma Ada_2005;
+      --          function Id_B (I : access Integer) return access Integer
+      --             renames Id_A;
 
-      if Present (Last_Extra) and then Present (Extra_Formal (Last_Extra)) then
+      if Is_Thunk (E) then
+         Ref_E := Thunk_Target (E);
+      else
+         Ref_E := E;
+      end if;
+
+      if Is_Subprogram (Ref_E) then
+         Parent_Subp := Parent_Subprogram (Ref_E);
+      end if;
+
+      May_Have_Alias :=
+        (Is_Subprogram (Ref_E) or else Ekind (Ref_E) = E_Subprogram_Type);
+
+      --  If the parent subprogram is available then its ultimate alias of
+      --  Ref_E is not needed since it will not be used to check its extra
+      --  formals.
+
+      if No (Parent_Subp)
+        and then May_Have_Alias
+        and then Present (Alias (Ref_E))
+        and then Has_Reliable_Extra_Formals (Ultimate_Alias (Ref_E))
+      then
+         Alias_Subp := Ultimate_Alias (Ref_E);
+      end if;
+
+      --  Cannot add extra formals to subprograms and access types that have
+      --  foreign convention nor to subprograms overriding primitives that
+      --  have foreign convention since the foreign language does not know
+      --  how to handle these extra formals; same for renamings of entities
+      --  with foreign convention.
+
+      if Has_Foreign_Convention (Ref_E)
+        or else (Present (Alias_Subp)
+                   and then Has_Foreign_Convention (Alias_Subp))
+      then
          return;
       end if;
 
@@ -9052,20 +9546,74 @@ package body Sem_Ch6 is
          goto Test_For_Func_Result_Extras;
       end if;
 
+      --  Process the formals relying on the formals of our reference entities:
+      --  Parent_Formal, Alias_Formal and Formal. Notice that we don't use the
+      --  formal of Ref_E; we must use the formal of E which is the entity to
+      --  which we are adding the extra formals.
+
+      --  If this is a derived subprogram then the subtypes of the parent
+      --  subprogram's formal parameters will be used to determine the need
+      --  for extra formals.
+
+      if Present (Parent_Subp) then
+         Parent_Formal := First_Formal (Parent_Subp);
+
+         --  For concurrent types, the controlling argument of a dispatching
+         --  primitive implementing an interface primitive is implicit. For
+         --  example:
+         --
+         --     type Iface is protected interface;
+         --     function Prim
+         --       (Obj   : Iface;
+         --        Value : Integer) return Natural is abstract;
+         --
+         --     protected type PO is new Iface with
+         --        function Prim (Value : Integer) return Natural;
+         --     end PO;
+
+         if Convention (Ref_E) = Convention_Protected
+           and then Is_Abstract_Subprogram (Parent_Subp)
+           and then Is_Interface (Find_Dispatching_Type (Parent_Subp))
+         then
+            Parent_Formal := Next_Formal (Parent_Formal);
+
+            --  This is the nondispatching subprogram of a concurrent type
+            --  that overrides the interface primitive; the expander will
+            --  create the dispatching primitive (without Convention_Protected)
+            --  with all the matching formals (see exp_ch9.Build_Wrapper_Specs)
+
+            pragma Assert (not Is_Dispatching_Operation (Ref_E));
+         end if;
+
+      --  Ensure that the ultimate alias has all its extra formals
+
+      elsif Present (Alias_Subp) then
+         Create_Extra_Formals (Alias_Subp);
+         Alias_Formal := First_Formal (Alias_Subp);
+      end if;
+
       Formal := First_Formal (E);
       while Present (Formal) loop
 
+         --  Here we establish our priority for deciding on the extra
+         --  formals: 1) Parent primitive 2) Aliased primitive 3) Identity
+
+         if Present (Parent_Formal) then
+            Formal_Type := Etype (Parent_Formal);
+
+         elsif Present (Alias_Formal) then
+            Formal_Type := Etype (Alias_Formal);
+
+         else
+            Formal_Type := Etype (Formal);
+         end if;
+
          --  Create extra formal for supporting the attribute 'Constrained.
          --  The case of a private type view without discriminants also
          --  requires the extra formal if the underlying type has defaulted
          --  discriminants.
 
          if Ekind (Formal) /= E_In_Parameter then
-            if Present (P_Formal) then
-               Formal_Type := Etype (P_Formal);
-            else
-               Formal_Type := Etype (Formal);
-            end if;
 
             --  Do not produce extra formals for Unchecked_Union parameters.
             --  Jump directly to the end of the loop.
@@ -9110,36 +9658,22 @@ package body Sem_Ch6 is
             end if;
          end if;
 
-         --  Create extra formal for supporting accessibility checking. This
-         --  is done for both anonymous access formals and formals of named
-         --  access types that are marked as controlling formals. The latter
-         --  case can occur when Expand_Dispatching_Call creates a subprogram
-         --  type and substitutes the types of access-to-class-wide actuals
-         --  for the anonymous access-to-specific-type of controlling formals.
-         --  Base_Type is applied because in cases where there is a null
-         --  exclusion the formal may have an access subtype.
+         --  Extra formal for supporting accessibility checking
+
+         if Needs_Accessibility_Check_Extra (Ref_E, Formal) then
+            pragma Assert (No (Parent_Formal)
+              or else Present (Extra_Accessibility (Parent_Formal)));
+            pragma Assert (No (Alias_Formal)
+              or else Present (Extra_Accessibility (Alias_Formal)));
 
-         --  This is suppressed if we specifically suppress accessibility
-         --  checks at the package level for either the subprogram, or the
-         --  package in which it resides. However, we do not suppress it
-         --  simply if the scope has accessibility checks suppressed, since
-         --  this could cause trouble when clients are compiled with a
-         --  different suppression setting. The explicit checks at the
-         --  package level are safe from this point of view.
-
-         if (Ekind (Base_Type (Etype (Formal))) = E_Anonymous_Access_Type
-              or else (Is_Controlling_Formal (Formal)
-                        and then Is_Access_Type (Base_Type (Etype (Formal)))))
-           and then not
-             (Explicit_Suppress (E, Accessibility_Check)
-               or else
-              Explicit_Suppress (Scope (E), Accessibility_Check))
-           and then
-             (No (P_Formal)
-               or else Present (Extra_Accessibility (P_Formal)))
-         then
             Set_Extra_Accessibility
               (Formal, Add_Extra_Formal (Formal, Standard_Natural, E, "L"));
+
+         else
+            pragma Assert (No (Parent_Formal)
+              or else No (Extra_Accessibility (Parent_Formal)));
+            pragma Assert (No (Alias_Formal)
+              or else No (Extra_Accessibility (Alias_Formal)));
          end if;
 
          --  This label is required when skipping extra formal generation for
@@ -9147,8 +9681,12 @@ package body Sem_Ch6 is
 
          <<Skip_Extra_Formal_Generation>>
 
-         if Present (P_Formal) then
-            Next_Formal (P_Formal);
+         if Present (Parent_Formal) then
+            Next_Formal (Parent_Formal);
+         end if;
+
+         if Present (Alias_Formal) then
+            Next_Formal (Alias_Formal);
          end if;
 
          Next_Formal (Formal);
@@ -9156,20 +9694,47 @@ package body Sem_Ch6 is
 
       <<Test_For_Func_Result_Extras>>
 
-      --  Ada 2012 (AI05-234): "the accessibility level of the result of a
-      --  function call is ... determined by the point of call ...".
+      --  Assume the worst case (Ada 2022) to evaluate this extra formal;
+      --  required to ensure matching of extra formals between subprograms
+      --  and access-to-subprogram types in projects with mixed Ada dialects.
 
-      if Needs_Result_Accessibility_Level (E) then
-         Set_Extra_Accessibility_Of_Result
-           (E, Add_Extra_Formal (E, Standard_Natural, E, "L"));
-      end if;
+      declare
+         Save_Ada_Version : constant Ada_Version_Type := Ada_Version;
+
+      begin
+         Ada_Version := Ada_2022;
+
+         if Needs_Result_Accessibility_Level (Ref_E) then
+            pragma Assert (No (Parent_Subp)
+              or else Needs_Result_Accessibility_Level (Parent_Subp));
+            pragma Assert (No (Alias_Subp)
+              or else Needs_Result_Accessibility_Level (Alias_Subp));
+
+            Set_Extra_Accessibility_Of_Result (E,
+              Add_Extra_Formal (E, Standard_Natural, E, "L"));
+
+         else
+            pragma Assert (No (Parent_Subp)
+              or else not Needs_Result_Accessibility_Level (Parent_Subp));
+            pragma Assert (No (Alias_Subp)
+              or else not Needs_Result_Accessibility_Level (Alias_Subp));
+         end if;
+
+         Ada_Version := Save_Ada_Version;
+      end;
 
       --  Ada 2005 (AI-318-02): In the case of build-in-place functions, add
       --  appropriate extra formals. See type Exp_Ch6.BIP_Formal_Kind.
 
-      if Is_Build_In_Place_Function (E) then
+      if (Present (Parent_Subp) and then Has_BIP_Formals (Parent_Subp))
+            or else
+         (Present (Alias_Subp) and then Has_BIP_Formals (Alias_Subp))
+            or else
+         (Is_Build_In_Place_Function (Ref_E)
+            and then Has_Reliable_Extra_Formals (Ref_E))
+      then
          declare
-            Result_Subt : constant Entity_Id := Etype (E);
+            Result_Subt : constant Entity_Id := Etype (Ref_E);
             Formal_Typ  : Entity_Id;
             Subp_Decl   : Node_Id;
             Discard     : Entity_Id;
@@ -9187,7 +9752,14 @@ package body Sem_Ch6 is
             --  dispatching context and such calls must be handled like calls
             --  to a class-wide function.
 
-            if Needs_BIP_Alloc_Form (E) then
+            if Needs_BIP_Alloc_Form (Ref_E) then
+               pragma Assert (No (Parent_Subp)
+                 or else Has_BIP_Extra_Formal (Parent_Subp, BIP_Alloc_Form,
+                           Must_Be_Frozen => False));
+               pragma Assert (No (Alias_Subp)
+                 or else Has_BIP_Extra_Formal (Alias_Subp, BIP_Alloc_Form,
+                           Must_Be_Frozen => False));
+
                Discard :=
                  Add_Extra_Formal
                    (E, Standard_Natural,
@@ -9203,23 +9775,66 @@ package body Sem_Ch6 is
                       (E, RTE (RE_Root_Storage_Pool_Ptr),
                        E, BIP_Formal_Suffix (BIP_Storage_Pool));
                end if;
+
+            else
+               pragma Assert (No (Parent_Subp)
+                 or else not
+                   Has_BIP_Extra_Formal (Parent_Subp, BIP_Alloc_Form,
+                     Must_Be_Frozen => False));
+               pragma Assert (No (Alias_Subp)
+                 or else not
+                   Has_BIP_Extra_Formal (Alias_Subp, BIP_Alloc_Form,
+                     Must_Be_Frozen => False));
             end if;
 
             --  In the case of functions whose result type needs finalization,
             --  add an extra formal which represents the finalization master.
 
-            if Needs_BIP_Finalization_Master (E) then
+            if Needs_BIP_Finalization_Master (Ref_E) then
+               pragma Assert (No (Parent_Subp)
+                 or else Has_BIP_Extra_Formal (Parent_Subp,
+                           Kind           => BIP_Finalization_Master,
+                           Must_Be_Frozen => False));
+               pragma Assert (No (Alias_Subp)
+                 or else Has_BIP_Extra_Formal (Alias_Subp,
+                           Kind           => BIP_Finalization_Master,
+                           Must_Be_Frozen => False));
+
                Discard :=
                  Add_Extra_Formal
                    (E, RTE (RE_Finalization_Master_Ptr),
                     E, BIP_Formal_Suffix (BIP_Finalization_Master));
+
+            else
+               pragma Assert (No (Parent_Subp)
+                 or else not
+                   Has_BIP_Extra_Formal (Parent_Subp,
+                     Kind           => BIP_Finalization_Master,
+                     Must_Be_Frozen => False));
+               pragma Assert (No (Alias_Subp)
+                 or else not
+                   Has_BIP_Extra_Formal (Alias_Subp,
+                     Kind           => BIP_Finalization_Master,
+                     Must_Be_Frozen => False));
             end if;
 
             --  When the result type contains tasks, add two extra formals: the
             --  master of the tasks to be created, and the caller's activation
             --  chain.
 
-            if Needs_BIP_Task_Actuals (E) then
+            if Needs_BIP_Task_Actuals (Ref_E) then
+               pragma Assert (No (Parent_Subp)
+                 or else Has_BIP_Extra_Formal (Parent_Subp, BIP_Task_Master,
+                           Must_Be_Frozen => False));
+               pragma Assert (No (Alias_Subp)
+                 or else Has_BIP_Extra_Formal (Alias_Subp, BIP_Task_Master,
+                           Must_Be_Frozen => False)
+                 or else
+                   (Is_Abstract_Subprogram (Ref_E)
+                      and then Is_Predefined_Dispatching_Operation (Ref_E)
+                      and then Is_Interface
+                                 (Find_Dispatching_Type (Alias_Subp))));
+
                Discard :=
                  Add_Extra_Formal
                    (E, Standard_Integer,
@@ -9231,6 +9846,16 @@ package body Sem_Ch6 is
                  Add_Extra_Formal
                    (E, RTE (RE_Activation_Chain_Access),
                     E, BIP_Formal_Suffix (BIP_Activation_Chain));
+
+            else
+               pragma Assert (No (Parent_Subp)
+                 or else not
+                   Has_BIP_Extra_Formal (Parent_Subp, BIP_Task_Master,
+                     Must_Be_Frozen => False));
+               pragma Assert (No (Alias_Subp)
+                 or else not
+                   Has_BIP_Extra_Formal (Alias_Subp, BIP_Task_Master,
+                     Must_Be_Frozen => False));
             end if;
 
             --  All build-in-place functions get an extra formal that will be
@@ -9296,6 +9921,14 @@ package body Sem_Ch6 is
       if Is_Generic_Instance (E) and then Present (Alias (E)) then
          Set_Extra_Formals (Alias (E), Extra_Formals (E));
       end if;
+
+      pragma Assert (No (Alias_Subp)
+        or else Extra_Formals_Match_OK (E, Alias_Subp));
+
+      pragma Assert (No (Parent_Subp)
+        or else Extra_Formals_Match_OK (E, Parent_Subp));
+
+      pragma Assert (Extra_Formals_OK (E));
    end Create_Extra_Formals;
 
    -----------------------------
@@ -9526,252 +10159,162 @@ package body Sem_Ch6 is
       end if;
    end Enter_Overloaded_Entity;
 
-   -----------------------------
-   -- Check_Untagged_Equality --
-   -----------------------------
-
-   procedure Check_Untagged_Equality (Eq_Op : Entity_Id) is
-      Eq_Decl : constant Node_Id   := Unit_Declaration_Node (Eq_Op);
-      Typ     : constant Entity_Id := Etype (First_Formal (Eq_Op));
-
-      procedure Freezing_Point_Warning (N : Node_Id; S : String);
-      --  Output a warning about the freezing point N of Typ
-
-      function Is_Actual_Of_Instantiation
-        (E    : Entity_Id;
-         Inst : Node_Id) return Boolean;
-      --  Return True if E is an actual parameter of instantiation Inst
-
-      -----------------------------------
-      -- Output_Freezing_Point_Warning --
-      -----------------------------------
-
-      procedure Freezing_Point_Warning (N : Node_Id; S : String) is
-      begin
-         Error_Msg_String (1 .. S'Length) := S;
-         Error_Msg_Strlen := S'Length;
-
-         if Ada_Version >= Ada_2012 then
-            Error_Msg_NE ("type& is frozen by ~??", N, Typ);
-            Error_Msg_N
-              ("\an equality operator cannot be declared after this point??",
-               N);
-
-         else
-            Error_Msg_NE ("type& is frozen by ~ (Ada 2012)?y?", N, Typ);
-            Error_Msg_N
-              ("\an equality operator cannot be declared after this point"
-               & " (Ada 2012)?y?", N);
-         end if;
-      end Freezing_Point_Warning;
-
-      --------------------------------
-      -- Is_Actual_Of_Instantiation --
-      --------------------------------
-
-      function Is_Actual_Of_Instantiation
-        (E    : Entity_Id;
-         Inst : Node_Id) return Boolean
-      is
-         Assoc : Node_Id;
-
-      begin
-         if Present (Generic_Associations (Inst)) then
-            Assoc := First (Generic_Associations (Inst));
-
-            while Present (Assoc) loop
-               if Present (Explicit_Generic_Actual_Parameter (Assoc))
-                 and then
-                   Is_Entity_Name (Explicit_Generic_Actual_Parameter (Assoc))
-                 and then
-                   Entity (Explicit_Generic_Actual_Parameter (Assoc)) = E
-               then
-                  return True;
-               end if;
-
-               Next (Assoc);
-            end loop;
-         end if;
-
-         return False;
-      end Is_Actual_Of_Instantiation;
-
-      --  Local variable
-
-      Decl : Node_Id;
-
-   --  Start of processing for Check_Untagged_Equality
+   ----------------------------
+   -- Extra_Formals_Match_OK --
+   ----------------------------
 
+   function Extra_Formals_Match_OK
+     (E     : Entity_Id;
+      Ref_E : Entity_Id) return Boolean is
    begin
-      --  This check applies only if we have a subprogram declaration or a
-      --  subprogram body that is not a completion, for an untagged record
-      --  type, and that is conformant with the predefined operator.
+      pragma Assert (Is_Subprogram (E));
+
+      --  Cases where no check can be performed:
+      --    1) When expansion is not active (since we never generate extra
+      --       formals if expansion is not active because we don't need them
+      --       unless we are generating code).
+      --    2) On abstract predefined dispatching operations of Root_Controlled
+      --       and predefined stream operations not emitted by the frontend.
+      --    3) On renamings of abstract predefined dispatching operations of
+      --       interface types (since limitedness is not inherited in such
+      --       case (AI-419)).
+      --    4) The controlling formal of the nondispatching subprogram of
+      --       a concurrent type that overrides an interface primitive is
+      --       implicit and hence we cannot check here if all its extra
+      --       formals match; the expander will create the dispatching
+      --       primitive (without Convention_Protected) with the matching
+      --       formals (see exp_ch9.Build_Wrapper_Specs) which will be
+      --       checked later.
+
+      if Debug_Flag_Underscore_XX
+        or else not Expander_Active
+        or else
+          (Is_Predefined_Dispatching_Operation (E)
+             and then (not Has_Reliable_Extra_Formals (E)
+                         or else not Has_Reliable_Extra_Formals (Ref_E)))
+        or else
+          (Is_Predefined_Dispatching_Operation (E)
+             and then Is_Abstract_Subprogram (E)
+             and then Is_Interface (Find_Dispatching_Type (Ref_E)))
+      then
+         return True;
 
-      if (Nkind (Eq_Decl) /= N_Subprogram_Declaration
-           and then not (Nkind (Eq_Decl) = N_Subprogram_Body
-                          and then Acts_As_Spec (Eq_Decl)))
-        or else not Is_Record_Type (Typ)
-        or else Is_Tagged_Type (Typ)
-        or else not Is_User_Defined_Equality (Eq_Op)
+      elsif Convention (E) = Convention_Protected
+        and then not Is_Dispatching_Operation (E)
+        and then Is_Abstract_Subprogram (Ref_E)
+        and then Is_Interface (Find_Dispatching_Type (Ref_E))
       then
-         return;
+         return True;
       end if;
 
-      --  In Ada 2012 case, we will output errors or warnings depending on
-      --  the setting of debug flag -gnatd.E.
-
-      if Ada_Version >= Ada_2012 then
-         Error_Msg_Warn := Debug_Flag_Dot_EE;
-
-      --  In earlier versions of Ada, nothing to do unless we are warning on
-      --  Ada 2012 incompatibilities (Warn_On_Ada_2012_Incompatibility set).
+      --  Perform the checks
 
-      else
-         if not Warn_On_Ada_2012_Compatibility then
-            return;
-         end if;
+      if No (Extra_Formals (E)) then
+         return No (Extra_Formals (Ref_E));
       end if;
 
-      --  Cases where the type has already been frozen
-
-      if Is_Frozen (Typ) then
-
-         --  The check applies to a primitive operation, so check that type
-         --  and equality operation are in the same scope.
-
-         if Scope (Typ) /= Current_Scope then
-            return;
-
-         --  If the type is a generic actual (sub)type, the operation is not
-         --  primitive either because the base type is declared elsewhere.
+      if Ekind (E) in E_Function | E_Subprogram_Type
+        and then Present (Extra_Accessibility_Of_Result (E))
+                   /= Present (Extra_Accessibility_Of_Result (Ref_E))
+      then
+         return False;
+      end if;
 
-         elsif Is_Generic_Actual_Type (Typ) then
-            return;
+      declare
+         Formal_1 : Entity_Id := Extra_Formals (E);
+         Formal_2 : Entity_Id := Extra_Formals (Ref_E);
 
-         --  Here we may have an error of declaration after freezing, but we
-         --  must make sure not to flag the equality operator itself causing
-         --  the freezing when it is a subprogram body.
+      begin
+         while Present (Formal_1) and then Present (Formal_2) loop
+            if Has_Suffix (Formal_1, 'L') then
+               if not Has_Suffix (Formal_2, 'L') then
+                  return False;
+               end if;
 
-         else
-            Decl := Next (Declaration_Node (Typ));
+            elsif Has_Suffix (Formal_1, 'O') then
+               if not Has_Suffix (Formal_2, 'O') then
+                  return False;
+               end if;
 
-            while Present (Decl) and then Decl /= Eq_Decl loop
+            elsif BIP_Suffix_Kind (Formal_1) /= BIP_Suffix_Kind (Formal_2) then
+               return False;
+            end if;
 
-               --  The declaration of an object of the type
+            Formal_1 := Next_Formal_With_Extras (Formal_1);
+            Formal_2 := Next_Formal_With_Extras (Formal_2);
+         end loop;
 
-               if Nkind (Decl) = N_Object_Declaration
-                 and then Etype (Defining_Identifier (Decl)) = Typ
-               then
-                  Freezing_Point_Warning (Decl, "declaration");
-                  exit;
+         return No (Formal_1) and then No (Formal_2);
+      end;
+   end Extra_Formals_Match_OK;
 
-               --  The instantiation of a generic on the type
+   ----------------------
+   -- Extra_Formals_OK --
+   ----------------------
 
-               elsif Nkind (Decl) in N_Generic_Instantiation
-                 and then Is_Actual_Of_Instantiation (Typ, Decl)
-               then
-                  Freezing_Point_Warning (Decl, "instantiation");
-                  exit;
+   function Extra_Formals_OK (E : Entity_Id) return Boolean is
+      Last_Formal       : Entity_Id := Empty;
+      Formal            : Entity_Id;
+      Has_Extra_Formals : Boolean := False;
 
-               --  A noninstance proper body, body stub or entry body
+   begin
+      --  No check required if explicitly disabled
 
-               elsif Nkind (Decl) in N_Proper_Body
-                                   | N_Body_Stub
-                                   | N_Entry_Body
-                 and then not Is_Generic_Instance (Defining_Entity (Decl))
-               then
-                  Freezing_Point_Warning (Decl, "body");
-                  exit;
+      if Debug_Flag_Underscore_XX then
+         return True;
 
-               --  If we have reached the freeze node and immediately after we
-               --  have the body or generated code for the body, then it is the
-               --  body that caused the freezing and this is legal.
+      --  No check required if expansion is disabled because extra
+      --  formals are only generated when we are generating code.
+      --  See Create_Extra_Formals.
 
-               elsif Nkind (Decl) = N_Freeze_Entity
-                 and then Entity (Decl) = Typ
-                 and then (Next (Decl) = Eq_Decl
-                            or else
-                           Sloc (Next (Decl)) = Sloc (Eq_Decl))
-               then
-                  return;
-               end if;
+      elsif not Expander_Active then
+         return True;
+      end if;
 
-               Next (Decl);
-            end loop;
+      --  Check attribute Extra_Formal: If available, it must be set only
+      --  on the last formal of E.
 
-            --  Here we have a definite error of declaration after freezing
+      Formal := First_Formal (E);
+      while Present (Formal) loop
+         if Present (Extra_Formal (Formal)) then
+            if Has_Extra_Formals then
+               return False;
+            end if;
 
-            if Ada_Version >= Ada_2012 then
-               Error_Msg_NE
-                 ("equality operator must be declared before type & is "
-                  & "frozen (RM 4.5.2 (9.8)) (Ada 2012)<<", Eq_Op, Typ);
+            Has_Extra_Formals := True;
+         end if;
 
-               --  In Ada 2012 mode with error turned to warning, output one
-               --  more warning to warn that the equality operation may not
-               --  compose. This is the consequence of ignoring the error.
+         Last_Formal := Formal;
+         Next_Formal (Formal);
+      end loop;
 
-               if Error_Msg_Warn then
-                  Error_Msg_N ("\equality operation may not compose??", Eq_Op);
-               end if;
+      --  Check attribute Extra_Accessibility_Of_Result
 
-            else
-               Error_Msg_NE
-                 ("equality operator must be declared before type& is "
-                  & "frozen (RM 4.5.2 (9.8)) (Ada 2012)?y?", Eq_Op, Typ);
-            end if;
+      if Ekind (E) in E_Function | E_Subprogram_Type
+        and then Needs_Result_Accessibility_Level (E)
+        and then No (Extra_Accessibility_Of_Result (E))
+      then
+         return False;
+      end if;
 
-            --  If we have found no freezing point and the declaration of the
-            --  operator could not be reached from that of the type and we are
-            --  in a package body, this must be because the type is declared
-            --  in the spec of the package. Add a message tailored to this.
+      --  Check attribute Extra_Formals: If E has extra formals, then this
+      --  attribute must point to the first extra formal of E.
 
-            if No (Decl) and then In_Package_Body (Scope (Typ)) then
-               if Ada_Version >= Ada_2012 then
-                  if Nkind (Eq_Decl) = N_Subprogram_Body then
-                     Error_Msg_N
-                       ("\put declaration in package spec<<", Eq_Op);
-                  else
-                     Error_Msg_N
-                       ("\move declaration to package spec<<", Eq_Op);
-                  end if;
+      if Has_Extra_Formals then
+         return Present (Extra_Formals (E))
+           and then Present (Extra_Formal (Last_Formal))
+           and then Extra_Formal (Last_Formal) = Extra_Formals (E);
 
-               else
-                  if Nkind (Eq_Decl) = N_Subprogram_Body then
-                     Error_Msg_N
-                       ("\put declaration in package spec (Ada 2012)?y?",
-                        Eq_Op);
-                  else
-                     Error_Msg_N
-                       ("\move declaration to package spec (Ada 2012)?y?",
-                        Eq_Op);
-                  end if;
-               end if;
-            end if;
-         end if;
+      --  When E has no formals, the first extra formal is available through
+      --  the Extra_Formals attribute.
 
-      --  Now check for AI12-0352: the declaration of a user-defined primitive
-      --  equality operation for a record type T is illegal if it occurs after
-      --  a type has been derived from T.
+      elsif Present (Extra_Formals (E)) then
+         return No (First_Formal (E));
 
       else
-         Decl := Next (Declaration_Node (Typ));
-
-         while Present (Decl) and then Decl /= Eq_Decl loop
-            if Nkind (Decl) = N_Full_Type_Declaration
-              and then Etype (Defining_Identifier (Decl)) = Typ
-            then
-               Error_Msg_N
-                 ("equality operator cannot appear after derivation", Eq_Op);
-               Error_Msg_NE
-                 ("an equality operator for& cannot be declared after "
-                  & "this point??",
-                  Decl, Typ);
-            end if;
-
-            Next (Decl);
-         end loop;
+         return True;
       end if;
-   end Check_Untagged_Equality;
+   end Extra_Formals_OK;
 
    -----------------------------
    -- Find_Corresponding_Spec --
@@ -10656,6 +11199,89 @@ package body Sem_Ch6 is
       end if;
    end Fully_Conformant_Discrete_Subtypes;
 
+   ---------------------
+   -- Has_BIP_Formals --
+   ---------------------
+
+   function Has_BIP_Formals (E : Entity_Id) return Boolean is
+      Formal : Entity_Id := First_Formal_With_Extras (E);
+
+   begin
+      while Present (Formal) loop
+         if Is_Build_In_Place_Entity (Formal) then
+            return True;
+         end if;
+
+         Next_Formal_With_Extras (Formal);
+      end loop;
+
+      return False;
+   end Has_BIP_Formals;
+
+   --------------------------------
+   -- Has_Reliable_Extra_Formals --
+   --------------------------------
+
+   function Has_Reliable_Extra_Formals (E : Entity_Id) return Boolean is
+      Alias_E : Entity_Id;
+
+   begin
+      --  Extra formals are not added if expansion is not active (and hence if
+      --  available they are not reliable for extra formals check).
+
+      if not Expander_Active then
+         return False;
+
+      --  Currently the unique cases where extra formals are not reliable
+      --  are associated with predefined dispatching operations; otherwise
+      --  they are properly added when required.
+
+      elsif not Is_Predefined_Dispatching_Operation (E) then
+         return True;
+      end if;
+
+      Alias_E := Ultimate_Alias (E);
+
+      --  Abstract predefined primitives of Root_Controlled don't have
+      --  extra formals; this is required to build the runtime.
+
+      if Ekind (Alias_E) = E_Function
+        and then Is_Abstract_Subprogram (Alias_E)
+        and then Is_RTE (Underlying_Type (Etype (Alias_E)),
+                           RE_Root_Controlled)
+      then
+         return False;
+
+      --  Predefined stream dispatching operations that are not emitted by
+      --  the frontend; they have a renaming of the corresponding primitive
+      --  of their parent type and hence they don't have extra formals.
+
+      else
+         declare
+            Typ : constant Entity_Id :=
+                    Underlying_Type (Find_Dispatching_Type (Alias_E));
+
+         begin
+            if (Get_TSS_Name (E) = TSS_Stream_Input
+                  and then not Stream_Operation_OK (Typ, TSS_Stream_Input))
+              or else
+                (Get_TSS_Name (E) = TSS_Stream_Output
+                   and then not Stream_Operation_OK (Typ, TSS_Stream_Output))
+              or else
+                (Get_TSS_Name (E) = TSS_Stream_Read
+                   and then not Stream_Operation_OK (Typ, TSS_Stream_Read))
+              or else
+                (Get_TSS_Name (E) = TSS_Stream_Write
+                   and then not Stream_Operation_OK (Typ, TSS_Stream_Write))
+            then
+               return False;
+            end if;
+         end;
+      end if;
+
+      return True;
+   end Has_Reliable_Extra_Formals;
+
    --------------------
    -- Install_Entity --
    --------------------
@@ -12527,7 +13153,7 @@ package body Sem_Ch6 is
                   if Is_Dispatching_Operation (E) then
 
                      --  An overriding dispatching subprogram inherits the
-                     --  convention of the overridden subprogram (AI-117).
+                     --  convention of the overridden subprogram (AI95-117).
 
                      Set_Convention (S, Convention (E));
                      Check_Dispatching_Operation (S, E);