[Ada] Revert "Enforce matching of extra formals"

This reverts commit 51abc0cc8691daecd7cec8372e4988e9f3f1913c.

12 files changed, 438 insertions, 1148 deletions

diff --git a/gcc/ada/debug.adb b/gcc/ada/debug.adb
index dce460f..b67103a 100644
--- a/gcc/ada/debug.adb
+++ b/gcc/ada/debug.adb
@@ -189,7 +189,7 @@ package body Debug is
    --  d_U  Disable prepending messages with "error:".
    --  d_V  Enable verifications on the expanded tree
    --  d_W
-   --  d_X  Disable assertions to check matching of extra formals
+   --  d_X
    --  d_Y
    --  d_Z
 
@@ -1044,10 +1044,6 @@ package body Debug is
    --  d_V  Enable verification of the expanded code before calling the backend
    --       and generate error messages on each inconsistency found.
 
-   --  d_X  Disable assertions to check matching of extra formals; switch added
-   --       temporarily to disable these checks until this work is complete if
-   --       they cause unexpected assertion failures.
-
    --  d1   Error messages have node numbers where possible. Normally error
    --       messages have only source locations. This option is useful when
    --       debugging errors caused by expanded code, where the source location
diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index 2d4a471..4a26671 100644
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -2311,40 +2311,19 @@ package body Exp_Attr is
             if Is_Access_Protected_Subprogram_Type (Btyp) then
                Expand_Access_To_Protected_Op (N, Pref, Typ);
 
+            --  If prefix is a subprogram that has class-wide preconditions and
+            --  an indirect-call wrapper (ICW) of such subprogram is available
+            --  then replace the prefix by the ICW.
+
             elsif Is_Access_Subprogram_Type (Btyp)
               and then Is_Entity_Name (Pref)
+              and then Present (Class_Preconditions (Entity (Pref)))
+              and then Present (Indirect_Call_Wrapper (Entity (Pref)))
             then
-               --  If prefix is a subprogram that has class-wide preconditions
-               --  and an indirect-call wrapper (ICW) of the subprogram is
-               --  available then replace the prefix by the ICW.
-
-               if Present (Class_Preconditions (Entity (Pref)))
-                 and then Present (Indirect_Call_Wrapper (Entity (Pref)))
-               then
-                  Rewrite (Pref,
-                    New_Occurrence_Of
-                      (Indirect_Call_Wrapper (Entity (Pref)), Loc));
-                  Analyze_And_Resolve (N, Typ);
-               end if;
-
-               --  Ensure the availability of the extra formals to check that
-               --  they match.
-
-               if not Is_Frozen (Entity (Pref))
-                 or else From_Limited_With (Etype (Entity (Pref)))
-               then
-                  Create_Extra_Formals (Entity (Pref));
-               end if;
-
-               if not Is_Frozen (Btyp_DDT)
-                 or else From_Limited_With (Etype (Btyp_DDT))
-               then
-                  Create_Extra_Formals (Btyp_DDT);
-               end if;
-
-               pragma Assert
-                 (Extra_Formals_Match_OK
-                   (E => Entity (Pref), Ref_E => Btyp_DDT));
+               Rewrite (Pref,
+                 New_Occurrence_Of
+                   (Indirect_Call_Wrapper (Entity (Pref)), Loc));
+               Analyze_And_Resolve (N, Typ);
 
             --  If prefix is a type name, this is a reference to the current
             --  instance of the type, within its initialization procedure.
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index 30ec739..0d82691 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -44,6 +44,7 @@ with Exp_Dist;       use Exp_Dist;
 with Exp_Put_Image;
 with Exp_Smem;       use Exp_Smem;
 with Exp_Strm;       use Exp_Strm;
+with Exp_Tss;        use Exp_Tss;
 with Exp_Util;       use Exp_Util;
 with Freeze;         use Freeze;
 with Ghost;          use Ghost;
@@ -407,6 +408,15 @@ package body Exp_Ch3 is
    --  Freeze entities of all predefined primitive operations. This is needed
    --  because the bodies of these operations do not normally do any freezing.
 
+   function Stream_Operation_OK
+     (Typ       : Entity_Id;
+      Operation : TSS_Name_Type) return Boolean;
+   --  Check whether the named stream operation must be emitted for a given
+   --  type. The rules for inheritance of stream attributes by type extensions
+   --  are enforced by this function. Furthermore, various restrictions prevent
+   --  the generation of these operations, as a useful optimization or for
+   --  certification purposes and to save unnecessary generated code.
+
    --------------------------
    -- Adjust_Discriminants --
    --------------------------
@@ -5369,10 +5379,6 @@ package body Exp_Ch3 is
       procedure Register_Dispatch_Table_Wrappers (Typ : Entity_Id);
       --  Register dispatch-table wrappers in the dispatch table of Typ
 
-      procedure Validate_Tagged_Type_Extra_Formals (Typ : Entity_Id);
-      --  Check extra formals of dispatching primitives of tagged type Typ.
-      --  Used in pragma Debug.
-
       ---------------------------------------
       -- Build_Class_Condition_Subprograms --
       ---------------------------------------
