We've recently found that Scope_Depth_Value is sometimes called on the
wrong nodes.
This is fixed by adding proper assertions and updating the problematic
call.
Tested on x86_64-pc-linux-gnu, committed on trunk
gcc/ada/
* einfo.ads, einfo.adb (Scope_Depth_Value,
Set_Scope_Depth_Value): Add assertions on valid nodes and update
documentation accordingly.
(Write_Field22_Name): Sync with change in Scope_Depth_Value.
* sem_ch8.adb (Find_Direct_Name): Fix call to Scope_Depth_Value.
diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb
--- a/gcc/ada/einfo.adb
+++ b/gcc/ada/einfo.adb
@@ -3311,6 +3311,13 @@ package body Einfo is
function Scope_Depth_Value (Id : E) return U is
begin
+ pragma Assert
+ (Ekind (Id) in
+ Concurrent_Kind | Entry_Kind | Generic_Unit_Kind |
+ E_Package | E_Package_Body | Subprogram_Kind |
+ E_Block | E_Subprogram_Body |
+ E_Private_Type .. E_Limited_Private_Subtype |
+ E_Void | E_Loop | E_Return_Statement);
return Uint22 (Id);
end Scope_Depth_Value;
@@ -6582,7 +6589,13 @@ package body Einfo is
procedure Set_Scope_Depth_Value (Id : E; V : U) is
begin
- pragma Assert (not Is_Record_Type (Id));
+ pragma Assert
+ (Ekind (Id) in
+ Concurrent_Kind | Entry_Kind | Generic_Unit_Kind |
+ E_Package | E_Package_Body | Subprogram_Kind |
+ E_Block | E_Subprogram_Body |
+ E_Private_Type .. E_Limited_Private_Subtype |
+ E_Void | E_Loop | E_Return_Statement);
Set_Uint22 (Id, V);
end Set_Scope_Depth_Value;
@@ -10873,21 +10886,18 @@ package body Einfo is
when Formal_Kind =>
Write_Str ("Protected_Formal");
- when E_Block
- | E_Entry
- | E_Entry_Family
- | E_Function
- | E_Generic_Function
- | E_Generic_Package
- | E_Generic_Procedure
- | E_Loop
+ when Concurrent_Kind
+ | Entry_Kind
+ | Generic_Unit_Kind
| E_Package
| E_Package_Body
- | E_Procedure
- | E_Protected_Type
- | E_Return_Statement
+ | Subprogram_Kind
+ | E_Block
| E_Subprogram_Body
- | E_Task_Type
+ | E_Private_Type .. E_Limited_Private_Subtype
+ | E_Void
+ | E_Loop
+ | E_Return_Statement
=>
Write_Str ("Scope_Depth_Value");
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -4280,14 +4280,16 @@ package Einfo is
-- the Scope will be Standard.
-- Scope_Depth (synthesized)
--- Applies to program units, blocks, concurrent types and entries, and
--- also to record types, i.e. to any entity that can appear on the scope
--- stack. Yields the scope depth value, which for those entities other
--- than records is simply the scope depth value, for record entities, it
--- is the Scope_Depth of the record scope.
+-- Applies to program units, blocks, loops, return statements,
+-- concurrent types, private types and entries, and also to record types,
+-- i.e. to any entity that can appear on the scope stack. Yields the
+-- scope depth value, which for those entities other than records is
+-- simply the scope depth value, for record entities, it is the
+-- Scope_Depth of the record scope.
-- Scope_Depth_Value (Uint22)
--- Defined in program units, blocks, concurrent types, and entries.
+-- Defined in program units, blocks, loops, return statements,
+-- concurrent types, private types and entries.
-- Indicates the number of scopes that statically enclose the declaration
-- of the unit or type. Library units have a depth of zero. Note that
-- record types can act as scopes but do NOT have this field set (see
diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
--- a/gcc/ada/sem_ch8.adb
+++ b/gcc/ada/sem_ch8.adb
@@ -5752,7 +5752,7 @@ package body Sem_Ch8 is
-- outside the instance.
if From_Actual_Package (E)
- and then Scope_Depth (E2) < Scope_Depth (Inst)
+ and then Scope_Depth (Scope (E2)) < Scope_Depth (Inst)
then
goto Found;
else