From: Piotr Trojanek <trojanek@adacore.com>
Date: Sat, 12 Dec 2020 23:01:24 +0000 (+0100)
Subject: [Ada] Fix handling of visibility when categorization from pragmas
X-Git-Tag: basepoints/gcc-13~8054
X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=02ba09894f669a69936e1f4b43cfa0e8385e0c84;p=thirdparty%2Fgcc.git

[Ada] Fix handling of visibility when categorization from pragmas

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.
---

diff --git a/gcc/ada/sem_cat.adb b/gcc/ada/sem_cat.adb
index ee22113a3c4d..242f1d2c3014 100644
--- 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;
 
    -----------------------------------