[Ada] Fix handling of visibility when categorization from pragmas

[Ada] Fix handling of visibility when categorization from pragmas

[Pierre-Marie de Rodat]

[-- Attachment #1: Type: text/plain, Size: 1218 bytes --]

Routine Set_Categorization_From_Pragmas processes pragmas listed after
the compilation unit. It requires enclosing scopes to be visible, to
support pragmas (and aspects that are translated to pragmas) like here:

   with Generic_Pkg;
   private package Parent.Child_Instance is new Generic_Pkg
     with Part_Of => Parent.State;
                     ^^^^^^^^^^^^
  --  "Parent" need to be visible when processing the pragma

However, detection of the special case with generic child unit of a
generic parent, where the enclosing scopes need to be made visible, was
imprecise.  For simplicity, this special case is now removed, because
detecting it seemed expensive and complicated.

Also, the visibility is now properly restored to its previous value and
not just blindly left as False.

Finally, the explicit check for an empty list of pragmas is removed; it
was only meant as an optimization, but it didn't seem essential. The
routine is now much simpler and hopefully more robust.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

	* sem_cat.adb (Set_Categorization_From_Pragmas): Remove special
	case for generic child units; remove optimization for empty list
	of pragmas; properly restore visibility.

[-- Attachment #2: patch.diff --]
[-- Type: text/x-diff, Size: 4848 bytes --]

diff --git a/gcc/ada/sem_cat.adb b/gcc/ada/sem_cat.adb
--- a/gcc/ada/sem_cat.adb
+++ b/gcc/ada/sem_cat.adb
@@ -691,56 +691,25 @@ package body Sem_Cat is
    -------------------------------------
 
    procedure Set_Categorization_From_Pragmas (N : Node_Id) is
-      P   : constant Node_Id := Parent (N);
-      S   : constant Entity_Id := Current_Scope;
+      P : constant Node_Id := Parent (N);
 
-      procedure Set_Parents (Visibility : Boolean);
-         --  If this is a child instance, the parents are not immediately
-         --  visible during analysis. Make them momentarily visible so that
-         --  the argument of the pragma can be resolved properly, and reset
-         --  afterwards.
+      procedure Make_Parents_Visible_And_Process_Pragmas (Par : Entity_Id);
+      --  Parents might not be immediately visible during analysis. Make
+      --  them momentarily visible so that the argument of the pragma can
+      --  be resolved properly, process pragmas and restore the previous
+      --  visibility.
 
-      -----------------
-      -- Set_Parents --
-      -----------------
+      procedure Process_Categorization_Pragmas;
+      --  Process categorization pragmas, if any
 
-      procedure Set_Parents (Visibility : Boolean) is
-         Par : Entity_Id;
-      begin
-         Par := Scope (S);
-         while Present (Par) and then Par /= Standard_Standard loop
-            Set_Is_Immediately_Visible (Par, Visibility);
-            Par := Scope (Par);
-         end loop;
-      end Set_Parents;
-
-   --  Start of processing for Set_Categorization_From_Pragmas
-
-   begin
-      --  Deal with categorization pragmas in Pragmas of Compilation_Unit.
-      --  The purpose is to set categorization flags before analyzing the
-      --  unit itself, so as to diagnose violations of categorization as
-      --  we process each declaration, even though the pragma appears after
-      --  the unit. This processing is only needed if compilation unit pragmas
-      --  are present.
-      --  Note: This code may be incorrect in the unlikely case a child generic
-      --  unit is instantiated as a child of its (nongeneric) parent, so that
-      --  generic and instance are siblings.
-
-      if Nkind (P) /= N_Compilation_Unit
-         or else No (First (Pragmas_After (Aux_Decls_Node (P))))
-      then
-         return;
-      end if;
+      ------------------------------------
+      -- Process_Categorization_Pragmas --
+      ------------------------------------
 
-      declare
+      procedure Process_Categorization_Pragmas is
          PN : Node_Id;
 
       begin
-         if Is_Child_Unit (S) and then Is_Generic_Instance (S) then
-            Set_Parents (True);
-         end if;
-
          PN := First (Pragmas_After (Aux_Decls_Node (P)));
          while Present (PN) loop
 
@@ -765,11 +734,49 @@ package body Sem_Cat is
 
             Next (PN);
          end loop;
+      end Process_Categorization_Pragmas;
+
+      ----------------------------------------------
+      -- Make_Parents_Visible_And_Process_Pragmas --
+      ----------------------------------------------
+
+      procedure Make_Parents_Visible_And_Process_Pragmas (Par : Entity_Id) is
+      begin
+         --  When we reached the Standard scope, then just process pragmas
+
+         if Par = Standard_Standard then
+            Process_Categorization_Pragmas;
 
-         if Is_Child_Unit (S) and then Is_Generic_Instance (S) then
-            Set_Parents (False);
+         --  Otherwise make the current scope momentarily visible, recurse
+         --  into its enclosing scope, and restore the visibility. This is
+         --  required for child units that are instances of generic parents.
+
+         else
+            declare
+               Save_Is_Immediately_Visible : constant Boolean :=
+                 Is_Immediately_Visible (Par);
+            begin
+               Set_Is_Immediately_Visible (Par);
+               Make_Parents_Visible_And_Process_Pragmas (Scope (Par));
+               Set_Is_Immediately_Visible (Par, Save_Is_Immediately_Visible);
+            end;
          end if;
-      end;
+      end Make_Parents_Visible_And_Process_Pragmas;
+
+   --  Start of processing for Set_Categorization_From_Pragmas
+
+   begin
+      --  Deal with categorization pragmas in Pragmas of Compilation_Unit.
+      --  The purpose is to set categorization flags before analyzing the
+      --  unit itself, so as to diagnose violations of categorization as
+      --  we process each declaration, even though the pragma appears after
+      --  the unit.
+
+      if Nkind (P) /= N_Compilation_Unit then
+         return;
+      end if;
+
+      Make_Parents_Visible_And_Process_Pragmas (Scope (Current_Scope));
    end Set_Categorization_From_Pragmas;
 
    -----------------------------------