@@ -5502,71 +5508,6 @@ package body Exp_Ch3 is
          end loop;
       end Register_Dispatch_Table_Wrappers;
 
-      ----------------------------------------
-      -- Validate_Tagged_Type_Extra_Formals --
-      ----------------------------------------
-
-      procedure Validate_Tagged_Type_Extra_Formals (Typ : Entity_Id) is
-         Ovr_Subp : Entity_Id;
-         Elmt     : Elmt_Id;
-         Subp     : Entity_Id;
-
-      begin
-         pragma Assert (not Is_Class_Wide_Type (Typ));
-
-         --  No check required if expansion is not active since we never
-         --  generate extra formals in such case.
-
-         if not Expander_Active then
-            return;
-         end if;
-
-         Elmt := First_Elmt (Primitive_Operations (Typ));
-         while Present (Elmt) loop
-            Subp := Node (Elmt);
-
-            --  Extra formals of a primitive must match the extra formals of
-            --  its covered interface primitive.
-
-            if Present (Interface_Alias (Subp)) then
-               pragma Assert
-                 (Extra_Formals_Match_OK
-                   (E     => Interface_Alias (Subp),
-                    Ref_E => Alias (Subp)));
-
-            elsif Present (Overridden_Operation (Subp)) then
-               Ovr_Subp := Overridden_Operation (Subp);
-
-               --  Handle controlling function wrapper
-
-               if Is_Wrapper (Subp)
-                 and then Ultimate_Alias (Ovr_Subp) = Subp
-               then
-                  if Present (Overridden_Operation (Ovr_Subp)) then
-                     pragma Assert
-                       (Extra_Formals_Match_OK
-                         (E     => Subp,
-                          Ref_E => Overridden_Operation (Ovr_Subp)));
-                  end if;
-
-               else
-                  pragma Assert
-                    (Extra_Formals_Match_OK
-                      (E     => Subp,
-                       Ref_E => Overridden_Operation (Subp)));
-               end if;
-
-            elsif Present (Alias (Subp)) then
-               pragma Assert
-                 (Extra_Formals_Match_OK
-                   (E     => Subp,
-                    Ref_E => Ultimate_Alias (Subp)));
-            end if;
-
-            Next_Elmt (Elmt);
-         end loop;
-      end Validate_Tagged_Type_Extra_Formals;
-
       --  Local variables
 
       Typ      : constant Node_Id := Entity (N);
@@ -5955,58 +5896,28 @@ package body Exp_Ch3 is
          --  inherited functions, then add their bodies to the freeze actions.
 
          Append_Freeze_Actions (Typ, Wrapper_Body_List);
-      end if;
 
-      --  Create extra formals for the primitive operations of the type.
-      --  This must be done before analyzing the body of the initialization
-      --  procedure, because a self-referential type might call one of these
-      --  primitives in the body of the init_proc itself.
-      --
-      --  This is not needed:
-      --    1) If expansion is disabled, because extra formals are only added
-      --       when we are generating code.
-      --
-      --    2) For types with foreign convention since primitives with foreign
-      --       convention don't have extra formals and AI-117 requires that all
-      --       primitives of a tagged type inherit the convention.
+         --  Create extra formals for the primitive operations of the type.
+         --  This must be done before analyzing the body of the initialization
+         --  procedure, because a self-referential type might call one of these
+         --  primitives in the body of the init_proc itself.
 
-      if Expander_Active
-        and then Is_Tagged_Type (Typ)
-        and then not Has_Foreign_Convention (Typ)
-      then
          declare
             Elmt : Elmt_Id;
-            E    : Entity_Id;
+            Subp : Entity_Id;
 
          begin
-            --  Add extra formals to primitive operations
-
             Elmt := First_Elmt (Primitive_Operations (Typ));
             while Present (Elmt) loop
-               Create_Extra_Formals (Node (Elmt));
-               Next_Elmt (Elmt);
-            end loop;
-
-            --  Add extra formals to renamings of primitive operations. The
-            --  addition of extra formals is done in two steps to minimize
-            --  the compile time required for this action; the evaluation of
-            --  Find_Dispatching_Type() and Contains() is only done here for
-            --  renamings that are not primitive operations.
-
-            E := First_Entity (Scope (Typ));
-            while Present (E) loop
-               if Is_Dispatching_Operation (E)
-                 and then Present (Alias (E))
-                 and then Find_Dispatching_Type (E) = Typ
-                 and then not Contains (Primitive_Operations (Typ), E)
+               Subp := Node (Elmt);
+               if not Has_Foreign_Convention (Subp)
+                 and then not Is_Predefined_Dispatching_Operation (Subp)
                then
-                  Create_Extra_Formals (E);
+                  Create_Extra_Formals (Subp);
                end if;
 
-               Next_Entity (E);
+               Next_Elmt (Elmt);
             end loop;
