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;