https://gcc.gnu.org/g:6632608c6190a9c9452b3547d3ccc33a6e580bfc
commit r17-1203-g6632608c6190a9c9452b3547d3ccc33a6e580bfc Author: Eric Botcazou <[email protected]> Date: Wed Apr 22 13:54:17 2026 +0200 ada: Fix crash on allocator of class-wide interface as actual in subprogram call The crash occurs because the type of the allocator lacks the Master_Id to be passed to the function initializing the allocator, which is required because the interface is limited and therefore may be the progenitor of a type that contains tasks. It comes from a couple of problems: 1) the special conversion trick used in Resolve_Actuals to force the displacement of the pointer, which blocks the proper resolution of the allocator (its E_Allocator_Type is not replaced), and 2) the lack of Master_Id on the E_Access_Subtype created for the subtype of the parameter in the subprogram call, which is the not null variant of a named access type. The former problem is solved by resolving the allocator explicitly, while the latter is solved by changing Master_Id to live on root types only (in accordance with RM 9.3(2), which says that it should designate the master construct that elaborates the ultimate ancestor of a given access type). The change contains a couple of additional fixes: 3) the proper resolution of the allocator causes missing accessibility checks to be generated, which in turn generates a fair amount of useless access checks and 4) an incorrect transient scope would be created around the allocator when the type of the parameter is named, while it's only needed for an anonymous access type. gcc/ada/ChangeLog: * gen_il-gen-gen_entities.adb (Access_Kind): Add Root_Type_Only for the Master_Id field. * einfo.ads (Master_Id): Document that it lives on root types only. * accessibility.adb (Apply_Accessibility_Check_For_Allocator): Avoid generating secondary useless checks. * exp_ch3.adb (Build_Initialization_Call): Use the Master_Id of the type of target reference directly. (Build_Master): Minor tweak. (Expand_N_Full_Type_Declaration): Do not call Build_Master for a derived access type declaration. * exp_ch4.adb (Expand_N_Allocator): Test Master_Id directly on the access type. * sem_res.adb (Resolve_Actuals): In the case of an allocator, if the designated type is a CW interface, call Convert_To_And_Rewrite to add the special conversion but nevertheless resolve the allocator to the type of the formal afterward; do not establish a transient scope if the type is a named access type. Diff: --- gcc/ada/accessibility.adb | 3 ++- gcc/ada/einfo.ads | 6 ++--- gcc/ada/exp_ch3.adb | 11 ++++---- gcc/ada/exp_ch4.adb | 2 +- gcc/ada/gen_il-gen-gen_entities.adb | 2 +- gcc/ada/sem_res.adb | 54 +++++++++++++++++-------------------- 6 files changed, 38 insertions(+), 40 deletions(-) diff --git a/gcc/ada/accessibility.adb b/gcc/ada/accessibility.adb index 396c8914f9a5..9b5d0fba73ae 100644 --- a/gcc/ada/accessibility.adb +++ b/gcc/ada/accessibility.adb @@ -1169,7 +1169,8 @@ package body Accessibility is Insert_Action (N, Make_Implicit_If_Statement (N, Condition => Cond, - Then_Statements => Stmts)); + Then_Statements => Stmts), + Suppress => All_Checks); end if; end Apply_Accessibility_Check_For_Allocator; diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index 9c293f478145..b156de6ee051 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -3688,7 +3688,7 @@ package Einfo is -- having Has_Machine_Radix_Clause True. This happens when a type is -- derived from a type with a clause present. --- Master_Id +-- Master_Id [root type only] -- Defined in access types and subtypes. Empty unless Has_Task is set for -- the designated type, in which case it points to the entity for the -- Master_Id for the access type master. Also set for access-to-limited- @@ -5252,7 +5252,7 @@ package Einfo is -- E_Access_Type -- E_Access_Subtype -- Direct_Primitive_Operations $$$ type - -- Master_Id + -- Master_Id (root type only) -- Directly_Designated_Type -- Associated_Storage_Pool (root type only) -- Finalization_Collection (root type only) @@ -5704,7 +5704,7 @@ package Einfo is -- E_General_Access_Type -- First_Entity $$$ -- Renamed_Entity $$$ - -- Master_Id + -- Master_Id (root type only) -- Directly_Designated_Type -- Associated_Storage_Pool (root type only) -- Finalization_Collection (root type only) diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index 843dc173c25b..12cbd58a42bd 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -2564,8 +2564,7 @@ package body Exp_Ch3 is Append_To (Args, Make_Integer_Literal (Loc, Library_Task_Level)); elsif Present (Target_Ref) then Append_To (Args, - New_Occurrence_Of - (Master_Id (Base_Type (Root_Type (Etype (Target_Ref)))), Loc)); + New_Occurrence_Of (Master_Id (Etype (Target_Ref)), Loc)); else Append_To (Args, Make_Identifier (Loc, Name_uMaster)); end if; @@ -6882,8 +6881,8 @@ package body Exp_Ch3 is -- but testing Comes_From_Source may be too general in this case -- (affects some test output)??? - elsif not Is_Param_Block_Component_Type (Ptr_Typ) - and then Is_Limited_Class_Wide_Type (Desig_Typ) + elsif Is_Limited_Class_Wide_Type (Desig_Typ) + and then not Is_Param_Block_Component_Type (Ptr_Typ) then Build_Master_Entity (N); Build_Master_Renaming (Ptr_Typ); @@ -6901,7 +6900,9 @@ package body Exp_Ch3 is begin if Is_Access_Type (Def_Id) then - Build_Master (Def_Id); + if Nkind (Type_Definition (N)) /= N_Derived_Type_Definition then + Build_Master (Def_Id); + end if; if Ekind (Def_Id) = E_Access_Protected_Subprogram_Type then Expand_Access_Protected_Subprogram_Type (N); diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 2763aed4f9a5..1bad0f9a3c87 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -4976,7 +4976,7 @@ package body Exp_Ch4 is -- created when expanding the function declaration. if Has_Task (Etyp) then - if No (Master_Id (Base_Type (PtrT))) then + if No (Master_Id (PtrT)) then -- The designated type was an incomplete type, and the -- access type did not get expanded. Salvage it now. diff --git a/gcc/ada/gen_il-gen-gen_entities.adb b/gcc/ada/gen_il-gen-gen_entities.adb index 716c1d33f7aa..60de3aa27d81 100644 --- a/gcc/ada/gen_il-gen-gen_entities.adb +++ b/gcc/ada/gen_il-gen-gen_entities.adb @@ -652,7 +652,7 @@ begin -- Gen_IL.Gen.Gen_Entities Sm (Is_Local_Anonymous_Access, Flag), Sm (Is_Param_Block_Component_Type, Flag, Base_Type_Only), Sm (Is_Pure_Unit_Access_Type, Flag), - Sm (Master_Id, Node_Id), + Sm (Master_Id, Node_Id, Root_Type_Only), Sm (No_Pool_Assigned, Flag, Root_Type_Only), Sm (No_Strict_Aliasing, Flag, Base_Type_Only), Sm (Storage_Size_Variable, Node_Id, Impl_Base_Type_Only))); diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 08d45ebca33e..028e170021e4 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -4513,51 +4513,47 @@ package body Sem_Res is end if; end if; - -- (Ada 2005: AI-251): If the actual is an allocator whose - -- directly designated type is a class-wide interface, we build - -- an anonymous access type to use it as the type of the - -- allocator. Later, when the subprogram call is expanded, if - -- the interface has a secondary dispatch table the expander - -- will add a type conversion to force the correct displacement - -- of the pointer. - if Nkind (A) = N_Allocator then declare DDT : constant Entity_Id := Directly_Designated_Type (Base_Type (Etype (F))); begin - -- Displace the pointer to the object to reference its - -- secondary dispatch table. + -- Ada 2005, AI-251: If the actual is an allocator whose + -- directly designated type is a class-wide interface, we + -- build a type conversion to force the displacement of + -- the pointer to reference the secondary dispatch table. + -- Note that we need to resolve the allocator explicitly, + -- otherwise its E_Allocator_Type will never be replaced, + -- since it's now the operand of a type conversion. if Is_Class_Wide_Type (DDT) and then Is_Interface (DDT) then - Rewrite (A, Convert_To (Etype (F), Relocate_Node (A))); + Convert_To_And_Rewrite (Etype (F), A); Flag_Interface_Pointer_Displacement (A); - - Analyze_And_Resolve (A, Etype (F), - Suppress => Access_Check); + Resolve (Expression (A), Etype (F)); + Analyze_And_Resolve + (A, Etype (F), Suppress => Access_Check); end if; - -- Ada 2005, AI-162:If the actual is an allocator, the - -- innermost enclosing statement is the master of the - -- created object. This needs to be done with expansion - -- enabled only, otherwise the transient scope will not - -- be removed in the expansion of the wrapped construct. + -- Ada 2005, AI-162: If the actual of an access parameter + -- is an allocator, the innermost enclosing statement is + -- the master of the created object. When the expander is + -- active, establish a transient scope to embody it. - if Expander_Active - and then (Needs_Finalization (DDT) - or else Has_Task (DDT)) - then - Establish_Transient_Scope - (A, Manage_Sec_Stack => False); + if Ekind (Etype (F)) = E_Anonymous_Access_Type then + Check_Restriction (No_Access_Parameter_Allocators, A); + + if Expander_Active + and then (Needs_Finalization (DDT) + or else Might_Have_Tasks (DDT)) + then + Establish_Transient_Scope + (A, Manage_Sec_Stack => False); + end if; end if; end; - - if Ekind (Etype (F)) = E_Anonymous_Access_Type then - Check_Restriction (No_Access_Parameter_Allocators, A); - end if; end if; -- (Ada 2005): The call may be to a primitive operation of a