-
-            pragma Debug (Validate_Tagged_Type_Extra_Formals (Typ));
          end;
       end if;
 
diff --git a/gcc/ada/exp_ch3.ads b/gcc/ada/exp_ch3.ads
index 24e2263..f7d43c4 100644
--- a/gcc/ada/exp_ch3.ads
+++ b/gcc/ada/exp_ch3.ads
@@ -25,10 +25,9 @@
 
 --  Expand routines for chapter 3 constructs
 
-with Types;   use Types;
-with Elists;  use Elists;
-with Exp_Tss; use Exp_Tss;
-with Uintp;   use Uintp;
+with Types;  use Types;
+with Elists; use Elists;
+with Uintp;  use Uintp;
 
 package Exp_Ch3 is
 
@@ -208,13 +207,4 @@ package Exp_Ch3 is
    --  Make_Predefined_Primitive_Eq_Spec; see there for description of
    --  the Renamed_Eq parameter.
 
-   function Stream_Operation_OK
-     (Typ       : Entity_Id;
-      Operation : TSS_Name_Type) return Boolean;
-   --  Check whether the named stream operation must be emitted for a given
-   --  type. The rules for inheritance of stream attributes by type extensions
-   --  are enforced by this function. Furthermore, various restrictions prevent
-   --  the generation of these operations, as a useful optimization or for
-   --  certification purposes and to save unnecessary generated code.
-
 end Exp_Ch3;
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index 721298f..fe3bb5b 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -315,6 +315,15 @@ package body Exp_Ch6 is
    --  Expand simple return from function. In the case where we are returning
    --  from a function body this is called by Expand_N_Simple_Return_Statement.
 
+   function Has_BIP_Extra_Formal
+     (E    : Entity_Id;
+      Kind : BIP_Formal_Kind) return Boolean;
+   --  Given a frozen subprogram, subprogram type, entry or entry family,
+   --  return True if E has the BIP extra formal associated with Kind. It must
+   --  be invoked with a frozen entity or a subprogram type of a dispatching
+   --  call since we can only rely on the availability of the extra formals
+   --  on these entities.
+
    procedure Insert_Post_Call_Actions (N : Node_Id; Post_Call : List_Id);
    --  Insert the Post_Call list previously produced by routine Expand_Actuals
    --  or Expand_Call_Helper into the tree.
@@ -3804,7 +3813,7 @@ package body Exp_Ch6 is
         and then Thunk_Entity (Current_Scope) = Subp
         and then Present (Extra_Formals (Subp))
       then
-         pragma Assert (Extra_Formals_Match_OK (Current_Scope, Subp));
+         pragma Assert (Present (Extra_Formals (Current_Scope)));
 
          declare
             Target_Formal : Entity_Id;
@@ -7185,9 +7194,8 @@ package body Exp_Ch6 is
    --------------------------
 
    function Has_BIP_Extra_Formal
-     (E              : Entity_Id;
-      Kind           : BIP_Formal_Kind;
-      Must_Be_Frozen : Boolean := True) return Boolean
+     (E    : Entity_Id;
+      Kind : BIP_Formal_Kind) return Boolean
    is
       Extra_Formal : Entity_Id := Extra_Formals (E);
 
@@ -7197,7 +7205,7 @@ package body Exp_Ch6 is
       --  extra formals are added when the target subprogram is frozen; see
       --  Expand_Dispatching_Call).
 
