diff options
author | Bob Duff <duff@adacore.com> | 2023-09-05 14:40:22 -0400 |
---|---|---|
committer | Marc Poulhiès <poulhies@adacore.com> | 2023-09-15 15:01:29 +0200 |
commit | 553c37bedcfb04f52237ef3cdd2a19747c61cde1 (patch) | |
tree | 3d93df681fb0727604b4fbec9904a6c64c939914 | |
parent | 545af80aef6dcc368f3e50cbd0c2119ddbdde2e7 (diff) | |
download | gcc-553c37bedcfb04f52237ef3cdd2a19747c61cde1.zip gcc-553c37bedcfb04f52237ef3cdd2a19747c61cde1.tar.gz gcc-553c37bedcfb04f52237ef3cdd2a19747c61cde1.tar.bz2 |
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>
-rw-r--r-- | gcc/ada/accessibility.adb | 38 | ||||
-rw-r--r-- | gcc/ada/atree.adb | 210 | ||||
-rw-r--r-- | gcc/ada/einfo-utils.adb | 6 | ||||
-rw-r--r-- | gcc/ada/einfo-utils.ads | 6 | ||||
-rw-r--r-- | gcc/ada/frontend.adb | 2 | ||||
-rw-r--r-- | gcc/ada/gen_il-gen-gen_entities.adb | 27 | ||||
-rw-r--r-- | gcc/ada/gen_il-types.ads | 1 | ||||
-rw-r--r-- | gcc/ada/sem.adb | 1 | ||||
-rw-r--r-- | gcc/ada/sem.ads | 3 | ||||
-rw-r--r-- | gcc/ada/sem_ch8.adb | 5 | ||||
-rw-r--r-- | gcc/ada/sem_ch8.ads | 5 | ||||
-rw-r--r-- | gcc/ada/sem_util.adb | 8 | ||||
-rw-r--r-- | 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 bc897d1..bc217be 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 5597d16..8e4c443 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 cb9a00d..9bee1f4 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 20ca470..21a8891 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 f2faa09..eb9378d 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 f980ba2..3e6ed96 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 be6ba52..be389eb 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 3bff8d2..0356ffc 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 19abbf1..10d4bd2 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 6e0db36..3c55cb6 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 87323e0..246ab87 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 cc9dcb3..e778bab 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 b56a235..92016bc 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; |