Ada: Fix visibility problem for implicit actual of formal subprogram

If an actual parameter for a formal subprogram parameter of a generic unit,
whose default is specified by a box, is omitted then an implicit actual with
the name of the formal is used and resolved in the context of the instance.

If this context is a generic unit, and these implicit actuals are resolved
to global references, then these implicit actuals need to be retrofitted
into the unanalyzed copy of the generic unit, so that instances of this
generic unit do not resolve again the implicit actuals but inherit the
global references instead.

This works fine for instances whose name is a direct name but not for those
whose name is an expanded name (in GNAT parlance).  The patch also contains
a small cleanup for a related procedure.

gcc/ada/
	PR ada/25988
	* sem_ch12.adb (Save_Global_References.Reset_Entity): Also call
	Save_Global_Defaults for instances with an expanded name.
	(Save_Global_References.Save_References): Minor code cleanup.

gcc/testsuite/
	* gnat.dg/specs/generic_inst3.ads: New test.
	* gnat.dg/specs/generic_inst3_pkg1.ads: New helper.
	* gnat.dg/specs/generic_inst3_pkg1.adb: New helper.
	* gnat.dg/specs/generic_inst3_pkg2.ads: Likewise.
	* gnat.dg/specs/generic_inst3_pkg3.ads: Likewise.
	* gnat.dg/specs/generic_inst3_pkg3-child.ads: Likewise.

diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index 3575b04ad963ce14d810ddb7f466cc6daaabf641..24d276ba48ae7e6df92cc51de6aac662ba108d56 100644 (file)
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -17639,6 +17639,8 @@ package body Sem_Ch12 is
                Set_Etype  (N2, E);
             end if;
 
+            --  If the entity is global, save its type in the generic node
+
             if Is_Global (E) then
                Set_Global_Type (N, N2);
 
@@ -17659,12 +17661,24 @@ package body Sem_Ch12 is
                Set_Etype (N, Empty);
             end if;
 
+            --  If default actuals have been added to a generic instantiation
+            --  and they are global, save them in the generic node.
+
             if Nkind (Parent (N)) in N_Generic_Instantiation
               and then N = Name (Parent (N))
             then
                Save_Global_Defaults (Parent (N), Parent (N2));
             end if;
 
+            if Nkind (Parent (N)) = N_Selected_Component
+              and then N = Selector_Name (Parent (N))
+              and then Nkind (Parent (Parent (N))) in N_Generic_Instantiation
+              and then Parent (N) = Name (Parent (Parent (N)))
+            then
+               Save_Global_Defaults
+                 (Parent (Parent (N)), Parent (Parent (N2)));
+            end if;
+
          elsif Nkind (Parent (N)) = N_Selected_Component
            and then Nkind (Parent (N2)) = N_Expanded_Name
          then
@@ -18488,12 +18502,13 @@ package body Sem_Ch12 is
          elsif Nkind (N) = N_Pragma then
             Save_References_In_Pragma (N);
 
+         --  Aspects
+
          elsif Nkind (N) =  N_Aspect_Specification then
             declare
                P : constant Node_Id := Parent (N);
-               Expr : Node_Id;
-            begin
 
+            begin
                if Permits_Aspect_Specifications (P) then
 
                   --  The capture of global references within aspects
@@ -18505,15 +18520,11 @@ package body Sem_Ch12 is
                   if Requires_Delayed_Save (Original_Node (P)) then
                      null;
 
-                     --  Otherwise save all global references within the
-                     --  aspects
-
-                  else
-                     Expr := Expression (N);
+                  --  Otherwise save all global references within the
+                  --  expression of the aspect.
 
-                     if Present (Expr) then
-                        Save_Global_References (Expr);
-                     end if;
+                  elsif Present (Expression (N)) then
+                     Save_Global_References (Expression (N));
                   end if;
                end if;
             end;
@@ -18523,10 +18534,11 @@ package body Sem_Ch12 is
          elsif Nkind (N) = N_Implicit_Label_Declaration then
             null;
 
+         --  Other nodes
+
          else
             Save_References_In_Descendants (N);
          end if;
-
       end Save_References;
 
       ---------------------

diff --git a/gcc/testsuite/gnat.dg/specs/generic_inst3.ads b/gcc/testsuite/gnat.dg/specs/generic_inst3.ads
new file mode 100644 (file)
index 0000000..4f31d61
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/specs/generic_inst3.ads
@@ -0,0 +1,3 @@
+with Generic_Inst3_Pkg1;
+
+package Generic_Inst3 is new Generic_Inst3_Pkg1;

diff --git a/gcc/testsuite/gnat.dg/specs/generic_inst3_pkg1.adb b/gcc/testsuite/gnat.dg/specs/generic_inst3_pkg1.adb
new file mode 100644 (file)
index 0000000..02294c2
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/specs/generic_inst3_pkg1.adb
@@ -0,0 +1,14 @@
+with Generic_Inst3_Pkg2; use Generic_Inst3_Pkg2;
+with Generic_Inst3_Pkg3, Generic_Inst3_Pkg3.Child;
+
+package body Generic_Inst3_Pkg1 is
+
+  package Pkg3 is new Generic_Inst3_Pkg3 (T);
+
+  use Pkg3;
+
+  package Child is new Pkg3.Child;
+
+  procedure Proc is null;
+
+end Generic_Inst3_Pkg1;

diff --git a/gcc/testsuite/gnat.dg/specs/generic_inst3_pkg1.ads b/gcc/testsuite/gnat.dg/specs/generic_inst3_pkg1.ads
new file mode 100644 (file)
index 0000000..3fc9c76
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/specs/generic_inst3_pkg1.ads
@@ -0,0 +1,8 @@
+-- { dg-excess-errors "no code generated" }
+
+generic
+package Generic_Inst3_Pkg1 is
+
+  procedure Proc;
+
+end Generic_Inst3_Pkg1;

diff --git a/gcc/testsuite/gnat.dg/specs/generic_inst3_pkg2.ads b/gcc/testsuite/gnat.dg/specs/generic_inst3_pkg2.ads
new file mode 100644 (file)
index 0000000..9187adb
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/specs/generic_inst3_pkg2.ads
@@ -0,0 +1,9 @@
+package Generic_Inst3_Pkg2 is
+
+  type T is new Integer;
+
+  procedure S_One (N: in out T) is null;
+
+  procedure S_Two (N: in out T) is null;
+
+end Generic_Inst3_Pkg2;

diff --git a/gcc/testsuite/gnat.dg/specs/generic_inst3_pkg3-child.ads b/gcc/testsuite/gnat.dg/specs/generic_inst3_pkg3-child.ads
new file mode 100644 (file)
index 0000000..dd02843
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/specs/generic_inst3_pkg3-child.ads
@@ -0,0 +1,9 @@
+generic
+
+  with procedure S_Two (N: in out Number) is <>;
+
+package Generic_Inst3_Pkg3.Child is
+
+  procedure Two (N: in out Number) renames S_Two;
+
+end Generic_Inst3_Pkg3.Child;

diff --git a/gcc/testsuite/gnat.dg/specs/generic_inst3_pkg3.ads b/gcc/testsuite/gnat.dg/specs/generic_inst3_pkg3.ads
new file mode 100644 (file)
index 0000000..29cf00f
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/specs/generic_inst3_pkg3.ads
@@ -0,0 +1,11 @@
+generic
+
+  type Number is private;
+
+  with procedure S_One (N: in out Number) is <>;
+
+package Generic_Inst3_Pkg3 is
+
+  procedure One (N: in out Number) renames S_One;
+
+end Generic_Inst3_Pkg3;