-      pragma Assert ((Is_Frozen (E) or else not Must_Be_Frozen)
+      pragma Assert (Is_Frozen (E)
         or else (Ekind (E) = E_Subprogram_Type
                    and then Is_Dispatch_Table_Entity (E))
         or else (Is_Dispatching_Operation (E)
@@ -7826,7 +7834,7 @@ package body Exp_Ch6 is
                or else
              (Kind = E_Subprogram_Type and then Typ /= Standard_Void_Type))
         and then Is_Build_In_Place_Result_Type (Typ)
-        and then not Has_Foreign_Convention (E);
+        and then not (Is_Imported (E) and then Has_Foreign_Convention (E));
    end Is_Build_In_Place_Function;
 
    -------------------------------------
@@ -8555,11 +8563,6 @@ package body Exp_Ch6 is
       --  initialization expression of the object to Empty, which would be
       --  illegal Ada, and would cause gigi to misallocate X.
 
-      Is_OK_Return_Object : constant Boolean :=
-        Is_Return_Object (Obj_Def_Id)
-          and then
-        not Has_Foreign_Convention (Return_Applies_To (Scope (Obj_Def_Id)));
-
    --  Start of processing for Make_Build_In_Place_Call_In_Object_Declaration
 
    begin
@@ -8612,7 +8615,7 @@ package body Exp_Ch6 is
       --  the result object is in a different (transient) scope, so won't cause
       --  freezing.
 
-      if Definite and then not Is_OK_Return_Object then
+      if Definite and then not Is_Return_Object (Obj_Def_Id) then
 
          --  The presence of an address clause complicates the build-in-place
          --  expansion because the indicated address must be processed before
@@ -8695,7 +8698,7 @@ package body Exp_Ch6 is
       --  really be directly built in place in the aggregate and not in a
       --  temporary. ???)
 
-      if Is_OK_Return_Object then
+      if Is_Return_Object (Obj_Def_Id) then
          Pass_Caller_Acc := True;
 
          --  When the enclosing function has a BIP_Alloc_Form formal then we
@@ -8880,7 +8883,7 @@ package body Exp_Ch6 is
       --  itself the return expression of an enclosing BIP function, then mark
       --  the object as having no initialization.
 
-      if Definite and then not Is_OK_Return_Object then
+      if Definite and then not Is_Return_Object (Obj_Def_Id) then
 
          --  The related object declaration is encased in a transient block
          --  because the build-in-place function call contains at least one
@@ -9237,7 +9240,7 @@ package body Exp_Ch6 is
         and then not No_Run_Time_Mode
         and then (Has_Task (Typ)
                     or else (Is_Class_Wide_Type (Typ)
-                               and then Is_Limited_Record (Etype (Typ))
+                               and then Is_Limited_Record (Typ)
                                and then not Has_Aspect
                                  (Etype (Typ), Aspect_No_Task_Parts)));
    end Might_Have_Tasks;
@@ -9247,6 +9250,7 @@ package body Exp_Ch6 is
    ----------------------------
 
    function Needs_BIP_Task_Actuals (Func_Id : Entity_Id) return Boolean is
+      pragma Assert (Is_Build_In_Place_Function (Func_Id));
       Subp_Id  : Entity_Id;
       Func_Typ : Entity_Id;
 
@@ -9271,12 +9275,6 @@ package body Exp_Ch6 is
 
       Func_Typ := Underlying_Type (Etype (Subp_Id));
 
-      --  Functions returning types with foreign convention don't have extra
-      --  formals.
-
-      if Has_Foreign_Convention (Func_Typ) then
-         return False;
-
       --  At first sight, for all the following cases, we could add assertions
       --  to ensure that if Func_Id is frozen then the computed result matches
       --  with the availability of the task master extra formal; unfortunately
@@ -9284,7 +9282,7 @@ package body Exp_Ch6 is
       --  (that is, Is_Frozen has been set by Freeze_Entity but it has not
       --  completed its work).
 
-      elsif Has_Task (Func_Typ) then
+      if Has_Task (Func_Typ) then
          return True;
 
       elsif Ekind (Func_Id) = E_Function then
@@ -9316,6 +9314,8 @@ package body Exp_Ch6 is
       Typ : constant Entity_Id := Underlying_Type (Etype (Func_Id));
 
    begin
+      pragma Assert (Is_Build_In_Place_Function (Func_Id));
+
       --  A formal giving the finalization master is needed for build-in-place
       --  functions whose result type needs finalization or is a tagged type.
       --  Tagged primitive build-in-place functions need such a formal because
@@ -9327,8 +9327,7 @@ package body Exp_Ch6 is
       --  such build-in-place functions, primitive or not.
 
       return not Restriction_Active (No_Finalization)
-        and then (Needs_Finalization (Typ) or else Is_Tagged_Type (Typ))
-        and then not Has_Foreign_Convention (Typ);
+        and then (Needs_Finalization (Typ) or else Is_Tagged_Type (Typ));
    end Needs_BIP_Finalization_Master;
 
    --------------------------
@@ -9339,6 +9338,8 @@ package body Exp_Ch6 is
       Typ : constant Entity_Id := Underlying_Type (Etype (Func_Id));
 
    begin
+      pragma Assert (Is_Build_In_Place_Function (Func_Id));
+
       --  A formal giving the allocation method is needed for build-in-place
       --  functions whose result type is returned on the secondary stack or
       --  is a tagged type. Tagged primitive build-in-place functions need
@@ -9350,8 +9351,7 @@ package body Exp_Ch6 is
       --  to be passed to all such build-in-place functions, primitive or not.
 
       return not Restriction_Active (No_Secondary_Stack)
-        and then (Needs_Secondary_Stack (Typ) or else Is_Tagged_Type (Typ))
-        and then not Has_Foreign_Convention (Typ);
+        and then (Needs_Secondary_Stack (Typ) or else Is_Tagged_Type (Typ));
    end Needs_BIP_Alloc_Form;
 
    -------------------------------------
diff --git a/gcc/ada/exp_ch6.ads b/gcc/ada/exp_ch6.ads
index ab547b9..19d0bc3 100644
--- a/gcc/ada/exp_ch6.ads
+++ b/gcc/ada/exp_ch6.ads
@@ -121,18 +121,6 @@ package Exp_Ch6 is
    --  The returned node is the root of the procedure body which will replace
    --  the original function body, which is not needed for the C program.
 
-   function Has_BIP_Extra_Formal
-     (E              : Entity_Id;
-      Kind           : BIP_Formal_Kind;
-      Must_Be_Frozen : Boolean := True) return Boolean;
-   --  Given a subprogram, subprogram type, entry or entry family, return True
-   --  if E has the BIP extra formal associated with Kind. In general this
-   --  subprogram must be invoked with a frozen entity or a subprogram type of
-   --  a dispatching call since we can only rely on the availability of extra
-   --  formals on these entities; this requirement can be relaxed using the
-   --  formal Must_Be_Frozen in scenarios where we know that the entity has
-   --  the extra formals.
-
    procedure Install_Class_Preconditions_Check (Call_Node : Node_Id);
    --  Install check of class-wide preconditions on the caller.
 
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index 3adc255..52858e2 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -4979,7 +4979,6 @@ package body Freeze is
               and then Convention (Desig) /= Convention_Protected
             then
                Set_Is_Frozen (Desig);
-               Create_Extra_Formals (Desig);
             end if;
          end Check_Itype;
 
@@ -8238,7 +8237,7 @@ package body Freeze is
             if Present (Nam)
               and then Ekind (Nam) = E_Function
               and then Nkind (Parent (N)) = N_Function_Call
-              and then not Has_Foreign_Convention (Nam)
+              and then Convention (Nam) = Convention_Ada
             then
                Create_Extra_Formals (Nam);
             end if;
@@ -9845,11 +9844,77 @@ package body Freeze is
    -----------------------
 
    procedure Freeze_Subprogram (E : Entity_Id) is
+      function Check_Extra_Formals (E : Entity_Id) return Boolean;
+      --  Return True if the decoration of the attributes associated with extra
+      --  formals are properly set.
 
       procedure Set_Profile_Convention (Subp_Id : Entity_Id);
       --  Set the conventions of all anonymous access-to-subprogram formals and
       --  result subtype of subprogram Subp_Id to the convention of Subp_Id.
 
+      -------------------------
+      -- Check_Extra_Formals --
+      -------------------------
+
+      function Check_Extra_Formals (E : Entity_Id) return Boolean is
+         Last_Formal       : Entity_Id := Empty;
+         Formal            : Entity_Id;
+         Has_Extra_Formals : Boolean := False;
+
+      begin
+         --  No check required if expansion is disabled because extra
+         --  formals are only generated when we are generating code.
+         --  See Create_Extra_Formals.
+
+         if not Expander_Active then
+            return True;
+         end if;
+
+         --  Check attribute Extra_Formal: If available, it must be set only
+         --  on the last formal of E.
+
+         Formal := First_Formal (E);
+         while Present (Formal) loop
+            if Present (Extra_Formal (Formal)) then
+               if Has_Extra_Formals then
+                  return False;
+               end if;
+
+               Has_Extra_Formals := True;
+            end if;
+
+            Last_Formal := Formal;
+            Next_Formal (Formal);
+         end loop;
+
+         --  Check attribute Extra_Accessibility_Of_Result
+
+         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;
+
+         --  Check attribute Extra_Formals: If E has extra formals, then this
+         --  attribute must point to the first extra formal of E.
+
+         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);
+
+         --  When E has no formals, the first extra formal is available through
+         --  the Extra_Formals attribute.
+
+         elsif Present (Extra_Formals (E)) then
+            return No (First_Formal (E));
+
+         else
+            return True;
+         end if;
+      end Check_Extra_Formals;
+
       ----------------------------
       -- Set_Profile_Convention --
       ----------------------------
