[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).

gcc/ada/

	* debug.adb
	(Debug_Flag_Underscore_X): Switch added 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
	(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.
	(Expand_Call_Helper): Enforce assertion checking extra formals on
	thunks.
	(Is_Build_In_Place_Function): Return False for entities with
	foreign convention.
	(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.

	* exp_ch6.ads
	(Stream_Operation_OK): Declaration moved from the package body. In
	addition, a parameter has been added to disable assertion that
	requires its use with frozen entities.

	* 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.

	* 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
	(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.
	(Needs_Constrained_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.
	(Has_Reliable_Extra_Formals): New subprogram.

	* sem_ch6.ads
	(Extra_Formals_OK): Subprogram moved from freeze.adb.
	(Extra_Formals_Match_OK): New subprogram.

	* 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, 17 insertions, 86 deletions

diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index 52858e2..3adc255 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -4979,6 +4979,7 @@ package body Freeze is
               and then Convention (Desig) /= Convention_Protected
             then
                Set_Is_Frozen (Desig);
+               Create_Extra_Formals (Desig);
             end if;
          end Check_Itype;
 
@@ -8237,7 +8238,7 @@ package body Freeze is
             if Present (Nam)
               and then Ekind (Nam) = E_Function
               and then Nkind (Parent (N)) = N_Function_Call
-              and then Convention (Nam) = Convention_Ada
+              and then not Has_Foreign_Convention (Nam)
             then
                Create_Extra_Formals (Nam);
             end if;
@@ -9844,77 +9845,11 @@ 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 --
       ----------------------------
@@ -10053,30 +9988,26 @@ package body Freeze is
       --  that we know the convention.
 
       if not Has_Foreign_Convention (E) then
-         if No (Extra_Formals (E)) then
 
-            --  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).
+         --  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.
 
-            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)));
+         if not Is_Dispatching_Operation (E) then
+            Create_Extra_Formals (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;
+            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))))));
          end if;
 
-         pragma Assert (Check_Extra_Formals (E));
          Set_Mechanisms (E);
 
          --  If this is convention Ada and a Valued_Procedure, that's odd