From: Eric Botcazou <ebotcazou@adacore.com>
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.
Tested on x86_64-pc-linux-gnu, committed on master.
---
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(-)
@@ -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;
@@ -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 [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)
@@ -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);
@@ -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.
@@ -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)));
@@ -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