This patch fixes a spurious error when a generic grand-child unit is
instantiated in the body of its parent, i.e. a generic child unit, and the
name of the grand-child is fully qualified with that of its ancestors.

The following must compile quietly:

   gnatmake -q c

---
with A;
procedure C is
   package Ai is new A (1);
begin
   Ai.Op;
end C;
---
generic
   I : Integer;
package A is

   procedure Op;

end A;
---
generic
   I : Integer;
package B is

   procedure Op;

end B;
---
with B;
package body A is

   package Ins is new B (I);

   procedure Op is
   begin
      Ins.op;
   end Op;

end A;
---
package body B.A.C is

   Z : Integer;
   --------
   -- Op --
   --------

   procedure Op is
   begin
      Z := Z + 1;
   end Op;

end B.A.C;
---
generic
   I : Integer;
package B.A.C is

   procedure Op;

end B.A.C;
---
with B.A.C;
package body B.A is

   package Inst is new B.A.C (I);

   --------
   -- op --
   --------

   procedure op is
   begin
      Inst.Op;
   end op;

end B.A;
---
generic
   I : Integer;
package B.A is

   procedure op;

end B.A;
---
with B.A;
package body B is

   package Insx is new A (I);

   procedure Op is
   begin
      Insx.Op;
   end op;

end B;

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

2015-05-12  Ed Schonberg  <schonb...@adacore.com>

        * sem_ch8.adb (Find_Expanded_Name): Handle properly a fully
        qualified name for an instance of a generic grand-child unit in
        the body its parent.

Index: sem_ch8.adb
===================================================================
--- sem_ch8.adb (revision 223033)
+++ sem_ch8.adb (working copy)
@@ -5791,8 +5791,19 @@
             end if;
 
             if Is_New_Candidate then
+
+               --  If entity is a child unit, either it is a visible child of
+               --  the prefix, or we are in the body of a generic prefix, as
+               --  will happen when a child unit is instantiated in the body
+               --  of a generic parent. This is because the instance body does
+               --  not restore the full compilation context, given that all
+               --  non-local references have been captured.
+
                if Is_Child_Unit (Id) or else P_Name = Standard_Standard then
-                  exit when Is_Visible_Lib_Unit (Id);
+                  exit when Is_Visible_Lib_Unit (Id)
+                    or else (Is_Child_Unit (Id)
+                              and then In_Open_Scopes (Scope (Id))
+                              and then In_Instance_Body);
                else
                   exit when not Is_Hidden (Id);
                end if;

Reply via email to