From f1668c3d35b1031fa3ee266b6c3292e53344d315 Mon Sep 17 00:00:00 2001 From: Javier Miranda Date: Sun, 16 Oct 2022 19:48:53 +0000 Subject: ada: Enforce matching of extra formals This patch enforces matching of extra formals in overridden subprograms, subprogram renamings, and subprograms to which attributes 'Access, 'Unchecked_Access, or 'Unrestricted_Access is applied (for these access cases the subprogram is checked against its corresponding subprogram type). This enforcement is an internal consistency check, not an implementation of some language legality rule. gcc/ada/ * debug.adb (Debug_Flag_Underscore_XX): Switch -gnatd_X used temporarily to allow disabling extra formal checks. * exp_attr.adb (Expand_N_Attribute_Reference [access types]): Add extra formals to the subprogram referenced in the prefix of 'Unchecked_Access, 'Unrestricted_Access or 'Access; required to check that its extra formals match the extra formals of the corresponding subprogram type. * exp_ch3.adb (Stream_Operation_OK): Declaration moved to the public part of the package. (Validate_Tagged_Type_Extra_Formals): New subprogram. (Expand_Freeze_Record_Type): Improve the code that takes care of adding the extra formals of dispatching primitives; extended to add also the extra formals to renamings of dispatching primitives. * exp_ch3.ads (Stream_Operation_OK): Declaration moved from the package body. * exp_ch6.adb (Check_BIP_Actuals): Complete documentation. (Has_BIP_Extra_Formal): Subprogram declaration moved to the public part of the package. In addition, a parameter has been added to disable an assertion that requires its use with frozen entities. (Duplicate_Params_Without_Extra_Actuals): New subprogram. (Check_Subprogram_Variant): Emit the call without duplicating the extra formals since they will be added when the call is analyzed. (Expand_Call_Helper): Ensure that the called subprogram has all its extra formals, enforce assertion checking extra formals on thunks, and mark calls from thunks as processed-BIP-calls to avoid adding their extra formals twice. (Is_Build_In_Place_Function): Return False for entities with foreign convention. (Is_Build_In_Place_Function_Call): Return True also for not BIP functions that have BIP formals since the extra actuals are required. (Make_Build_In_Place_Call_In_Object_Declaration): Occurrences of Is_Return_Object replaced by the local variable Is_OK_Return_Object that evaluates to False for scopes with foreign convention. (Might_Have_Tasks): Fix check of class-wide limited record types. (Needs_BIP_Task_Actuals): Remove assertion to allow calling this function in more contexts; in addition it returns False for functions returning objects with foreign convention. (Needs_BIP_Finalization_Master): Likewise. (Needs_BIP_Alloc_Form): Likewise. (Validate_Subprogram_Calls): Check that the number of actuals (including extra actuals) of calls in the subtree N match their corresponding formals. * exp_ch6.ads (Has_BIP_Extra_Formal): Subprogram declaration moved to the public part of the package. In addition, a parameter has been added to disable an assertion that requires its use with frozen entities. (Is_Build_In_Place_Function_Call): Complete documentation. (Validate_Subprogram_Calls): Check that the number of actuals (including extra actuals) of calls in the subtree N match their corresponding formals. * freeze.adb (Check_Itype): Add extra formals to anonymous access subprogram itypes. (Freeze_Expression): Improve code that disables the addition of extra formals to functions with foreign convention. (Check_Extra_Formals): Moved to package Sem_Ch6 as Extra_Formals_OK. (Freeze_Subprogram): Add extra formals to non-dispatching subprograms. * frontend.adb (Frontend): Validate all the subprogram calls; it can be disabled using switch -gnatd_X * sem_ch3.adb (Access_Subprogram_Declaration): Defer the addition of extra formals to the freezing point so that we know the convention. (Check_Anonymous_Access_Component): Likewise. (Derive_Subprogram): Fix documentation. * sem_ch6.adb (Has_Reliable_Extra_Formals): New subprogram. (Check_Anonymous_Return): Fix check of access to class-wide limited record types. (Check_Untagged_Equality): Placed in alphabetical order. (Extra_Formals_OK): Subprogram moved from freeze.adb. (Extra_Formals_Match_OK): New subprogram. (Has_BIP_Formals): New subprogram. (Has_Extra_Formals): New subprograms. (Needs_Accessibility_Check_Extra): New subprogram. (Parent_Subprogram): New subprogram. (Add_Extra_Formal): Minor code cleanup. (Create_Extra_Formals): Enforce matching extra formals on overridden and aliased entities. * sem_ch6.ads (Extra_Formals_Match_OK): New subprogram. (Extra_Formals_OK): Subprogram moved from freeze.adb. * sem_eval.adb (Compile_Time_Known_Value): Improve predicate to avoid assertion failure; found working on this ticket; this change does not affect the behavior of the compiler because this subprogram has an exception handler that returns False when the assertion fails. * sem_util.adb (Needs_Result_Accessibility_Level): Do not return False for dispatching operations compiled with Ada_Version < 2012 since they they may be overridden by primitives compiled with Ada_Version >= Ada_2012. --- gcc/ada/freeze.adb | 115 +++++++++++------------------------------------------ 1 file changed, 23 insertions(+), 92 deletions(-) (limited to 'gcc/ada/freeze.adb') diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 1fdc9d0d60e..032c73d3dfb 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -4984,6 +4984,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; @@ -7131,11 +7132,11 @@ package body Freeze is Check_Debug_Info_Needed (E); - -- AI-117 requires that the convention of a partial view be the - -- same as the convention of the full view. Note that this is a - -- recognized breach of privacy, but it's essential for logical - -- consistency of representation, and the lack of a rule in - -- RM95 was an oversight. + -- AI95-117 requires that the convention of a partial view be + -- the same as the convention of the full view. Note that this + -- is a recognized breach of privacy, but it's essential for + -- logical consistency of representation, and the lack of a + -- rule in RM95 was an oversight. Set_Convention (E, Convention (Full_View (E))); @@ -7360,7 +7361,7 @@ package body Freeze is if Is_Composite_Type (E) then - -- AI-117 requires that all new primitives of a tagged type must + -- AI95-117 requires that all new primitives of a tagged type must -- inherit the convention of the full view of the type. Inherited -- and overriding operations are defined to inherit the convention -- of their parent or overridden subprogram (also specified in @@ -8268,7 +8269,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; @@ -9875,77 +9876,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 -- ---------------------------- @@ -10084,30 +10019,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 -- cgit v1.2.1