[gcc r13-383] [Ada] Ineffective use type clause warnings cause compile time crash

[gcc r13-383] [Ada] Ineffective use type clause warnings cause compile time crash

[Pierre-Marie de Rodat]

https://gcc.gnu.org/g:8a8366d4969e87366a94d9f2b768606fdf46a7b2

commit r13-383-g8a8366d4969e87366a94d9f2b768606fdf46a7b2
Author: Justin Squirek <squirek@adacore.com>
Date:   Mon Feb 14 20:51:49 2022 +0000

    [Ada] Ineffective use type clause warnings cause compile time crash
    
    This patch corrects an error in the compiler whereby the presence of a
    generic instance featuring a use type clause at library level may cause
    a crash at compile time when warnings for ineffective use clauses are
    enabled and the type in question is already use visible.
    
    gcc/ada/
    
            * sem_ch8.adb (Determine_Package_Scope): Created to centralize
            the calculation of which package a given use clause belongs to.
            (Most_Descendant_Use_Clause): Modified to call
            Determine_Package_Scope.
            * sem_util.adb, sem_util.ads (Enclosing_Package): Modified to
            handle both entity and node ids.

Diff:
---
 gcc/ada/sem_ch8.adb  | 29 +++++++++++++++++++++++++++--
 gcc/ada/sem_util.adb | 26 ++++++++++++++++++++++++--
 gcc/ada/sem_util.ads |  4 ++--
 3 files changed, 53 insertions(+), 6 deletions(-)

diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
index 18187789121..60c2ce6e3bc 100644
--- a/gcc/ada/sem_ch8.adb
+++ b/gcc/ada/sem_ch8.adb
@@ -9202,9 +9202,34 @@ package body Sem_Ch8 is
      (Clause1 : Entity_Id;
       Clause2 : Entity_Id) return Entity_Id
    is
+      function Determine_Package_Scope (Clause : Node_Id) return Entity_Id;
+      --  Given a use clause, determine which package it belongs to
+
+      -----------------------------
+      -- Determine_Package_Scope --
+      -----------------------------
+
+      function Determine_Package_Scope (Clause : Node_Id) return Entity_Id is
+      begin
+         --  Check if the clause appears in the context area
+
+         --  Note we cannot employ Enclosing_Packge for use clauses within
+         --  context clauses since they are not actually "enclosed."
+
+         if Nkind (Parent (Clause)) = N_Compilation_Unit then
+            return Entity_Of_Unit (Unit (Parent (Clause)));
+         end if;
+
+         --  Otherwise, obtain the enclosing package normally
+
+         return Enclosing_Package (Clause);
+      end Determine_Package_Scope;
+
       Scope1 : Entity_Id;
       Scope2 : Entity_Id;
 
+   --  Start of processing for Most_Descendant_Use_Clause
+
    begin
       if Clause1 = Clause2 then
          return Clause1;
@@ -9213,8 +9238,8 @@ package body Sem_Ch8 is
       --  We determine which one is the most descendant by the scope distance
       --  to the ultimate parent unit.
 
-      Scope1 := Entity_Of_Unit (Unit (Parent (Clause1)));
-      Scope2 := Entity_Of_Unit (Unit (Parent (Clause2)));
+      Scope1 := Determine_Package_Scope (Clause1);
+      Scope2 := Determine_Package_Scope (Clause2);
       while Scope1 /= Standard_Standard
         and then Scope2 /= Standard_Standard
       loop
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 2f1a5e05b95..f12dbc7a120 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -8287,10 +8287,32 @@ package body Sem_Util is
    -- Enclosing_Package --
    -----------------------
 
-   function Enclosing_Package (E : Entity_Id) return Entity_Id is
-      Dynamic_Scope : constant Entity_Id := Enclosing_Dynamic_Scope (E);
+   function Enclosing_Package (N : Node_Or_Entity_Id) return Entity_Id is
+      Dynamic_Scope : Entity_Id;
 
    begin
+      --  Obtain the enclosing scope when N is a Node_Id - taking care to
+      --  handle the case when the enclosing scope is already a package.
+
+      if Nkind (N) not in N_Entity then
+         declare
+            Encl_Scop : constant Entity_Id := Find_Enclosing_Scope (N);
+         begin
+            if No (Encl_Scop) then
+               return Empty;
+            elsif Ekind (Encl_Scop) in
+                    E_Generic_Package | E_Package | E_Package_Body
+            then
+               return Encl_Scop;
+            end if;
+
+            return Enclosing_Package (Encl_Scop);
+         end;
+      end if;
+
+      --  When N is already an Entity_Id proceed
+
+      Dynamic_Scope := Enclosing_Dynamic_Scope (N);
       if Dynamic_Scope = Standard_Standard then
          return Standard_Standard;
 
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index bd2253003df..4ab40164c65 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -816,9 +816,9 @@ package Sem_Util is
    --  Enclosing_Comp_Unit_Node returns a subunit, then the corresponding
    --  library unit. If no such item is found, returns Empty.
 
-   function Enclosing_Package (E : Entity_Id) return Entity_Id;
+   function Enclosing_Package (N : Node_Or_Entity_Id) return Entity_Id;
    --  Utility function to return the Ada entity of the package enclosing
-   --  the entity E, if any. Returns Empty if no enclosing package.
+   --  the entity or node N, if any. Returns Empty if no enclosing package.
 
    function Enclosing_Package_Or_Subprogram (E : Entity_Id) return Entity_Id;
    --  Returns the entity of the package or subprogram enclosing E, if any.