This is not a regression but the issue is quite annoying and the fix is
trivial. The problem is that a formal parameter covered by a box in the
formal package is not visible in the instance when it comes after another
formal parameter that is also a formal package.
It comes from a discrepancy internal to Instantiate_Formal_Package, where a
specific construct (the abbreviated instance) built for the nested formal
package discombobulates the processing done for the outer formal package.
Tested on x86-64/Linux, applied on the mainline, 14 and 13 branches.
2025-03-19 Eric Botcazou <ebotca...@adacore.com>
* gen_il-gen-gen_nodes.adb (N_Formal_Package_Declaration): Use
N_Declaration instead of Node_Kind as ancestor.
* sem_ch12.adb (Get_Formal_Entity): Remove obsolete alternative.
(Instantiate_Formal_Package): Take into account the abbreviated
instances in the main loop running over the actuals of the local
package created for the formal package.
2025-03-19 Eric Botcazou <ebotca...@adacore.com>
* gnat.dg/generic_inst14.adb: New test.
* gnat.dg/generic_inst14_pkg.ads: New helper.
* gnat.dg/generic_inst14_pkg-child.ads: Likewise.
--
Eric Botcazou-- { dg-do compile }
with Generic_Inst14_Pkg;
with Generic_Inst14_Pkg.Child;
procedure Generic_Inst14 is
type T is null record;
package Tree is new Generic_Inst14_Pkg.Definite_Value_Tree (T);
package Base is new Generic_Inst14_Pkg.Child.Simple (T, Tree);
package OK is new Generic_Inst14_Pkg.Child.OK (T, Base.Strat);
package Not_OK is new Generic_Inst14_Pkg.Child.Not_OK (T, Tree, Base.Strat);
begin
null;
end;
package Generic_Inst14_Pkg.Child is
generic
type Value is private;
with package Value_Tree is new Definite_Value_Tree (Value => Value);
package Simple is
type Node is new Value_Tree.Value_Node with null record;
package Strat is new Def_Strat (Value, Value_Tree, Node);
end Simple;
generic
type Value is private;
with package A_Strat is new Def_Strat (Value => Value, others => <>);
package OK is
procedure Plop (N : A_Strat.Node) is null;
end OK;
generic
type Value is private;
with package Value_Tree is new Definite_Value_Tree (Value => Value);
with package A_Strat is
new Def_Strat (Value => Value, Value_Tree => Value_Tree, others => <>);
package Not_OK is
procedure Plop (N : A_Strat.Node) is null;
end Not_OK;
end Generic_Inst14_Pkg.Child;
package Generic_Inst14_Pkg is
generic
type Value is limited private;
package Definite_Value_Tree is
type Value_Node is abstract tagged null record;
end Definite_Value_Tree;
generic
type Value is limited private;
with package Value_Tree is new Definite_Value_Tree (Value);
type Node (<>) is new Value_Tree.Value_Node with private;
package Def_Strat is
end Def_Strat;
end Generic_Inst14_Pkg;
diff --git a/gcc/ada/gen_il-gen-gen_nodes.adb b/gcc/ada/gen_il-gen-gen_nodes.adb
index 1f5dc6d3803..eb035361b57 100644
--- a/gcc/ada/gen_il-gen-gen_nodes.adb
+++ b/gcc/ada/gen_il-gen-gen_nodes.adb
@@ -1309,7 +1309,7 @@ begin -- Gen_IL.Gen.Gen_Nodes
Cc (N_Formal_Modular_Type_Definition, Node_Kind);
Cc (N_Formal_Ordinary_Fixed_Point_Definition, Node_Kind);
- Cc (N_Formal_Package_Declaration, Node_Kind,
+ Cc (N_Formal_Package_Declaration, N_Declaration,
(Sy (Defining_Identifier, Node_Id),
Sy (Name, Node_Id, Default_Empty),
Sy (Generic_Associations, List_Id, Default_No_List),
diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index dad8c73729e..5768e28e90f 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -11551,6 +11551,7 @@ package body Sem_Ch12 is
function Get_Formal_Entity (N : Node_Id) return Entity_Id is
Kind : constant Node_Kind := Nkind (Original_Node (N));
+
begin
case Kind is
when N_Formal_Object_Declaration =>
@@ -11565,9 +11566,6 @@ package body Sem_Ch12 is
when N_Formal_Package_Declaration =>
return Defining_Identifier (Original_Node (N));
- when N_Generic_Package_Declaration =>
- return Defining_Identifier (Original_Node (N));
-
-- All other declarations are introduced by semantic analysis and
-- have no match in the actual.
@@ -11806,6 +11804,26 @@ package body Sem_Ch12 is
end if;
Next_Non_Pragma (Formal_Node);
+
+ -- If the actual of the local package created for the formal
+ -- is itself an instantiated formal package, then it could
+ -- have given rise to additional declarations, see the code
+ -- dealing with conformance checking below.
+
+ if Nkind (Actual_Of_Formal) = N_Package_Renaming_Declaration
+ and then Requires_Conformance_Checking
+ (Declaration_Node
+ (Associated_Formal_Package
+ (Defining_Entity (Actual_Of_Formal))))
+ then
+ Next (Actual_Of_Formal);
+ pragma Assert
+ (Nkind (Actual_Of_Formal) = N_Package_Declaration);
+ Next (Actual_Of_Formal);
+ pragma Assert
+ (Nkind (Actual_Of_Formal) = N_Package_Instantiation);
+ end if;
+
Next (Actual_Of_Formal);
-- A formal subprogram may be overloaded, so advance in
@@ -11861,10 +11879,15 @@ package body Sem_Ch12 is
-- checking, because it contains formal declarations for those
-- defaulted parameters, and those should not reach the back-end.
+ -- This processing needs to be synchronized with the pattern matching
+ -- done in the main loop of the above block that starts with the test
+ -- on Requires_Conformance_Checking.
+
if Requires_Conformance_Checking (Formal) then
declare
I_Pack : constant Entity_Id := Make_Temporary (Loc, 'P');
- I_Nam : Node_Id;
+ I_Nam : Node_Id;
+
begin
Set_Is_Internal (I_Pack);
Mutate_Ekind (I_Pack, E_Package);