@@ -9988,26 +10053,30 @@ package body Freeze is
       --  that we know the convention.
 
       if not Has_Foreign_Convention (E) then
+         if No (Extra_Formals (E)) then
 
-         --  Extra formals of dispatching operations are added later by
-         --  Expand_Freeze_Record_Type, which also adds extra formals to
-         --  internal entities built to handle interface types.
+            --  Extra formals are shared by derived subprograms; therefore, if
+            --  the ultimate alias of E has been frozen before E then the extra
+            --  formals have been added, but the attribute Extra_Formals is
+            --  still unset (and must be set now).
 
-         if not Is_Dispatching_Operation (E) then
-            Create_Extra_Formals (E);
+            if Present (Alias (E))
+              and then Is_Frozen (Ultimate_Alias (E))
+              and then Present (Extra_Formals (Ultimate_Alias (E)))
+              and then Last_Formal (Ultimate_Alias (E)) = Last_Formal (E)
+            then
+               Set_Extra_Formals (E, Extra_Formals (Ultimate_Alias (E)));
 
-            pragma Assert
-              ((Ekind (E) = E_Subprogram_Type
-                  and then Extra_Formals_OK (E))
-               or else
-                 (Is_Subprogram (E)
-                   and then Extra_Formals_OK (E)
-                   and then
-                     (No (Overridden_Operation (E))
-                       or else Extra_Formals_Match_OK (E,
-                                 Ultimate_Alias (Overridden_Operation (E))))));
+               if Ekind (E) = E_Function then
+                  Set_Extra_Accessibility_Of_Result (E,
+                    Extra_Accessibility_Of_Result (Ultimate_Alias (E)));
+               end if;
+            else
+               Create_Extra_Formals (E);
+            end if;
          end if;
 
