This patch removes a spurious visibility error on a reference to a formal T
of a formal package, when T is declared as a formal derived type and there
is no corresponding actual for T in the formal package declaration, that is
to say it is covered by an (others => <>) clause.
Compiling c.adb must yield:
c.adb:19:17: "Value_Type" is not a visible entity of "Bs"
c.ads:10:40: "Value_Type" is not a visible entity of "Bs"
---
with A;
with B;
generic
with package As is new A (<>);
with package Bs is new B (Value_Type => As.Value_Type, others => <>);
package C is
procedure Update_A_Value (Value : As.Value_Type);
procedure Update_B_Value (Value : Bs.Value_Type);
procedure Update_Object (Object : Bs.Derived_Object);
end C;
---
package body C is
--------------------
-- Update_A_Value --
--------------------
procedure Update_A_Value
(Value : As.Value_Type)
is
begin
null;
end Update_A_Value;
--------------------
-- Update_B_Value --
--------------------
procedure Update_B_Value
(Value : Bs.Value_Type)
is
begin
null;
end Update_B_Value;
-------------------
-- Update_Object --
-------------------
procedure Update_Object
(Object : Bs.Derived_Object)
is
begin
null;
end Update_Object;
end C;
---
with Objects;
generic
type Value_Type is limited private;
type Derived_Object is new Objects.Object with private;
package B is
end B;
---
package Objects is
type Object is tagged null record;
end Objects;
Tested on x86_64-pc-linux-gnu, committed on trunk
2017-04-27 Ed Schonberg <schonb...@adacore.com>
* sem_aux.adb (Is_Generic_Formal): Use original node to locate
corresponding declaration, because formal derived types are
rewritten as private extensions.
Index: sem_aux.adb
===================================================================
--- sem_aux.adb (revision 247293)
+++ sem_aux.adb (working copy)
@@ -1041,11 +1041,16 @@
function Is_Generic_Formal (E : Entity_Id) return Boolean is
Kind : Node_Kind;
+
begin
if No (E) then
return False;
else
- Kind := Nkind (Parent (E));
+ -- Formal derived types are rewritten as private extensions, so
+ -- examine original node.
+
+ Kind := Nkind (Original_Node (Parent (E)));
+
return
Nkind_In (Kind, N_Formal_Object_Declaration,
N_Formal_Package_Declaration,
