From: Javier Miranda <mira...@adacore.com>
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.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/exp_attr.adb | 8 ++++----
gcc/ada/exp_ch3.adb | 4 ++--
gcc/ada/exp_ch6.adb | 8 ++++----
gcc/ada/exp_disp.adb | 2 +-
gcc/ada/freeze.adb | 4 ++--
gcc/ada/sem_ch6.adb | 41 +++++++++++++++++++++++++++--------------
gcc/ada/sem_ch6.ads | 19 ++++++++++++++++---
7 files changed, 56 insertions(+), 30 deletions(-)
diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index 4bc6006454b..4eb0a6720f7 100644
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -2171,7 +2171,7 @@ package body Exp_Attr is
-- 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
@@ -2648,7 +2648,7 @@ package body Exp_Attr is
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;
@@ -2679,13 +2679,13 @@ package body Exp_Attr is
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
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index e83b0e392db..c6ef88faca2 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -6592,7 +6592,7 @@ package body Exp_Ch3 is
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;
@@ -6609,7 +6609,7 @@ package body Exp_Ch3 is
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);
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index 19812ad7cc1..a7b694270d8 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -4716,7 +4716,7 @@ package body Exp_Ch6 is
-- 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
@@ -4785,7 +4785,7 @@ package body Exp_Ch6 is
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.
@@ -5228,10 +5228,10 @@ package body Exp_Ch6 is
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;
diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb
index 1c09e204275..0f6bef17ecf 100644
--- a/gcc/ada/exp_disp.adb
+++ b/gcc/ada/exp_disp.adb
@@ -971,7 +971,7 @@ package body Exp_Disp is
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
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index 2ebffff7a5f..f383b57ae23 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -5180,7 +5180,7 @@ package body Freeze is
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;
@@ -8786,7 +8786,7 @@ package body Freeze is
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 =>
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 55c5e026ea0..a427c7a86b0 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -3864,7 +3864,7 @@ package body Sem_Ch6 is
-- 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
@@ -3883,7 +3883,7 @@ package body Sem_Ch6 is
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);
@@ -3933,7 +3933,7 @@ package body Sem_Ch6 is
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;
@@ -8550,7 +8550,10 @@ package body Sem_Ch6 is
-- 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;
@@ -8824,7 +8827,8 @@ package body Sem_Ch6 is
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;
@@ -8907,7 +8911,7 @@ package body Sem_Ch6 is
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)));
@@ -9080,7 +9084,7 @@ package body Sem_Ch6 is
-- 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);
@@ -9115,7 +9119,7 @@ package body Sem_Ch6 is
-- 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;
@@ -13114,8 +13118,8 @@ package body Sem_Ch6 is
-- 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));
@@ -13288,8 +13292,11 @@ package body Sem_Ch6 is
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
@@ -13308,12 +13315,18 @@ package body Sem_Ch6 is
-- (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;
diff --git a/gcc/ada/sem_ch6.ads b/gcc/ada/sem_ch6.ads
index 4ef5b654bb0..3c6de705097 100644
--- a/gcc/ada/sem_ch6.ads
+++ b/gcc/ada/sem_ch6.ads
@@ -160,13 +160,23 @@ package Sem_Ch6 is
-- 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;
@@ -432,12 +442,15 @@ package Sem_Ch6 is
-- 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.
--
2.43.0
