This patch corrects the visibility machinery to properly infer the original
visibility of a use-visible entity defined within a nested package within a
generic when the generic is instantiated and there is already another use-
visible entity which satisfies the referenced.
------------
-- Source --
------------
-- my_generic.ads
generic
package My_Generic is
package Nested is
package M is
function F (X : Integer) return Integer is (X);
end M;
end Nested;
use Nested;
function G (X : Integer) return Integer is (M.F (X));
end My_Generic;
-- my_instance.ads
with My_Generic;
package My_Instance is
package Nested is
package M is
function F (X : Integer) return Integer is (X);
end M;
end Nested;
use Nested;
package I is new My_Generic;
end My_Instance;
-----------------
-- Compilation --
-----------------
$ gcc -c my_instance.ads
Tested on x86_64-pc-linux-gnu, committed on trunk
2017-04-27 Hristian Kirtchev <kirtc...@adacore.com>
* sem_ch8.adb (Find_Direct_Name): Account for the case where
a use-visible entity is defined within a nested scope of an
instance when giving priority to entities which were visible in
the original generic.
* sem_util.ads, sem_util.adb (Nearest_Enclosing_Instance): New routine.
Index: sem_util.adb
===================================================================
--- sem_util.adb (revision 247298)
+++ sem_util.adb (working copy)
@@ -16750,6 +16750,26 @@
Mark_Allocators (Root_Nod);
end Mark_Coextensions;
+ --------------------------------
+ -- Nearest_Enclosing_Instance --
+ --------------------------------
+
+ function Nearest_Enclosing_Instance (E : Entity_Id) return Entity_Id is
+ Inst : Entity_Id;
+
+ begin
+ Inst := Scope (E);
+ while Present (Inst) and then Inst /= Standard_Standard loop
+ if Is_Generic_Instance (Inst) then
+ return Inst;
+ end if;
+
+ Inst := Scope (Inst);
+ end loop;
+
+ return Empty;
+ end Nearest_Enclosing_Instance;
+
----------------------
-- Needs_One_Actual --
----------------------
Index: sem_util.ads
===================================================================
--- sem_util.ads (revision 247298)
+++ sem_util.ads (working copy)
@@ -1941,6 +1941,10 @@
-- to guarantee this in all cases. Note that it is more possible to give
-- correct answer if the tree is fully analyzed.
+ function Nearest_Enclosing_Instance (E : Entity_Id) return Entity_Id;
+ -- Return the entity of the nearest enclosing instance which encapsulates
+ -- entity E. If no such instance exits, return Empty.
+
function Needs_One_Actual (E : Entity_Id) return Boolean;
-- Returns True if a function has defaults for all but its first
-- formal. Used in Ada 2005 mode to solve the syntactic ambiguity that
Index: sem_ch8.adb
===================================================================
--- sem_ch8.adb (revision 247293)
+++ sem_ch8.adb (working copy)
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2016, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2017, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -4764,16 +4764,16 @@
----------------------
procedure Find_Direct_Name (N : Node_Id) is
- E : Entity_Id;
- E2 : Entity_Id;
- Msg : Boolean;
+ E : Entity_Id;
+ E2 : Entity_Id;
+ Msg : Boolean;
+ Homonyms : Entity_Id;
+ -- Saves start of homonym chain
+
Inst : Entity_Id := Empty;
-- Enclosing instance, if any
- Homonyms : Entity_Id;
- -- Saves start of homonym chain
-
Nvis_Entity : Boolean;
-- Set True to indicate that there is at least one entity on the homonym
-- chain which, while not visible, is visible enough from the user point
@@ -4835,8 +4835,6 @@
Scop : constant Entity_Id := Scope (E);
-- Declared scope of candidate entity
- Act : Entity_Id;
-
function Declared_In_Actual (Pack : Entity_Id) return Boolean;
-- Recursive function that does the work and examines actuals of
-- actual packages of current instance.
@@ -4858,7 +4856,7 @@
if Renamed_Object (Pack) = Scop then
return True;
- -- Check for end of list of actuals.
+ -- Check for end of list of actuals
elsif Ekind (Act) = E_Package
and then Renamed_Object (Act) = Pack
@@ -4878,6 +4876,10 @@
end if;
end Declared_In_Actual;
+ -- Local variables
+
+ Act : Entity_Id;
+
-- Start of processing for From_Actual_Package
begin
@@ -5331,6 +5333,11 @@
Msg := True;
end Undefined;
+ -- Local variables
+
+ Nested_Inst : Entity_Id := Empty;
+ -- The entity of a nested instance which appears within Inst (if any)
+
-- Start of processing for Find_Direct_Name
begin
@@ -5497,15 +5504,17 @@
-- If there is more than one potentially use-visible entity and at
-- least one of them non-overloadable, we have an error (RM 8.4(11)).
-- Note that E points to the first such entity on the homonym list.
- -- Special case: if one of the entities is declared in an actual
- -- package, it was visible in the generic, and takes precedence over
- -- other entities that are potentially use-visible. Same if it is
- -- declared in a local instantiation of the current instance.
else
+ -- If one of the entities is declared in an actual package, it
+ -- was visible in the generic, and takes precedence over other
+ -- entities that are potentially use-visible. The same applies
+ -- if the entity is declared in a local instantiation of the
+ -- current instance.
+
if In_Instance then
- -- Find current instance
+ -- Find the current instance
Inst := Current_Scope;
while Present (Inst) and then Inst /= Standard_Standard loop
@@ -5516,12 +5525,21 @@
Inst := Scope (Inst);
end loop;
+ -- Reexamine the candidate entities, giving priority to those
+ -- that were visible within the generic.
+
E2 := E;
while Present (E2) loop
+ Nested_Inst := Nearest_Enclosing_Instance (E2);
+
+ -- The entity is declared within an actual package, or in a
+ -- nested instance. The ">=" accounts for the case where the
+ -- current instance and the nested instance are the same.
+
if From_Actual_Package (E2)
- or else
- (Is_Generic_Instance (Scope (E2))
- and then Scope_Depth (Scope (E2)) > Scope_Depth (Inst))
+ or else (Present (Nested_Inst)
+ and then Scope_Depth (Nested_Inst) >=
+ Scope_Depth (Inst))
then
E := E2;
goto Found;
@@ -5533,8 +5551,7 @@
Nvis_Messages;
goto Done;
- elsif
- Is_Predefined_File_Name (Unit_File_Name (Current_Sem_Unit))
+ elsif Is_Predefined_File_Name (Unit_File_Name (Current_Sem_Unit))
then
-- A use-clause in the body of a system file creates conflict
-- with some entity in a user scope, while rtsfind is active.
@@ -5543,7 +5560,7 @@
E2 := E;
while Present (E2) loop
if Is_Predefined_File_Name
- (Unit_File_Name (Get_Source_Unit (Sloc (E2))))
+ (Unit_File_Name (Get_Source_Unit (Sloc (E2))))
then
E := E2;
goto Found;