+         pragma Assert (Check_Extra_Formals (E));
          Set_Mechanisms (E);
 
          --  If this is convention Ada and a Valued_Procedure, that's odd
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 99e188d..00c2e67 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -1318,8 +1318,7 @@ package body Sem_Ch3 is
 
       Check_Restriction (No_Access_Subprograms, T_Def);
 
-      --  Addition of extra formals must be delayed till the freeze point so
-      --  that we know the convention.
+      Create_Extra_Formals (Desig_Type);
    end Access_Subprogram_Declaration;
 
    ----------------------------
@@ -11769,9 +11768,11 @@ package body Sem_Ch3 is
          Insert_Before (Typ_Decl, Decl);
          Analyze (Decl);
 
-         --  At first sight we could add here the extra formals of an access to
-         --  subprogram; however, it must delayed till the freeze point so that
-         --  we know the convention.
+         --  If an access to subprogram, create the extra formals
+
+         if Present (Acc_Def) then
+            Create_Extra_Formals (Designated_Type (Anon_Access));
+         end if;
 
          if Nkind (Comp_Def) = N_Component_Definition then
             Rewrite (Comp_Def,
@@ -16032,12 +16033,12 @@ package body Sem_Ch3 is
          Next_Formal (Formal);
       end loop;
 
-      --  Extra formals are shared between the parent subprogram and this
-      --  internal entity built by Derive_Subprogram (implicit in the above
-      --  copy of formals), unless the parent type is a limited interface type;
-      --  hence we must inherit also the reference to the first extra formal.
-      --  When the parent type is an interface, the extra formals will be added
-      --  when the tagged type is frozen (see Expand_Freeze_Record_Type).
+      --  Extra formals are shared between the parent subprogram and the
+      --  derived subprogram (implicit in the above copy of formals), unless
+      --  the parent type is a limited interface type; hence we must inherit
+      --  also the reference to the first extra formal. When the parent type is
+      --  an interface the extra formals will be added when the subprogram is
+      --  frozen (see Freeze.Freeze_Subprogram).
 
       if not Is_Limited_Interface (Parent_Type) then
          Set_Extra_Formals (New_Subp, Extra_Formals (Parent_Subp));
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 6f71adb..c92e691 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -34,7 +34,6 @@ 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;
@@ -201,13 +200,6 @@ 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;
@@ -3357,8 +3349,7 @@ package body Sem_Ch6 is
                       or else
                         (Is_Class_Wide_Type (Designated_Type (Etype (Scop)))
                            and then
-                         Is_Limited_Record
-                           (Etype (Designated_Type (Etype (Scop))))))
+                         Is_Limited_Record (Designated_Type (Etype (Scop)))))
            and then Expander_Active
          then
             Decl := Build_Master_Declaration (Loc);
@@ -8477,253 +8468,6 @@ 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 --
    ---------------------------
@@ -9203,29 +8947,6 @@ 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_BIP_Formals (E : Entity_Id) return Boolean;
-      --  Determines if a given entity has build-in-place formals
-
-      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 --
       ----------------------
@@ -9236,7 +8957,10 @@ package body Sem_Ch6 is
          Scope        : Entity_Id;
          Suffix       : String) return Entity_Id
       is
-         EF : Entity_Id;
+         EF : constant Entity_Id :=
+                Make_Defining_Identifier (Sloc (Assoc_Entity),
+                  Chars  => New_External_Name (Chars (Assoc_Entity),
+                                               Suffix => Suffix));
 
       begin
          --  A little optimization. Never generate an extra formal for the
@@ -9247,10 +8971,6 @@ 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);
@@ -9272,280 +8992,49 @@ package body Sem_Ch6 is
          return EF;
       end Add_Extra_Formal;
 
-      ---------------------
-      -- 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_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 non-dispatching 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) Overridding 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
-            --  overriddden 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;
-      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;
+      Formal_Type : Entity_Id;
+      P_Formal    : 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;
-
-      --  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;
+      end if;
 
       --  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).
 
-      elsif Is_Thunk (E) and then No (Extra_Formals (Thunk_Target (E))) then
+      if Is_Thunk (E) and then No (Extra_Formals (Thunk_Target (E))) then
          return;
+      end if;
 
-      --  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).
-
-      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;
+      --  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.
 
-         pragma Assert (Extra_Formals_OK (E));
-         return;
+      if Is_Overloadable (E) and then Present (Alias (E)) then
+         P_Formal := First_Formal (Alias (E));
+      else
+         P_Formal := Empty;
       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;
 
-      --  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 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 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 Has_Foreign_Convention (Ref_E)
-        or else (Present (Alias_Subp)
-                   and then Has_Foreign_Convention (Alias_Subp))
-      then
+      if Present (Last_Extra) and then Present (Extra_Formal (Last_Extra)) then
          return;
       end if;
 
