public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc r14-4024] ada: Clean up scope depth and related code (tech debt)
@ 2023-09-15 13:04 Marc Poulhi?s
0 siblings, 0 replies; only message in thread
From: Marc Poulhi?s @ 2023-09-15 13:04 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:553c37bedcfb04f52237ef3cdd2a19747c61cde1
commit r14-4024-g553c37bedcfb04f52237ef3cdd2a19747c61cde1
Author: Bob Duff <duff@adacore.com>
Date: Tue Sep 5 14:40:22 2023 -0400
ada: Clean up scope depth and related code (tech debt)
The main point of this patch is to remove the special case
for Atree.F_Scope_Depth_Value in the Assert that Field_Present
in Get_Field_Value. Pulling on that thread leads to lots
of related cleanup.
gcc/ada/ChangeLog:
* atree.adb (Node_Kind_Table): Specify parameter explicitly in
GNAT.Table instantiations. Use fully qualified references instead
of relying on use clauses.
(Get_Field_Value): Remove special case for F_Scope_Depth_Value.
That is, enable the Field_Present check in that case.
(It was already enabled for all other fields.) Violations of this
check were already fixed.
(Print_Node_Statistics): Sort the output in decreasing order of
frequencies.
(Print_Field_Statistics): Likewise (sort).
* accessibility.adb (Accessibility_Level): Pass Allow_Alt_Model in
recursive calls. Apparently, an oversight.
(Innermost_Master_Scope_Depth): Need to special-case the 'Old
attribute and allocators.
* einfo-utils.ads (Scope_Depth): Use Scope_Kind_Id to get
predicate checks.
(Scope_Depth_Set): Likewise.
(Scope_Depth_Default_0): Likewise.
* einfo-utils.adb: As for spec.
* frontend.adb (Frontend): Remove unnecessary "return;".
* gen_il-types.ads (Scope_Kind): New union type.
* gen_il-gen-gen_entities.adb (Scope_Kind): New union type.
* sem.ads: Move "with Einfo.Entities;" from body to spec.
(Scope_Stack_Entry): Declare Entity to be of Scope_Kind_Id to get
predicate checks. We had previously been putting non-scopes on the
scope stack; this prevents such anomalies.
* sem.adb: Move "with Einfo.Entities;" from body to spec.
* sem_ch8.ads: Move "with Einfo.Entities;" from body to spec. Add
"with Types;".
(Push_Scope): Use Scope_Kind_Id to get predicate checks.
* sem_ch8.adb: Move "with Einfo.Entities;" from body to spec. Add
"with Types;".
(Push_Scope): Use Scope_Kind_Id to get predicate checks.
(Pop_Scope): Use Scope_Kind_Id on popped entity to get predicate
checks. This prevents anomalies where a scope pushed onto the
stack is later mutated to a nonscope before being popped.
* sem_util.ads (Find_Enclosing_Scope): Add postcondition to ensure
that the enclosing scope of a node N is not the same node N.
Clearly, N does not enclose itself.
* sem_util.adb (Find_Enclosing_Scope): There were several bugs
where Find_Enclosing_Scope(N) = N. For example, if N is an entity,
then we would typically go up to its declaration, and then back
down to the Defining_Entity of the declaration, which is N itself.
There were other cases where Find_Enclosing_Scope of an entity
disagreed with Scope. Clearly, Find_Enclosing_Scope and Scope
should agree (when both are defined). Such bugs caused latent bugs
in accessibility.adb related to 'Old, and fixing bugs here caused
such bugs to be revealed. These are fixed by calling Scope when N
is an entity.
Co-authored-by: Ronan Desplanques <desplanques@adacore.com>
Diff:
---
gcc/ada/accessibility.adb | 38 ++++---
gcc/ada/atree.adb | 210 +++++++++++++++++++++++++++---------
gcc/ada/einfo-utils.adb | 6 +-
gcc/ada/einfo-utils.ads | 6 +-
gcc/ada/frontend.adb | 2 -
gcc/ada/gen_il-gen-gen_entities.adb | 27 +++++
gcc/ada/gen_il-types.ads | 1 +
gcc/ada/sem.adb | 1 -
gcc/ada/sem.ads | 3 +-
gcc/ada/sem_ch8.adb | 5 +-
gcc/ada/sem_ch8.ads | 5 +-
gcc/ada/sem_util.adb | 8 +-
gcc/ada/sem_util.ads | 3 +-
13 files changed, 231 insertions(+), 84 deletions(-)
diff --git a/gcc/ada/accessibility.adb b/gcc/ada/accessibility.adb
index bc897d1ef18..bc217bef703 100644
--- a/gcc/ada/accessibility.adb
+++ b/gcc/ada/accessibility.adb
@@ -119,8 +119,9 @@ package body Accessibility is
is
Loc : constant Source_Ptr := Sloc (Expr);
- function Accessibility_Level (Expr : Node_Id) return Node_Id
- is (Accessibility_Level (Expr, Level, In_Return_Context));
+ function Accessibility_Level (Expr : Node_Id) return Node_Id is
+ (Accessibility_Level
+ (Expr, Level, In_Return_Context, Allow_Alt_Model));
-- Renaming of the enclosing function to facilitate recursive calls
function Make_Level_Literal (Level : Uint) return Node_Id;
@@ -164,7 +165,19 @@ package body Accessibility is
Ent := Defining_Entity_Or_Empty (Node_Par);
if Present (Ent) then
- Encl_Scop := Find_Enclosing_Scope (Ent);
+ -- X'Old is nested within the current subprogram, so we do not
+ -- want Find_Enclosing_Scope of that subprogram. If this is an
+ -- allocator, then we're looking for the innermost master of
+ -- the call, so again we do not want Find_Enclosing_Scope.
+
+ if (Nkind (N) = N_Attribute_Reference
+ and then Attribute_Name (N) = Name_Old)
+ or else Nkind (N) = N_Allocator
+ then
+ Encl_Scop := Ent;
+ else
+ Encl_Scop := Find_Enclosing_Scope (Ent);
+ end if;
-- Ignore transient scopes made during expansion while also
-- taking into account certain expansions - like iterators
@@ -177,17 +190,13 @@ package body Accessibility is
then
-- Note that in some rare cases the scope depth may not be
-- set, for example, when we are in the middle of analyzing
- -- a type and the enclosing scope is said type. So, instead,
- -- continue to move up the parent chain since the scope
- -- depth of the type's parent is the same as that of the
- -- type.
-
- if not Scope_Depth_Set (Encl_Scop) then
- pragma Assert (Nkind (Parent (Encl_Scop))
- = N_Full_Type_Declaration);
+ -- a type and the enclosing scope is said type. In that case
+ -- simply return zero for the outermost scope.
+
+ if Scope_Depth_Set (Encl_Scop) then
+ return Scope_Depth (Encl_Scop) + Master_Lvl_Modifier;
else
- return
- Scope_Depth (Encl_Scop) + Master_Lvl_Modifier;
+ return Uint_0;
end if;
end if;
@@ -424,7 +433,7 @@ package body Accessibility is
when N_Aggregate =>
return Make_Level_Literal (Innermost_Master_Scope_Depth (Expr));
- -- The accessibility level is that of the access type, except for an
+ -- The accessibility level is that of the access type, except for
-- anonymous allocators which have special rules defined in RM 3.10.2
-- (14/3).
@@ -472,6 +481,7 @@ package body Accessibility is
and then Present (Get_Dynamic_Accessibility (Entity (Pre)))
and then Level = Dynamic_Level
then
+ pragma Assert (Is_Anonymous_Access_Type (Etype (Pre)));
return New_Occurrence_Of
(Get_Dynamic_Accessibility (Entity (Pre)), Loc);
diff --git a/gcc/ada/atree.adb b/gcc/ada/atree.adb
index 5597d166cdb..8e4c4437636 100644
--- a/gcc/ada/atree.adb
+++ b/gcc/ada/atree.adb
@@ -33,6 +33,8 @@ with Output; use Output;
with Sinfo.Utils; use Sinfo.Utils;
with System.Storage_Elements;
+with GNAT.Table;
+
package body Atree is
---------------
@@ -900,10 +902,7 @@ package body Atree is
function Get_Field_Value
(N : Node_Id; Field : Node_Or_Entity_Field) return Field_Size_32_Bit
is
- pragma Assert
- (if Field /= F_Scope_Depth_Value then -- ???Temporarily disable check
- Field_Checking.Field_Present (N, Field));
- -- Assert partially disabled because it fails in rare cases
+ pragma Assert (Field_Checking.Field_Present (N, Field));
Desc : Field_Descriptor renames Field_Descriptors (Field);
NN : constant Node_Or_Entity_Id := Node_To_Fetch_From (N, Field);
@@ -2889,6 +2888,34 @@ package body Atree is
Node_Counts : array (Node_Kind) of Count := (others => 0);
Entity_Counts : array (Entity_Kind) of Count := (others => 0);
+ -- We put the Node_Kinds and Entity_Kinds into a table just because
+ -- GNAT.Table has a handy sort procedure. We're sorting in decreasing
+ -- order of Node_Counts, for printing.
+
+ package Node_Kind_Table is new GNAT.Table
+ (Table_Component_Type => Node_Kind,
+ Table_Index_Type => Pos,
+ Table_Low_Bound => Pos'First,
+ Table_Initial => 8,
+ Table_Increment => 100
+ );
+ function Higher_Count (X, Y : Node_Kind) return Boolean is
+ (Node_Counts (X) > Node_Counts (Y));
+ procedure Sort_Node_Kind_Table is new
+ Node_Kind_Table.Sort_Table (Lt => Higher_Count);
+
+ package Entity_Kind_Table is new GNAT.Table
+ (Table_Component_Type => Entity_Kind,
+ Table_Index_Type => Pos,
+ Table_Low_Bound => Pos'First,
+ Table_Initial => 8,
+ Table_Increment => 100
+ );
+ function Higher_Count (X, Y : Entity_Kind) return Boolean is
+ (Entity_Counts (X) > Entity_Counts (Y));
+ procedure Sort_Entity_Kind_Table is new
+ Entity_Kind_Table.Sort_Table (Lt => Higher_Count);
+
All_Node_Offsets : Node_Offsets.Table_Type renames
Node_Offsets.Table (Node_Offsets.First .. Node_Offsets.Last);
begin
@@ -2897,6 +2924,8 @@ package body Atree is
Write_Int (Int (Slots.Last));
Write_Line (" non-header slots");
+ -- Count up the number of each kind of node and entity
+
for N in All_Node_Offsets'Range loop
declare
K : constant Node_Kind := Nkind (N);
@@ -2910,44 +2939,95 @@ package body Atree is
end;
end loop;
+ -- Copy kinds to tables, and sort:
+
for K in Node_Kind loop
- declare
- Count : constant Nat_64 := Node_Counts (K);
- begin
- Write_Int_64 (Count);
- Write_Ratio (Count, Int_64 (Node_Offsets.Last));
- Write_Str (" ");
- Write_Str (Node_Kind'Image (K));
- Write_Str (" ");
- Write_Int (Int (Sinfo.Nodes.Size (K)));
- Write_Str (" slots");
- Write_Eol;
- end;
+ Node_Kind_Table.Append (K);
end loop;
+ Sort_Node_Kind_Table;
for K in Entity_Kind loop
- declare
- Count : constant Nat_64 := Entity_Counts (K);
- begin
- Write_Int_64 (Count);
- Write_Ratio (Count, Int_64 (Node_Offsets.Last));
- Write_Str (" ");
- Write_Str (Entity_Kind'Image (K));
- Write_Str (" ");
- Write_Int (Int (Einfo.Entities.Size (K)));
- Write_Str (" slots");
- Write_Eol;
- end;
+ Entity_Kind_Table.Append (K);
end loop;
+ Sort_Entity_Kind_Table;
+
+ -- Print out the counts for each kind in decreasing order. Exit the loop
+ -- if we see a zero count, because all the rest must be zero, and the
+ -- zero ones are boring.
+
+ declare
+ use Node_Kind_Table;
+ -- Note: the full qualification of First below is needed for
+ -- bootstrap builds.
+ Table : Table_Type renames Node_Kind_Table.Table
+ (Node_Kind_Table.First .. Last);
+ begin
+ for J in Table'Range loop
+ declare
+ K : constant Node_Kind := Table (J);
+ Count : constant Nat_64 := Node_Counts (K);
+ begin
+ exit when Count = 0; -- skip the rest
+
+ Write_Int_64 (Count);
+ Write_Ratio (Count, Int_64 (Node_Offsets.Last));
+ Write_Str (" ");
+ Write_Str (Node_Kind'Image (K));
+ Write_Str (" ");
+ Write_Int (Int (Sinfo.Nodes.Size (K)));
+ Write_Str (" slots");
+ Write_Eol;
+ end;
+ end loop;
+ end;
+
+ declare
+ use Entity_Kind_Table;
+ -- Note: the full qualification of First below is needed for
+ -- bootstrap builds.
+ Table : Table_Type renames Entity_Kind_Table.Table
+ (Entity_Kind_Table.First .. Last);
+ begin
+ for J in Table'Range loop
+ declare
+ K : constant Entity_Kind := Table (J);
+ Count : constant Nat_64 := Entity_Counts (K);
+ begin
+ exit when Count = 0; -- skip the rest
+
+ Write_Int_64 (Count);
+ Write_Ratio (Count, Int_64 (Node_Offsets.Last));
+ Write_Str (" ");
+ Write_Str (Entity_Kind'Image (K));
+ Write_Str (" ");
+ Write_Int (Int (Einfo.Entities.Size (K)));
+ Write_Str (" slots");
+ Write_Eol;
+ end;
+ end loop;
+ end;
end Print_Node_Statistics;
procedure Print_Field_Statistics is
Total, G_Total, S_Total : Call_Count := 0;
+
+ -- Use a table for sorting, as done in Print_Node_Statistics.
+
+ package Field_Table is new GNAT.Table
+ (Table_Component_Type => Node_Or_Entity_Field,
+ Table_Index_Type => Pos,
+ Table_Low_Bound => Pos'First,
+ Table_Initial => 8,
+ Table_Increment => 100
+ );
+ function Higher_Count (X, Y : Node_Or_Entity_Field) return Boolean is
+ (Get_Count (X) + Set_Count (X) > Get_Count (Y) + Set_Count (Y));
+ procedure Sort_Field_Table is new
+ Field_Table.Sort_Table (Lt => Higher_Count);
begin
Write_Int_64 (Get_Original_Node_Count);
Write_Str (" + ");
Write_Int_64 (Set_Original_Node_Count);
- Write_Eol;
Write_Line (" Original_Node_Count getter and setter calls");
Write_Eol;
@@ -2970,32 +3050,55 @@ package body Atree is
Write_Int_64 (S_Total);
Write_Line (" total getter and setter calls");
- for Field in Node_Or_Entity_Field loop
- declare
- G : constant Call_Count := Get_Count (Field);
- S : constant Call_Count := Set_Count (Field);
- GS : constant Call_Count := G + S;
-
- Desc : Field_Descriptor renames Field_Descriptors (Field);
- Slot : constant Field_Offset :=
- (Field_Size (Desc.Kind) * Desc.Offset) / Slot_Size;
+ -- Copy fields to the table, and sort:
- begin
- Write_Int_64 (GS);
- Write_Ratio (GS, Total);
- Write_Str (" = ");
- Write_Int_64 (G);
- Write_Str (" + ");
- Write_Int_64 (S);
- Write_Str (" ");
- Write_Str (Node_Or_Entity_Field'Image (Field));
- Write_Str (" in slot ");
- Write_Int (Int (Slot));
- Write_Str (" size ");
- Write_Int (Int (Field_Size (Desc.Kind)));
- Write_Eol;
- end;
+ for F in Node_Or_Entity_Field loop
+ Field_Table.Append (F);
end loop;
+ Sort_Field_Table;
+
+ -- Print out the counts for each field in decreasing order of
+ -- getter+setter sum. As in Print_Node_Statistics, exit the loop
+ -- if we see a zero sum.
+
+ declare
+ use Field_Table;
+ -- Note: the full qualification of First below is needed for
+ -- bootstrap builds.
+ Table : Table_Type renames
+ Field_Table.Table (Field_Table.First .. Last);
+ begin
+ for J in Table'Range loop
+ declare
+ Field : constant Node_Or_Entity_Field := Table (J);
+
+ G : constant Call_Count := Get_Count (Field);
+ S : constant Call_Count := Set_Count (Field);
+ GS : constant Call_Count := G + S;
+
+ Desc : Field_Descriptor renames Field_Descriptors (Field);
+ Slot : constant Field_Offset :=
+ (Field_Size (Desc.Kind) * Desc.Offset) / Slot_Size;
+
+ begin
+ exit when GS = 0; -- skip the rest
+
+ Write_Int_64 (GS);
+ Write_Ratio (GS, Total);
+ Write_Str (" = ");
+ Write_Int_64 (G);
+ Write_Str (" + ");
+ Write_Int_64 (S);
+ Write_Str (" ");
+ Write_Str (Node_Or_Entity_Field'Image (Field));
+ Write_Str (" in slot ");
+ Write_Int (Int (Slot));
+ Write_Str (" size ");
+ Write_Int (Int (Field_Size (Desc.Kind)));
+ Write_Eol;
+ end;
+ end loop;
+ end;
end Print_Field_Statistics;
procedure Print_Statistics is
@@ -3003,6 +3106,7 @@ package body Atree is
Write_Eol;
Write_Eol;
Print_Node_Statistics;
+ Write_Eol;
Print_Field_Statistics;
end Print_Statistics;
diff --git a/gcc/ada/einfo-utils.adb b/gcc/ada/einfo-utils.adb
index cb9a00dc4bb..9bee1f4fb2c 100644
--- a/gcc/ada/einfo-utils.adb
+++ b/gcc/ada/einfo-utils.adb
@@ -2589,7 +2589,7 @@ package body Einfo.Utils is
-- Scope_Depth --
-----------------
- function Scope_Depth (Id : E) return Uint is
+ function Scope_Depth (Id : Scope_Kind_Id) return Uint is
Scop : Entity_Id;
begin
@@ -2601,7 +2601,7 @@ package body Einfo.Utils is
return Scope_Depth_Value (Scop);
end Scope_Depth;
- function Scope_Depth_Default_0 (Id : E) return U is
+ function Scope_Depth_Default_0 (Id : Scope_Kind_Id) return U is
begin
if Scope_Depth_Set (Id) then
return Scope_Depth (Id);
@@ -2615,7 +2615,7 @@ package body Einfo.Utils is
-- Scope_Depth_Set --
---------------------
- function Scope_Depth_Set (Id : E) return B is
+ function Scope_Depth_Set (Id : Scope_Kind_Id) return B is
begin
return not Is_Record_Type (Id)
and then not Field_Is_Initial_Zero (Id, F_Scope_Depth_Value);
diff --git a/gcc/ada/einfo-utils.ads b/gcc/ada/einfo-utils.ads
index 20ca470d7ac..21a8891e4ab 100644
--- a/gcc/ada/einfo-utils.ads
+++ b/gcc/ada/einfo-utils.ads
@@ -242,10 +242,10 @@ package Einfo.Utils is
function Type_Low_Bound (Id : E) return N with Inline;
function Underlying_Type (Id : E) return Entity_Id;
- function Scope_Depth (Id : E) return U with Inline;
- function Scope_Depth_Set (Id : E) return B with Inline;
+ function Scope_Depth (Id : Scope_Kind_Id) return U with Inline;
+ function Scope_Depth_Set (Id : Scope_Kind_Id) return B with Inline;
- function Scope_Depth_Default_0 (Id : E) return U;
+ function Scope_Depth_Default_0 (Id : Scope_Kind_Id) return U;
-- In rare cases, the Scope_Depth_Value (queried by Scope_Depth) is
-- not correctly set before querying it; this may be used instead of
-- Scope_Depth in such cases. It returns Uint_0 if the Scope_Depth_Value
diff --git a/gcc/ada/frontend.adb b/gcc/ada/frontend.adb
index f2faa0960c6..eb9378d8936 100644
--- a/gcc/ada/frontend.adb
+++ b/gcc/ada/frontend.adb
@@ -565,6 +565,4 @@ begin
if Mapping_File_Name /= null then
Fmap.Update_Mapping_File (Mapping_File_Name.all);
end if;
-
- return;
end Frontend;
diff --git a/gcc/ada/gen_il-gen-gen_entities.adb b/gcc/ada/gen_il-gen-gen_entities.adb
index f980ba2f1b3..3e6ed9633bd 100644
--- a/gcc/ada/gen_il-gen-gen_entities.adb
+++ b/gcc/ada/gen_il-gen-gen_entities.adb
@@ -1423,4 +1423,31 @@ begin -- Gen_IL.Gen.Gen_Entities
E_Subprogram_Body,
E_Subprogram_Type));
+ -- Entities that represent scopes. These can be on the scope stack,
+ -- and Scope_Depth can be queried. These are the kinds that have
+ -- the Scope_Depth_Value attribute, plus Record_Kind, which has
+ -- a synthesized Scope_Depth.
+
+ Union (Scope_Kind,
+ Children =>
+ (E_Void,
+ E_Private_Type,
+ E_Private_Subtype,
+ E_Limited_Private_Type,
+ E_Limited_Private_Subtype,
+ Concurrent_Kind,
+ Subprogram_Kind,
+ E_Entry,
+ E_Entry_Family,
+ E_Block,
+ Generic_Unit_Kind,
+ E_Loop,
+ E_Return_Statement,
+ E_Package,
+ E_Package_Body,
+ E_Subprogram_Body,
+ Record_Kind,
+ E_Incomplete_Type,
+ E_Subprogram_Type));
+
end Gen_IL.Gen.Gen_Entities;
diff --git a/gcc/ada/gen_il-types.ads b/gcc/ada/gen_il-types.ads
index be6ba52634f..be389ebc35a 100644
--- a/gcc/ada/gen_il-types.ads
+++ b/gcc/ada/gen_il-types.ads
@@ -177,6 +177,7 @@ package Gen_IL.Types is
Record_Kind,
Record_Field_Kind,
Scalar_Kind,
+ Scope_Kind,
Signed_Integer_Kind,
Subprogram_Type_Or_Kind,
Subprogram_Kind,
diff --git a/gcc/ada/sem.adb b/gcc/ada/sem.adb
index 3bff8d26a0d..0356ffcf859 100644
--- a/gcc/ada/sem.adb
+++ b/gcc/ada/sem.adb
@@ -27,7 +27,6 @@ with Atree; use Atree;
with Debug; use Debug;
with Debug_A; use Debug_A;
with Einfo; use Einfo;
-with Einfo.Entities; use Einfo.Entities;
with Einfo.Utils; use Einfo.Utils;
with Elists; use Elists;
with Exp_SPARK; use Exp_SPARK;
diff --git a/gcc/ada/sem.ads b/gcc/ada/sem.ads
index 19abbf16d19..10d4bd2e964 100644
--- a/gcc/ada/sem.ads
+++ b/gcc/ada/sem.ads
@@ -201,6 +201,7 @@
-- called Preanalyze_And_Resolve and is in Sem_Res.
with Alloc;
+with Einfo.Entities; use Einfo.Entities;
with Opt; use Opt;
with Table;
with Types; use Types;
@@ -485,7 +486,7 @@ package Sem is
-- configuration file.
type Scope_Stack_Entry is record
- Entity : Entity_Id;
+ Entity : Scope_Kind_Id;
-- Entity representing the scope
Last_Subprogram_Name : String_Ptr;
diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
index 6e0db366db8..3c55cb61fb4 100644
--- a/gcc/ada/sem_ch8.adb
+++ b/gcc/ada/sem_ch8.adb
@@ -26,7 +26,6 @@
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 Elists; use Elists;
with Errout; use Errout;
@@ -9301,7 +9300,7 @@ package body Sem_Ch8 is
procedure Pop_Scope is
SST : Scope_Stack_Entry renames Scope_Stack.Table (Scope_Stack.Last);
- S : constant Entity_Id := SST.Entity;
+ S : constant Scope_Kind_Id := SST.Entity;
begin
if Debug_Flag_E then
@@ -9363,7 +9362,7 @@ package body Sem_Ch8 is
-- Push_Scope --
----------------
- procedure Push_Scope (S : Entity_Id) is
+ procedure Push_Scope (S : Scope_Kind_Id) is
E : constant Entity_Id := Scope (S);
function Component_Alignment_Default return Component_Alignment_Kind;
diff --git a/gcc/ada/sem_ch8.ads b/gcc/ada/sem_ch8.ads
index 87323e08f04..246ab87f11f 100644
--- a/gcc/ada/sem_ch8.ads
+++ b/gcc/ada/sem_ch8.ads
@@ -23,7 +23,8 @@
-- --
------------------------------------------------------------------------------
-with Types; use Types;
+with Einfo.Entities; use Einfo.Entities;
+with Types; use Types;
package Sem_Ch8 is
-----------------------------------
@@ -148,7 +149,7 @@ package Sem_Ch8 is
-- Mark a given entity or node Id's relevant use clauses as effective,
-- including redundant ones and ones outside of the current scope.
- procedure Push_Scope (S : Entity_Id);
+ procedure Push_Scope (S : Scope_Kind_Id);
-- Make new scope stack entry, pushing S, the entity for a scope onto the
-- top of the scope table. The current setting of the scope suppress flags
-- is saved for restoration on exit.
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index cc9dcb30b18..e778bab95d1 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -8938,10 +8938,16 @@ package body Sem_Util is
-- Find_Enclosing_Scope --
--------------------------
- function Find_Enclosing_Scope (N : Node_Id) return Entity_Id is
+ function Find_Enclosing_Scope (N : Node_Id) return Scope_Kind_Id is
Par : Node_Id;
begin
+ -- If N is an entity, simply return its Scope
+
+ if Nkind (N) in N_Entity then
+ return Scope (N);
+ end if;
+
-- Examine the parent chain looking for a construct which defines a
-- scope.
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index b56a235c022..92016bc0eef 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -889,7 +889,8 @@ package Sem_Util is
-- such a loop exists, return the entity of its identifier (E_Loop scope),
-- otherwise return Empty.
- function Find_Enclosing_Scope (N : Node_Id) return Entity_Id;
+ function Find_Enclosing_Scope (N : Node_Id) return Scope_Kind_Id with
+ Post => Find_Enclosing_Scope'Result /= N;
-- Find the nearest scope which encloses arbitrary node N
function Find_Loop_In_Conditional_Block (N : Node_Id) return Node_Id;
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2023-09-15 13:04 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2023-09-15 13:04 [gcc r14-4024] ada: Clean up scope depth and related code (tech debt) Marc Poulhi?s
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).