diff options
author | Javier Miranda <miranda@adacore.com> | 2022-08-15 16:54:40 +0000 |
---|---|---|
committer | Marc Poulhiès <poulhies@adacore.com> | 2022-09-06 09:14:22 +0200 |
commit | 51abc0cc8691daecd7cec8372e4988e9f3f1913c (patch) | |
tree | f44c568c999e9b6c23e85d8543f789f3c1cb643a /gcc/ada/freeze.adb | |
parent | 63499dbd7dd5c8ea814d07e0e6f5c254ff403a5b (diff) | |
download | gcc-51abc0cc8691daecd7cec8372e4988e9f3f1913c.zip gcc-51abc0cc8691daecd7cec8372e4988e9f3f1913c.tar.gz gcc-51abc0cc8691daecd7cec8372e4988e9f3f1913c.tar.bz2 |
[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.
Diffstat (limited to 'gcc/ada/freeze.adb')
-rw-r--r-- | gcc/ada/freeze.adb | 103 |
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 |