@@ -9560,74 +9049,20 @@ 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 non-dispatching 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.
@@ -9672,22 +9107,36 @@ package body Sem_Ch6 is
             end if;
          end if;
 
-         --  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)));
+         --  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.
 
+         --  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
@@ -9695,12 +9144,8 @@ package body Sem_Ch6 is
 
          <<Skip_Extra_Formal_Generation>>
 
-         if Present (Parent_Formal) then
-            Next_Formal (Parent_Formal);
-         end if;
-
-         if Present (Alias_Formal) then
-            Next_Formal (Alias_Formal);
+         if Present (P_Formal) then
+            Next_Formal (P_Formal);
          end if;
 
          Next_Formal (Formal);
@@ -9708,47 +9153,20 @@ package body Sem_Ch6 is
 
       <<Test_For_Func_Result_Extras>>
 
-      --  Assume the worse scenery (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.
+      --  Ada 2012 (AI05-234): "the accessibility level of the result of a
+      --  function call is ... determined by the point of call ...".
 
-      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;
+      if Needs_Result_Accessibility_Level (E) then
+         Set_Extra_Accessibility_Of_Result
+           (E, Add_Extra_Formal (E, Standard_Natural, E, "L"));
+      end if;
 
       --  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 (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
+      if Is_Build_In_Place_Function (E) then
          declare
-            Result_Subt : constant Entity_Id := Etype (Ref_E);
+            Result_Subt : constant Entity_Id := Etype (E);
             Formal_Typ  : Entity_Id;
             Subp_Decl   : Node_Id;
             Discard     : Entity_Id;
@@ -9766,14 +9184,7 @@ 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 (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));
-
+            if Needs_BIP_Alloc_Form (E) then
                Discard :=
                  Add_Extra_Formal
                    (E, Standard_Natural,
@@ -9789,66 +9200,23 @@ 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 (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));
-
+            if Needs_BIP_Finalization_Master (E) then
                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 (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))));
-
+            if Needs_BIP_Task_Actuals (E) then
                Discard :=
                  Add_Extra_Formal
                    (E, Standard_Integer,
@@ -9860,16 +9228,6 @@ 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
@@ -9935,14 +9293,6 @@ 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;
 
    -----------------------------
@@ -10173,162 +9523,252 @@ package body Sem_Ch6 is
       end if;
    end Enter_Overloaded_Entity;
 
-   ----------------------------
-   -- Extra_Formals_Match_OK --
-   ----------------------------
+   -----------------------------
+   -- Check_Untagged_Equality --
+   -----------------------------
 
-   function Extra_Formals_Match_OK
-     (E     : Entity_Id;
-      Ref_E : Entity_Id) return Boolean is
-   begin
-      pragma Assert (Is_Subprogram (E));
-
-      --  Cases were 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 non-dispatching 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;
+   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));
 
-      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 True;
-      end if;
+      procedure Freezing_Point_Warning (N : Node_Id; S : String);
+      --  Output a warning about the freezing point N of Typ
 
-      --  Perform the checks
+      function Is_Actual_Of_Instantiation
+        (E    : Entity_Id;
+         Inst : Node_Id) return Boolean;
+      --  Return True if E is an actual parameter of instantiation Inst
 
-      if No (Extra_Formals (E)) then
-         return No (Extra_Formals (Ref_E));
-      end if;
+      -----------------------------------
+      -- Output_Freezing_Point_Warning --
+      -----------------------------------
 
-      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;
+      procedure Freezing_Point_Warning (N : Node_Id; S : String) is
+      begin
+         Error_Msg_String (1 .. S'Length) := S;
+         Error_Msg_Strlen := S'Length;
 
-      declare
-         Formal_1 : Entity_Id := Extra_Formals (E);
-         Formal_2 : Entity_Id := Extra_Formals (Ref_E);
+         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
-         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;
+         if Present (Generic_Associations (Inst)) then
+            Assoc := First (Generic_Associations (Inst));
 
-            elsif Has_Suffix (Formal_1, 'O') then
-               if not Has_Suffix (Formal_2, 'O') then
-                  return False;
+            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;
 
-            elsif BIP_Suffix_Kind (Formal_1) /= BIP_Suffix_Kind (Formal_2) then
-               return False;
-            end if;
+               Next (Assoc);
+            end loop;
+         end if;
 
-            Formal_1 := Next_Formal_With_Extras (Formal_1);
-            Formal_2 := Next_Formal_With_Extras (Formal_2);
-         end loop;
+         return False;
+      end Is_Actual_Of_Instantiation;
 
-         return No (Formal_1) and then No (Formal_2);
-      end;
-   end Extra_Formals_Match_OK;
+      --  Local variable
 
-   ----------------------
-   -- Extra_Formals_OK --
-   ----------------------
+      Decl : Node_Id;
 
-   function Extra_Formals_OK (E : Entity_Id) return Boolean is
-      Last_Formal       : Entity_Id := Empty;
-      Formal            : Entity_Id;
-      Has_Extra_Formals : Boolean := False;
+   --  Start of processing for Check_Untagged_Equality
 
    begin
-      --  No check required if explicitly disabled
+      --  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 Debug_Flag_Underscore_XX 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)
+      then
+         return;
+      end if;
 
