Adjust previous patch to improve the support for AI05-0151-1/08.
gcc/ada/ChangeLog:
* exp_attr.adb (Rewrite_Attribute_Proc_Call): Add new parameter
to calls to Create_Extra_Formals.
(Expand_N_Attribute_Reference): Ditto.
* exp_ch3.adb (Expand_Freeze_Record_Type): Ditto.
* exp_ch6.adb (Expand_Call_Helper): Ditto.
* exp_disp.adb (Expand_Dispatching_Call): Ditto.
* freeze.adb (Check_Itype): Ditto.
(Freeze_Expression): Ditto.
* sem_ch6.adb (Analyze_Subprogram_Body_Helper): Ditto.
(Create_Extra_Formals): Add new formal, and use it to determine
if the creation of the extra formals can be deferred. Add the
new parameter to calls to Create_Extra_Formals.
(Is_Unsupported_Extra_Actuals_Call): Adjust the code to improve
its performance when the result is known.
(Is_Unsupported_Extra_Formals_Entity): Ditto. Add new formal
* sem_ch6.ads (Create_Extra_Formals): Add new formal.
(Is_Unsupported_Extra_Formals_Entity): Ditto.
-- that it has the necessary extra formals.
if not Is_Frozen (Pname) then
- Create_Extra_Formals (Pname);
+ Create_Extra_Formals (Pname, Related_Nod => N);
end if;
-- And now rewrite the call
Set_Extra_Formal (Extra, Empty);
end if;
- Create_Extra_Formals (Subp_Typ);
+ Create_Extra_Formals (Subp_Typ, Related_Nod => N);
Set_Directly_Designated_Type (Typ, Subp_Typ);
end;
end if;
if not Is_Frozen (Entity (Pref))
or else From_Limited_With (Etype (Entity (Pref)))
then
- Create_Extra_Formals (Entity (Pref));
+ Create_Extra_Formals (Entity (Pref), Related_Nod => N);
end if;
if not Is_Frozen (Btyp_DDT)
or else From_Limited_With (Etype (Btyp_DDT))
then
- Create_Extra_Formals (Btyp_DDT);
+ Create_Extra_Formals (Btyp_DDT, Related_Nod => N);
end if;
pragma Assert
Elmt := First_Elmt (Primitive_Operations (Typ));
while Present (Elmt) loop
- Create_Extra_Formals (Node (Elmt));
+ Create_Extra_Formals (Node (Elmt), Related_Nod => N);
Next_Elmt (Elmt);
end loop;
and then Find_Dispatching_Type (E) = Typ
and then not Contains (Primitive_Operations (Typ), E)
then
- Create_Extra_Formals (E);
+ Create_Extra_Formals (E, Related_Nod => N);
end if;
Next_Entity (E);
-- of init procs were added when they were built.
if not Extra_Formals_Known (Subp) then
- Create_Extra_Formals (Subp);
+ Create_Extra_Formals (Subp, Related_Nod => Call_Node);
-- If the previous call to Create_Extra_Formals could not add the
-- extra formals, then we must defer adding the extra actuals of
and then Extra_Formals_Known (Subp)
and then Present (Extra_Formals (Subp))
then
- Create_Extra_Actuals (N);
+ Create_Extra_Actuals (Call_Node);
-- Mark the call as an expanded build-in-place call; required
-- to avoid adding the extra formals twice.
null;
elsif not Defer_Extra_Actuals then
- Create_Extra_Formals (Subp);
+ Create_Extra_Formals (Subp, Related_Nod => Call_Node);
if Extra_Formals_Known (Subp) then
- Create_Extra_Actuals (N);
+ Create_Extra_Actuals (Call_Node);
end if;
end if;
pragma Assert (Is_Frozen (Typ));
if Extra_Formals_Known (Subp) then
- Create_Extra_Formals (Subp_Typ);
+ Create_Extra_Formals (Subp_Typ, Related_Nod => Call_Node);
-- Extra formals were previously deferred
and then Convention (Desig) /= Convention_Protected
then
Set_Is_Frozen (Desig);
- Create_Extra_Formals (Desig);
+ Create_Extra_Formals (Desig, Related_Nod => Rec);
end if;
end Check_Itype;
and then Nkind (Parent (N)) = N_Function_Call
and then not Has_Foreign_Convention (Nam)
then
- Create_Extra_Formals (Nam);
+ Create_Extra_Formals (Nam, Related_Nod => N);
end if;
when others =>
-- Separate spec is not present
if No (Spec_Id) then
- Create_Extra_Formals (Body_Id);
+ Create_Extra_Formals (Body_Id, Related_Nod => N);
-- Separate spec is present; deal with freezing issues
and then Is_Build_In_Place_Function (Spec_Id)
and then not Has_BIP_Formals (Spec_Id)
then
- Create_Extra_Formals (Spec_Id);
+ Create_Extra_Formals (Spec_Id, Related_Nod => N);
pragma Assert (not Expander_Active
or else Extra_Formals_Known (Spec_Id));
Compute_Returns_By_Ref (Spec_Id);
and then Serious_Errors_Detected = 0
then
Set_Has_Delayed_Freeze (Spec_Id);
- Create_Extra_Formals (Spec_Id);
+ Create_Extra_Formals (Spec_Id, Related_Nod => N);
Freeze_Before (N, Spec_Id);
end if;
end if;
-- Create_Extra_Formals --
--------------------------
- procedure Create_Extra_Formals (E : Entity_Id) is
+ procedure Create_Extra_Formals
+ (E : Entity_Id;
+ Related_Nod : Node_Id := Empty)
+ is
First_Extra : Entity_Id := Empty;
Formal : Entity_Id;
Last_Extra : Entity_Id := Empty;
use Deferred_Extra_Formals_Support;
Can_Be_Deferred : constant Boolean :=
- not Is_Unsupported_Extra_Formals_Entity (E);
+ not Is_Unsupported_Extra_Formals_Entity (E,
+ Related_Nod);
Alias_Formal : Entity_Id := Empty;
Alias_Subp : Entity_Id := Empty;
Formal_Type : Entity_Id;
pragma Assert (Is_Generic_Instance (E)
= Is_Generic_Instance (Ultimate_Alias (E)));
- Create_Extra_Formals (Ultimate_Alias (E));
+ Create_Extra_Formals (Ultimate_Alias (E), Related_Nod);
pragma Assert (not Expander_Active
or else Extra_Formals_Known (Ultimate_Alias (E)));
-- function Parent_Subprogram).
if Ultimate_Alias (Parent_Subp) /= Ref_E then
- Create_Extra_Formals (Parent_Subp);
+ Create_Extra_Formals (Parent_Subp, Related_Nod);
end if;
Parent_Formal := First_Formal (Parent_Subp);
-- Ensure that the ultimate alias has all its extra formals
elsif Present (Alias_Subp) then
- Create_Extra_Formals (Alias_Subp);
+ Create_Extra_Formals (Alias_Subp, Related_Nod);
Alias_Formal := First_Formal (Alias_Subp);
end if;
-- formals of the enclosing scope are available before
-- adding the extra actuals of this call.
- Create_Extra_Formals (Scop_Id);
- Create_Extra_Formals (Call_Id);
+ Create_Extra_Formals (Scop_Id, Related_Nod => Call_Node);
+ Create_Extra_Formals (Call_Id, Related_Nod => Call_Node);
pragma Assert (Extra_Formals_Known (Scop_Id));
pragma Assert (Extra_Formals_Known (Call_Id));
is
Comp_Unit : constant Entity_Id :=
Cunit_Entity (Get_Source_Unit (Call_Node));
+
begin
- return not Underlying_Types_Available (Id)
+ return Expander_Active
+ and then not Extra_Formals_Known (Id)
+ and then not Underlying_Types_Available (Id)
and then Is_Compilation_Unit (Comp_Unit)
and then Ekind (Comp_Unit) in E_Package
| E_Package_Body
-- (AI05-0151-1/08).
function Is_Unsupported_Extra_Formals_Entity
- (Id : Entity_Id) return Boolean
+ (Id : Entity_Id;
+ Related_Nod : Node_Id := Empty) return Boolean
is
+ Ref_Node : constant Node_Id := (if Present (Related_Nod) then
+ Related_Nod
+ else Id);
Comp_Unit : constant Entity_Id :=
- Cunit_Entity (Get_Source_Unit (Id));
+ Cunit_Entity (Get_Source_Unit (Ref_Node));
begin
- return not Underlying_Types_Available (Id)
+ return Expander_Active
+ and then not Extra_Formals_Known (Id)
+ and then not Underlying_Types_Available (Id)
and then Is_Compilation_Unit (Comp_Unit)
and then Ekind (Comp_Unit) in E_Package_Body
| E_Subprogram_Body;
-- True when this is a check against a formal access-to-subprogram type,
-- indicating that mapping of types is needed.
- procedure Create_Extra_Formals (E : Entity_Id);
+ procedure Create_Extra_Formals
+ (E : Entity_Id;
+ Related_Nod : Node_Id := Empty);
-- For each parameter of a subprogram or entry that requires an additional
-- formal (such as for access parameters and indefinite discriminated
-- parameters), creates the appropriate formal and attach it to its
-- associated parameter. Each extra formal will also be appended to
-- the end of Subp's parameter list (with each subsequent extra formal
-- being attached to the preceding extra formal).
+ --
+ -- Related_Nod is the node motivating the frontend call to create the
+ -- extra formals; it is not passed when the node causing the call is E
+ -- (for example, as part of freezing E). Related_Nod provides the context
+ -- where the extra formals are created, and it is used to determine if
+ -- the creation of the extra formals can be deferred when the underlying
+ -- type of some formal (or its return type) is not available, and thus
+ -- improve the support for AI05-0151-1/08.
function Extra_Formals_Match_OK
(E : Entity_Id;
-- been registered to defer the addition of its extra formals.
function Is_Unsupported_Extra_Formals_Entity
- (Id : Entity_Id) return Boolean;
+ (Id : Entity_Id;
+ Related_Nod : Node_Id := Empty) return Boolean;
-- Id is a subprogram, subprogram type, or entry. Return True if Id is
-- unsupported for deferring the addition of its extra formals; that is,
-- it is defined in a compilation unit that is a package body or a
-- subprogram body, and the underlying type of some of its parameters
- -- or result type is not available.
+ -- or result type is not available. Related_Nod is the node where this
+ -- check is performed (it is generally a subprogram call); if it is not
+ -- available then the location of entity Id is used as its related node.
--
-- The context for this case is an unsupported case of AI05-0151-1/08
-- that allows incomplete tagged types as parameter and result types.
projects / thirdparty / gcc.git / commitdiff
