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 <[email protected]>
* 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;