-      --  No check required if expansion is disabled because extra
-      --  formals are only generated when we are generating code.
-      --  See Create_Extra_Formals.
+      --  In Ada 2012 case, we will output errors or warnings depending on
+      --  the setting of debug flag -gnatd.E.
 
-      elsif not Expander_Active then
-         return True;
+      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;
 
-      --  Check attribute Extra_Formal: If available, it must be set only
-      --  on the last formal of E.
+      --  Cases where the type has already been frozen
 
-      Formal := First_Formal (E);
-      while Present (Formal) loop
-         if Present (Extra_Formal (Formal)) then
-            if Has_Extra_Formals then
-               return False;
-            end if;
+      if Is_Frozen (Typ) then
 
-            Has_Extra_Formals := True;
-         end if;
+         --  The check applies to a primitive operation, so check that type
+         --  and equality operation are in the same scope.
 
-         Last_Formal := Formal;
-         Next_Formal (Formal);
-      end loop;
+         if Scope (Typ) /= Current_Scope then
+            return;
 
-      --  Check attribute Extra_Accessibility_Of_Result
+         --  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 Needs_Result_Accessibility_Level (E)
-        and then No (Extra_Accessibility_Of_Result (E))
-      then
-         return False;
-      end if;
+         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));
 
-      --  Check attribute Extra_Formals: If E has extra formals, then this
-      --  attribute must point to the first extra formal of E.
+            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;
 
-      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);
+               --  The instantiation of a generic on the type
 
-      --  When E has no formals, the first extra formal is available through
-      --  the Extra_Formals attribute.
+               elsif Nkind (Decl) in N_Generic_Instantiation
+                 and then Is_Actual_Of_Instantiation (Typ, Decl)
+               then
+                  Freezing_Point_Warning (Decl, "instantiation");
+                  exit;
 
-      elsif Present (Extra_Formals (E)) then
-         return No (First_Formal (E));
+               --  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
-         return True;
+         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 Extra_Formals_OK;
+   end Check_Untagged_Equality;
 
    -----------------------------
    -- Find_Corresponding_Spec --
@@ -11213,70 +10653,6 @@ package body Sem_Ch6 is
       end if;
    end Fully_Conformant_Discrete_Subtypes;
 
-   --------------------------------
-   -- 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 primive
-      --  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 --
    --------------------
diff --git a/gcc/ada/sem_ch6.ads b/gcc/ada/sem_ch6.ads
index 6a499bd..da56ce6 100644
--- a/gcc/ada/sem_ch6.ads
+++ b/gcc/ada/sem_ch6.ads
@@ -174,22 +174,6 @@ package Sem_Ch6 is
    --  the end of Subp's parameter list (with each subsequent extra formal
    --  being attached to the preceding extra formal).
 
-   function Extra_Formals_Match_OK
-     (E     : Entity_Id;
-      Ref_E : Entity_Id) return Boolean;
-   --  Return True if the extra formals of the given entities match. E is a
-   --  subprogram, and Ref_E is the reference entity that will be used to check
-   --  the extra formals of E: a subprogram type or another subprogram. For
-   --  example, if E is a dispatching primitive of a tagged type then Ref_E
-   --  may be the overridden primitive of its parent type or its ultimate
-   --  renamed entity; however, if E is a subprogram to which 'Access is
-   --  applied then Ref_E is its corresponding subprogram type. Used in
-   --  assertions.
-
-   function Extra_Formals_OK (E : Entity_Id) return Boolean;
-   --  Return True if the decoration of the attributes associated with extra
-   --  formals are properly set. Used in assertions.
-
    function Find_Corresponding_Spec
      (N          : Node_Id;
       Post_Error : Boolean := True) return Entity_Id;
diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb
index 0332232..2ba4608 100644
--- a/gcc/ada/sem_eval.adb
+++ b/gcc/ada/sem_eval.adb
@@ -1823,7 +1823,6 @@ package body Sem_Eval is
          return False;
 
       elsif Op = Error
-        or else Nkind (Op) not in N_Has_Etype
         or else Etype (Op) = Any_Type
         or else Raises_Constraint_Error (Op)
       then
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 5434a06..4a12f08 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -23226,12 +23226,9 @@ package body Sem_Util is
 
          return Present (Extra_Accessibility_Of_Result (Alias (Func_Id)));
 
-      --  Remaining cases require Ada 2012 mode, unless they are dispatching
-      --  operations, since they may be overridden by Ada_2012 primitives.
+      --  Remaining cases require Ada 2012 mode
 
-      elsif Ada_Version < Ada_2012
-        and then not Is_Dispatching_Operation (Func_Id)
-      then
+      elsif Ada_Version < Ada_2012 then
          return False;
 
       --  Handle the situation where a result is an anonymous access type