https://gcc.gnu.org/g:ee300d9d3c2b4c2406bbf34621f8ee05129cdd19
commit r17-1647-gee300d9d3c2b4c2406bbf34621f8ee05129cdd19 Author: Ronan Desplanques <[email protected]> Date: Tue Apr 14 09:02:45 2026 +0200 ada: Rework In_Package_Body field 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]> Diff: --- 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 d50956db69b9..10e56966074d 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 f7a8fc4cc24c..e5a01e34bc95 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 abd7398562f3..960f39004ab9 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 acbd51468894..023b10ebbb94 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 31f4f13eca6a..cb2a30ba027b 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 e354b242427d..93cfd85ed220 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 6d94315031d6..4b73c011b2e5 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 09438f44a0cb..35c860db063a 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 98e95ebefe92..8912ecd28068 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 a00322e59be0..d425ec344b18 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 f5c82bbfb906..311917e0e3c8 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 bb0b297f6cb8..4b7b95479e51 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 79d5e6f0aed7..3f3f208a65e1 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 1ada25123776..3cbef0c18194 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 338c798d8742..dab3b9ac41c9 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 1b9d5f848c7a..90f851e57abb 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 e027e5afb70c..87fec5394be3 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 a1d421898df8..d1f83d3080d6 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 65c6585adcfc..d8842588c4d2 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 =>
