From: Ronan Desplanques <[email protected]>
Before this patch, In_Package_Body had two different meanings depending
on whether it was applied to a package or to some other entity. This
extracts the second meaning to a new field, Declared_In_Package_Body, and
ties the maintenance of this field to the Scope field, which actually
becomes a thin wrapper over a new internal Gen_IL field.
A new Gen_IL contract is added to help enforce that In_Package_Body is
now only used with package entities.
One might wonder why the conceptually similar In_Private_Part field is
not given the same treatment. One reason is that it has combined the two
different meanings for much longer than In_Package_Body has, so it's much
more work to categorize the call sites. One other reason is that a change
I have in my pipeline is made possible by just this change to
In_Package_Body.
Also update all call sites that previously used Is_Package_Body_Entity to
use the new Declared_In_Package_Body field, remove Is_Package_Body_Entity,
and make print_node display Scope instead of the internal
Scope_Gen_IL_Private field.
gcc/ada/ChangeLog:
* gen_il-fields.ads (Declared_In_Package_Body): New field.
(Scope): Rename into...
(Scope_Gen_IL_Private): ...this.
* einfo-utils.ads (Scope, Set_Scope): New subprograms.
* einfo-utils.adb (Set_Scope): New subprogram.
* einfo.ads (In_Package_Body): Update documentation.
(Declared_In_Package_Body): Add documentation.
(Is_Package_Body_Entity): Remove.
* fe.h (Scope): New macro.
* gen_il-gen-gen_entities.adb (Gen_Entities): New field.
New contract. Remove Sm (Is_Package_Body_Entity).
* gen_il-gen-gen_nodes.adb (Gen_Nodes): Adapt to renaming.
* gen_il-gen.adb (Compute_Field_Offsets): Adapt to renaming.
* gen_il-internals.adb (Image): Adapt to renaming.
* lib-load.adb, lib.adb: Add with clauses.
* sem_ch3.adb (Analyze_Object_Declaration): Remove field update.
* sem_ch6.adb (Enter_Overloaded_Entity): Likewise.
* sem_util.adb (Collect_Primitive_Operations): Use new field.
(Enter_Name): Replace Is_Package_Body_Entity with
Declared_In_Package_Body.
* treepr.adb (Image): Add F_Scope_Gen_IL_Private alternative
that returns Scope.
* exp_dbug.adb (Is_BNPE): Replace Is_Package_Body_Entity with
Declared_In_Package_Body.
* sem_ch12.adb (Check_Generic_Actuals): Likewise.
* sem_warn.adb (Generic_Package_Spec_Entity): Likewise.
* sem_ch7.adb (Analyze_Package_Body_Helper): Replace
Set_Is_Package_Body_Entity with Set_Declared_In_Package_Body.
Co-Authored-By: Mathias Aparicio <[email protected]>
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/einfo-utils.adb | 16 ++++++++++++++++
gcc/ada/einfo-utils.ads | 6 ++++++
gcc/ada/einfo.ads | 27 ++++++++++++++++-----------
gcc/ada/exp_dbug.adb | 2 +-
gcc/ada/fe.h | 3 +++
gcc/ada/gen_il-fields.ads | 4 ++--
gcc/ada/gen_il-gen-gen_entities.adb | 6 ++++--
gcc/ada/gen_il-gen-gen_nodes.adb | 2 +-
gcc/ada/gen_il-gen.adb | 4 ++--
gcc/ada/gen_il-internals.adb | 2 ++
gcc/ada/lib-load.adb | 1 +
gcc/ada/lib.adb | 1 +
gcc/ada/sem_ch12.adb | 2 +-
gcc/ada/sem_ch3.adb | 3 +--
gcc/ada/sem_ch6.adb | 3 +--
gcc/ada/sem_ch7.adb | 8 --------
gcc/ada/sem_util.adb | 5 +++--
gcc/ada/sem_warn.adb | 2 +-
gcc/ada/treepr.adb | 4 +++-
19 files changed, 65 insertions(+), 36 deletions(-)
diff --git a/gcc/ada/einfo-utils.adb b/gcc/ada/einfo-utils.adb
index d50956db69b..10e56966074 100644
--- a/gcc/ada/einfo-utils.adb
+++ b/gcc/ada/einfo-utils.adb
@@ -3201,6 +3201,22 @@ package body Einfo.Utils is
end if;
end Set_Is_Volatile;
+ ----------------
+ -- Set_Scope --
+ ----------------
+
+ procedure Set_Scope (N : N_Entity_Id; Val : Node_Id) is
+ begin
+ Set_Scope_Raw (N, Val);
+
+ -- Child units may appear on the entity list (e.g. if they appear
+ -- in the context of a subunit) but they are not body entities.
+
+ if Present (Val) and then not Is_Child_Unit (N) then
+ Set_Declared_In_Package_Body (N, In_Package_Body (Val));
+ end if;
+ end Set_Scope;
+
-----------------------
-- Write_Entity_Info --
-----------------------
diff --git a/gcc/ada/einfo-utils.ads b/gcc/ada/einfo-utils.ads
index f7a8fc4cc24..e5a01e34bc9 100644
--- a/gcc/ada/einfo-utils.ads
+++ b/gcc/ada/einfo-utils.ads
@@ -563,6 +563,12 @@ package Einfo.Utils is
-- Also, if the Etype of E is set and is an anonymous access type with
-- no convention set, this anonymous type inherits the convention of E.
+ function Scope
+ (N : N_Entity_Id) return Node_Id renames Scope_Raw;
+ procedure Set_Scope (N : N_Entity_Id; Val : Node_Id);
+ -- Same as Set_Scope_Raw, but set Declared_In_Package_Body if Val is a
+ -- package currently being analyzed
+
----------------------------------
-- Debugging Output Subprograms --
----------------------------------
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index abd7398562f..960f39004ab 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -833,6 +833,14 @@ package Einfo is
-- to the renamed entity. See Exp_Dbug.Debug_Renaming_Declaration for
-- details of the use of this field.
+-- Declared_In_Package_Body
+-- Defined in all entities. Set if the declaration of the entity is
+-- immediately enclosed by a package body. This is (perhaps
+-- unfortunately) not the same thing as "Ekind (Scope (E)) =
+-- E_Package_Body": an entity declared in a package body has its Scope
+-- field pointing to the corresponding package spec (of Ekind
+-- E_Package).
+
-- Declaration_Node (synthesized)
-- Applies to all entities. Returns the tree node for the construct that
-- declared the entity. Normally this is just the Parent of the entity.
@@ -2300,12 +2308,14 @@ package Einfo is
-- to multiple subprogram entities).
-- In_Package_Body
--- Defined in all entities. Can be set only in package entities, objects
--- and overloadable entities. For package entities, this flag is set to
--- indicate that the body of the package is being analyzed. The flag is
--- reset at the end of the package body. For objects and overloadable
--- entities, indicates that the declaration of the entity occurs in the
--- body of a package.
+-- Defined in all entities. Can only be set in package entities. This
+-- flag is set to indicate that the body of the package is being
+-- analyzed. The flag is reset at the end of the package body. The reason
+-- why In_Package_Body is defined in all entities and not just packages
+-- is so In_Package_Body (E) is a convenient abbreviation of
+-- Ekind (E) in E_Package | E_Generic_Package and then
+-- In_Package_Body (E)
+-- .
-- In_Private_Part
-- Defined in all entities. Can be set only in package entities, objects
@@ -3150,10 +3160,6 @@ package Einfo is
-- Applies to all entities, true for ordinary fixed point types and
-- subtypes.
--- Is_Package_Body_Entity
--- Defined in all entities. Set for entities defined at the top level
--- of a package body. Used to control externally generated names.
-
-- Is_Package_Or_Generic_Package (synthesized)
-- Applies to all entities. True for packages and generic packages.
-- False for all other entities.
@@ -5047,7 +5053,6 @@ package Einfo is
-- Is_Link_Once
-- Is_Loop_Parameter
-- Is_Obsolescent
- -- Is_Package_Body_Entity
-- Is_Packed_Array_Impl_Type
-- Is_Not_Self_Hidden
-- Is_Potentially_Use_Visible
diff --git a/gcc/ada/exp_dbug.adb b/gcc/ada/exp_dbug.adb
index acbd5146889..023b10ebbb9 100644
--- a/gcc/ada/exp_dbug.adb
+++ b/gcc/ada/exp_dbug.adb
@@ -1324,7 +1324,7 @@ package body Exp_Dbug is
function Is_BNPE (S : Entity_Id) return Boolean is
begin
- return Ekind (S) = E_Package and then Is_Package_Body_Entity (S);
+ return Ekind (S) = E_Package and then Declared_In_Package_Body (S);
end Is_BNPE;
--------------------
diff --git a/gcc/ada/fe.h b/gcc/ada/fe.h
index 31f4f13eca6..cb2a30ba027 100644
--- a/gcc/ada/fe.h
+++ b/gcc/ada/fe.h
@@ -535,6 +535,9 @@ extern Node_Id Renamed_Entity (N Node);
#define Renamed_Object einfo__entities__renamed_or_alias
extern Node_Id Renamed_Object (N Node);
+#define Scope sinfo__nodes__scope_raw
+extern Node_Id Scope (N Node);
+
#ifdef __cplusplus
}
#endif
diff --git a/gcc/ada/gen_il-fields.ads b/gcc/ada/gen_il-fields.ads
index e354b242427..93cfd85ed22 100644
--- a/gcc/ada/gen_il-fields.ads
+++ b/gcc/ada/gen_il-fields.ads
@@ -381,7 +381,7 @@ package Gen_IL.Fields is
SCIL_Entity,
SCIL_Tag_Value,
SCIL_Target_Prim,
- Scope,
+ Scope_Raw,
Scope_Link,
Select_Alternatives,
Selector_Name,
@@ -488,6 +488,7 @@ package Gen_IL.Fields is
Current_Value,
Debug_Info_Off,
Debug_Renaming_Link,
+ Declared_In_Package_Body,
Default_Aspect_Component_Value,
Default_Aspect_Value,
Default_Expressions_Processed,
@@ -766,7 +767,6 @@ package Gen_IL.Fields is
Is_Null_Init_Proc,
Is_Obsolescent,
Is_Only_Out_Parameter,
- Is_Package_Body_Entity,
Is_Packed,
Is_Packed_Array_Impl_Type,
Is_Not_Self_Hidden,
diff --git a/gcc/ada/gen_il-gen-gen_entities.adb
b/gcc/ada/gen_il-gen-gen_entities.adb
index 6d94315031d..4b73c011b2e 100644
--- a/gcc/ada/gen_il-gen-gen_entities.adb
+++ b/gcc/ada/gen_il-gen-gen_entities.adb
@@ -54,6 +54,7 @@ begin -- Gen_IL.Gen.Gen_Entities
Sm (Associated_Entity, Node_Id),
Sm (Can_Never_Be_Null, Flag),
Sm (Checks_May_Be_Suppressed, Flag),
+ Sm (Declared_In_Package_Body, Flag),
Sm (Debug_Info_Off, Flag),
Sm (Default_Expressions_Processed, Flag),
Sm (Delay_Cleanups, Flag),
@@ -116,7 +117,9 @@ begin -- Gen_IL.Gen.Gen_Entities
Sm (Has_Yield_Aspect, Flag),
Sm (Homonym, Node_Id),
Sm (Incomplete_View, Node_Id),
- Sm (In_Package_Body, Flag),
+ Sm (In_Package_Body,
+ Flag,
+ Pre_Set => "Ekind (N) in E_Package | E_Generic_Package"),
Sm (In_Private_Part, Flag),
Sm (In_Use, Flag),
Sm (Is_Ada_2005_Only, Flag),
@@ -179,7 +182,6 @@ begin -- Gen_IL.Gen.Gen_Entities
Sm (Is_Link_Once, Flag),
Sm (Is_Loop_Parameter, Flag),
Sm (Is_Obsolescent, Flag),
- Sm (Is_Package_Body_Entity, Flag),
Sm (Is_Packed, Flag, Impl_Base_Type_Only),
Sm (Is_Packed_Array_Impl_Type, Flag),
Sm (Is_Not_Self_Hidden, Flag),
diff --git a/gcc/ada/gen_il-gen-gen_nodes.adb b/gcc/ada/gen_il-gen-gen_nodes.adb
index 09438f44a0c..35c860db063 100644
--- a/gcc/ada/gen_il-gen-gen_nodes.adb
+++ b/gcc/ada/gen_il-gen-gen_nodes.adb
@@ -135,7 +135,7 @@ begin -- Gen_IL.Gen.Gen_Nodes
Ab (N_Entity, N_Has_Etype,
(Sy (Chars, Name_Id, Default_No_Name),
Sm (Next_Entity, Node_Id),
- Sm (Scope, Node_Id)));
+ Sm (Scope_Raw, Node_Id)));
Cc (N_Defining_Character_Literal, N_Entity);
Cc (N_Defining_Identifier, N_Entity);
diff --git a/gcc/ada/gen_il-gen.adb b/gcc/ada/gen_il-gen.adb
index 98e95ebefe9..8912ecd2806 100644
--- a/gcc/ada/gen_il-gen.adb
+++ b/gcc/ada/gen_il-gen.adb
@@ -1212,8 +1212,8 @@ package body Gen_IL.Gen is
pragma Assert (Field_Table (Is_Potentially_Use_Visible).Offset = 18);
Choose_Offset (Is_Generic_Instance);
pragma Assert (Field_Table (Is_Generic_Instance).Offset = 19);
- Choose_Offset (Scope);
- pragma Assert (Field_Table (Scope).Offset = 2);
+ Choose_Offset (Scope_Raw);
+ pragma Assert (Field_Table (Scope_Raw).Offset = 2);
-- Then loop through them all, skipping the ones we did above
diff --git a/gcc/ada/gen_il-internals.adb b/gcc/ada/gen_il-internals.adb
index a00322e59be..d425ec344b1 100644
--- a/gcc/ada/gen_il-internals.adb
+++ b/gcc/ada/gen_il-internals.adb
@@ -341,6 +341,8 @@ package body Gen_IL.Internals is
return "SCIL_Tag_Value";
when SCIL_Target_Prim =>
return "SCIL_Target_Prim";
+ when Scope_Raw =>
+ return "Scope_Raw";
when Shift_Count_OK =>
return "Shift_Count_OK";
when SPARK_Aux_Pragma =>
diff --git a/gcc/ada/lib-load.adb b/gcc/ada/lib-load.adb
index f5c82bbfb90..311917e0e3c 100644
--- a/gcc/ada/lib-load.adb
+++ b/gcc/ada/lib-load.adb
@@ -27,6 +27,7 @@ with Atree; use Atree;
with Debug; use Debug;
with Einfo; use Einfo;
with Einfo.Entities; use Einfo.Entities;
+with Einfo.Utils; use Einfo.Utils;
with Errout; use Errout;
with Fname; use Fname;
with Fname.UF; use Fname.UF;
diff --git a/gcc/ada/lib.adb b/gcc/ada/lib.adb
index bb0b297f6cb..4b7b95479e5 100644
--- a/gcc/ada/lib.adb
+++ b/gcc/ada/lib.adb
@@ -30,6 +30,7 @@ pragma Style_Checks (All_Checks);
with Atree; use Atree;
with Csets; use Csets;
with Einfo.Entities; use Einfo.Entities;
+with Einfo.Utils; use Einfo.Utils;
with Nlists; use Nlists;
with Opt; use Opt;
with Output; use Output;
diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index 79d5e6f0aed..3f3f208a65e 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -8506,7 +8506,7 @@ package body Sem_Ch12 is
if Curr = Outer then
return True;
- elsif Is_Package_Body_Entity (Curr) then
+ elsif Declared_In_Package_Body (Curr) then
Curr := Scope (Curr);
else
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 1ada2512377..3cbef0c1819 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -5480,10 +5480,9 @@ package body Sem_Ch3 is
Check_Eliminated (Id);
- -- Deal with setting In_Package_Body and In_Private_Part flags
+ -- Deal with setting In_Private_Part flag
if Ekind (Scope (Id)) = E_Package then
- Set_In_Package_Body (Id, In_Package_Body (Scope (Id)));
Set_In_Private_Part (Id, In_Private_Part (Scope (Id)));
end if;
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 338c798d874..dab3b9ac41c 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -9703,10 +9703,9 @@ package body Sem_Ch6 is
Append_Entity (S, Scope (S));
end if;
- -- Deal with setting In_Package_Body and In_Private_Part flags
+ -- Deal with setting In_Private_Part flag
if Ekind (Scope (S)) = E_Package then
- Set_In_Package_Body (S, In_Package_Body (Scope (S)));
Set_In_Private_Part (S, In_Private_Part (Scope (S)));
end if;
diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb
index 1b9d5f848c7..90f851e57ab 100644
--- a/gcc/ada/sem_ch7.adb
+++ b/gcc/ada/sem_ch7.adb
@@ -1084,14 +1084,6 @@ package body Sem_Ch7 is
Set_Is_Immediately_Visible (E, False);
Set_Is_Potentially_Use_Visible (E, False);
Set_Is_Hidden (E);
-
- -- Child units may appear on the entity list (e.g. if they appear
- -- in the context of a subunit) but they are not body entities.
-
- if not Is_Child_Unit (E) then
- Set_Is_Package_Body_Entity (E);
- end if;
-
Next_Entity (E);
end loop;
end;
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index e027e5afb70..87fec5394be 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -5891,7 +5891,8 @@ package body Sem_Util is
-- predefined "=" operator.
if Is_Overloadable (Id)
- and then ((Is_Type_In_Pkg and then not In_Package_Body (Id))
+ and then ((Is_Type_In_Pkg
+ and then not Declared_In_Package_Body (Id))
or else Is_Primitive (Id)
or else not Comes_From_Source (Id))
@@ -8260,7 +8261,7 @@ package body Sem_Util is
-- parent spec, and body entities are not visible.
elsif Is_Child_Unit (Def_Id)
- and then Is_Package_Body_Entity (E)
+ and then Declared_In_Package_Body (E)
and then not In_Package_Body (Current_Scope)
then
null;
diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb
index a1d421898df..d1f83d3080d 100644
--- a/gcc/ada/sem_warn.adb
+++ b/gcc/ada/sem_warn.adb
@@ -2872,7 +2872,7 @@ package body Sem_Warn is
S : Entity_Id;
begin
- if Is_Package_Body_Entity (E) then
+ if Declared_In_Package_Body (E) then
return False;
else
diff --git a/gcc/ada/treepr.adb b/gcc/ada/treepr.adb
index 65c6585adcf..d8842588c4d 100644
--- a/gcc/ada/treepr.adb
+++ b/gcc/ada/treepr.adb
@@ -270,7 +270,7 @@ package body Treepr is
begin
case F is
-- We special case the following; otherwise the compiler will use
- -- the usual Mixed_Case convention.
+ -- the usual Mixed_Case convention or we override the name entirely.
when F_Assignment_OK =>
return "Assignment_OK";
@@ -300,6 +300,8 @@ package body Treepr is
return "SCIL_Tag_Value";
when F_SCIL_Target_Prim =>
return "SCIL_Target_Prim";
+ when F_Scope_Raw =>
+ return "Scope";
when F_Shift_Count_OK =>
return "Shift_Count_OK";
when F_TSS_Elist =>
--
2.53.0
