+2018-05-22 Ed Schonberg <schonberg@adacore.com>
+
+ * einfo.ads, einfo.adb: New attribute Hidden_In_Formal_Instance,
+ defined on packages that are actuals for formal packages, in order to
+ set/reset the visibility of the formals of a formal package with given
+ actuals, when there are subsequent uses of those formals in the
+ enclosing generic, as required by RN 12.7 (10).
+ * atree.ads, atree.adb: Add operations for Elist30.
+ * atree.h: Add Elist30.
+ * sem_ch12.adb (Analyze_Formal_Package_Instantiation): Collect formals
+ that are not defaulted and are thus not visible within the current
+ instance.
+ (Check_Formal_Packages): Reset visibility of formals of a formal
+ package that are not defaulted, on exit from current instance.
+
2018-05-22 Hristian Kirtchev <kirtchev@adacore.com>
* sem_prag.adb (Analyze_Input_Output): Emit an error when a non-null,
end if;
end Elist29;
+ function Elist30 (N : Node_Id) return Elist_Id is
+ pragma Assert (Nkind (N) in N_Entity);
+ Value : constant Union_Id := Nodes.Table (N + 5).Field6;
+ begin
+ if Value = 0 then
+ return No_Elist;
+ else
+ return Elist_Id (Value);
+ end if;
+ end Elist30;
+
function Elist36 (N : Node_Id) return Elist_Id is
pragma Assert (Nkind (N) in N_Entity);
Value : constant Union_Id := Nodes.Table (N + 6).Field6;
Nodes.Table (N + 4).Field11 := Union_Id (Val);
end Set_Elist29;
+ procedure Set_Elist30 (N : Node_Id; Val : Elist_Id) is
+ begin
+ pragma Assert (not Locked);
+ pragma Assert (Nkind (N) in N_Entity);
+ Nodes.Table (N + 5).Field6 := Union_Id (Val);
+ end Set_Elist30;
+
procedure Set_Elist36 (N : Node_Id; Val : Elist_Id) is
begin
pragma Assert (not Locked);
function Elist29 (N : Node_Id) return Elist_Id;
pragma Inline (Elist29);
+ function Elist30 (N : Node_Id) return Elist_Id;
+ pragma Inline (Elist30);
+
function Elist36 (N : Node_Id) return Elist_Id;
pragma Inline (Elist36);
procedure Set_Elist29 (N : Node_Id; Val : Elist_Id);
pragma Inline (Set_Elist29);
+ procedure Set_Elist30 (N : Node_Id; Val : Elist_Id);
+ pragma Inline (Set_Elist30);
+
procedure Set_Elist36 (N : Node_Id; Val : Elist_Id);
pragma Inline (Set_Elist36);
#define Elist25(N) Field25 (N)
#define Elist26(N) Field26 (N)
#define Elist29(N) Field29 (N)
+#define Elist30(N) Field30 (N)
#define Elist36(N) Field36 (N)
#define Name1(N) Field1 (N)
-- Corresponding_Equality Node30
-- Last_Aggregate_Assignment Node30
-- Static_Initialization Node30
+ -- Hidden_In_Formal_Instance Elist30
-- Derived_Type_Link Node31
-- Thunk_Entity Node31
return Node8 (Id);
end Hiding_Loop_Variable;
+ function Hidden_In_Formal_Instance (Id : E) return L is
+ begin
+ pragma Assert (Ekind (Id) = E_Package);
+ return Elist30 (Id);
+ end Hidden_In_Formal_Instance;
+
function Homonym (Id : E) return E is
begin
return Node4 (Id);
Set_Node8 (Id, V);
end Set_Hiding_Loop_Variable;
+ procedure Set_Hidden_In_Formal_Instance (Id : E; V : L) is
+ begin
+ pragma Assert (Ekind (Id) = E_Package);
+ Set_Elist30 (Id, V);
+ end Set_Hidden_In_Formal_Instance;
+
procedure Set_Homonym (Id : E; V : E) is
begin
pragma Assert (Id /= V);
-- warning messages if the hidden variable turns out to be unused
-- or is referenced without being set.
+-- Hidden_In_Formal_Instance (Elist30)
+-- Defined on actuals for formal packages. Entities on the list are
+-- formals that are hidden outside of the formal package when this
+-- package is not declared with a box, or the formal itself is not
+-- defaulted (see RM 12.7 (10)). Their visibility is restored on exit
+-- from the current generic, because the actual for the formal package
+-- may be used subsequently in the current unit.
+
-- Homonym (Node4)
-- Defined in all entities. Link for list of entities that have the
-- same source name and that are declared in the same or enclosing
function Has_Volatile_Components (Id : E) return B;
function Has_Xref_Entry (Id : E) return B;
function Hiding_Loop_Variable (Id : E) return E;
+ function Hidden_In_Formal_Instance (Id : E) return L;
function Homonym (Id : E) return E;
function Ignore_SPARK_Mode_Pragmas (Id : E) return B;
function Import_Pragma (Id : E) return E;
procedure Set_Has_Volatile_Components (Id : E; V : B := True);
procedure Set_Has_Xref_Entry (Id : E; V : B := True);
procedure Set_Hiding_Loop_Variable (Id : E; V : E);
+ procedure Set_Hidden_In_Formal_Instance (Id : E; V : L);
procedure Set_Homonym (Id : E; V : E);
procedure Set_Ignore_SPARK_Mode_Pragmas (Id : E; V : B := True);
procedure Set_Import_Pragma (Id : E; V : E);
pragma Inline (Has_Volatile_Components);
pragma Inline (Has_Xref_Entry);
pragma Inline (Hiding_Loop_Variable);
+ pragma Inline (Hidden_In_Formal_Instance);
pragma Inline (Homonym);
pragma Inline (Ignore_SPARK_Mode_Pragmas);
pragma Inline (Import_Pragma);
pragma Inline (Set_Has_Volatile_Components);
pragma Inline (Set_Has_Xref_Entry);
pragma Inline (Set_Hiding_Loop_Variable);
+ pragma Inline (Set_Hidden_In_Formal_Instance);
pragma Inline (Set_Homonym);
pragma Inline (Set_Ignore_SPARK_Mode_Pragmas);
pragma Inline (Set_Import_Pragma);
-- check on Ada version and the presence of an access definition in N.
procedure Check_Formal_Packages (P_Id : Entity_Id);
- -- Apply the following to all formal packages in generic associations
+ -- Apply the following to all formal packages in generic associations.
+ -- Restore the visibility of the formals of the instance that are not
+ -- defaulted (see RM 12.7 (10)). Remove the anonymous package declaration
+ -- created for formal instances that are not defaulted.
procedure Check_Formal_Package_Instance
(Formal_Pack : Entity_Id;
E : Entity_Id;
Formal_P : Entity_Id;
Formal_Decl : Node_Id;
-
begin
-- Iterate through the declarations in the instance, looking for package
-- renaming declarations that denote instances of formal packages. Stop
Check_Formal_Package_Instance (Formal_P, E);
end if;
+ -- Restore the visibility of formals of the formal instance
+ -- that are not defaulted, and are hidden within the current
+ -- generic. These formals may be visible within an enclosing
+ -- generic.
+
+ declare
+ Elmt : Elmt_Id;
+ begin
+ Elmt := First_Elmt (Hidden_In_Formal_Instance (Formal_P));
+ while Present (Elmt) loop
+ Set_Is_Hidden (Node (Elmt), False);
+ Next_Elmt (Elmt);
+ end loop;
+ end;
+
-- After checking, remove the internal validating package.
-- It is only needed for semantic checks, and as it may
-- contain generic formal declarations it should not reach
Actual : Node_Id;
Analyzed_Formal : Node_Id) return List_Id
is
- Loc : constant Source_Ptr := Sloc (Actual);
- Actual_Pack : Entity_Id;
- Formal_Pack : Entity_Id;
- Gen_Parent : Entity_Id;
- Decls : List_Id;
- Nod : Node_Id;
- Parent_Spec : Node_Id;
+ Loc : constant Source_Ptr := Sloc (Actual);
+ Hidden_Formals : constant Elist_Id := New_Elmt_List;
+ Actual_Pack : Entity_Id;
+ Formal_Pack : Entity_Id;
+ Gen_Parent : Entity_Id;
+ Decls : List_Id;
+ Nod : Node_Id;
+ Parent_Spec : Node_Id;
procedure Find_Matching_Actual
(F : Node_Id;
end if;
else
+ if not Is_Hidden (Actual_Ent) then
+ Append_Elmt (Actual_Ent, Hidden_Formals);
+ end if;
+
Set_Is_Hidden (Actual_Ent);
Set_Is_Potentially_Use_Visible (Actual_Ent, False);
end if;
begin
Set_Is_Internal (I_Pack);
+ Set_Ekind (I_Pack, E_Package);
+ Set_Hidden_In_Formal_Instance (I_Pack, Hidden_Formals);
Append_To (Decls,
Make_Package_Instantiation (Sloc (Actual),
+2018-05-22 Ed Schonberg <schonberg@adacore.com>
+
+ * gnat.dg/gen_formal_pkg.adb, gnat.dg/gen_formal_pkg_a.ads,
+ gnat.dg/gen_formal_pkg_b.ads, gnat.dg/gen_formal_pkg_w.ads: New
+ testcase.
+
2018-05-22 Ed Schonberg <schonberg@adacore.com>
* gnat.dg/fixedpnt3.adb: New testcase.
--- /dev/null
+-- { dg-do compile }
+
+with Gen_Formal_Pkg_A, Gen_Formal_Pkg_B, Gen_Formal_Pkg_W;
+
+procedure Gen_Formal_Pkg is
+ package AI is new Gen_Formal_Pkg_A (Long_Float);
+ package WI is new Gen_Formal_Pkg_W (AI);
+begin
+ null;
+end;
--- /dev/null
+generic
+ type T1 is private;
+package Gen_Formal_Pkg_A is end;
--- /dev/null
+with Gen_Formal_Pkg_A;
+
+generic
+ type T1 is private;
+ with package Ai is new Gen_Formal_Pkg_A (T1);
+package Gen_Formal_Pkg_B is end;
--- /dev/null
+with Gen_Formal_Pkg_A, Gen_Formal_Pkg_B;
+
+generic
+ with package Ai is new Gen_Formal_Pkg_A (<>);
+package Gen_Formal_Pkg_W is
+
+ procedure P1 (T : Ai.T1) is null;
+
+ package Bi is new Gen_Formal_Pkg_B (Ai.T1, Ai);
+
+ procedure P2 (T : Ai.T1) is null;
+
+end Gen_Formal_Pkg_W;
projects / gcc.git / commitdiff