This patch fixes a compiler abort on an instantiation where the actual for
a formal package is an instantiation of a generic child unit. An instantiation
freezes its actuals, and in the case of formal packages whose instance
includes a body the back-end needs an explicit freeze node for the actual.
If the generic for that actual appears within an enclosing instantiation
that instantiation must be frozen as well. Additionally, if the actual is
an instantiation of a child unit it depends on an instance of its parent
unit, and that instantiation must be frozen as well. Previously only the
first kind of dependence on a previous instantiation was handled properly.
The following must compile quietly:
gcc -c p.ads
---
with Q;
with Q.Sub1;
with Q.Sub2;
package P is
type Rec is record
null;
end record;
package My_Q is new Q (Rec);
package My_Sub1 is new My_Q.Sub1;
package My_Sub2 is new My_Q.Sub2 (My_Sub1);
end P;
---
generic
type T is private;
package Q is
pragma Elaborate_Body;
package Inner is
generic
package G is
end G;
end Inner;
end Q;
---
generic
package Q.Sub1 is
pragma Elaborate_Body;
end Q.Sub1;
---
package body Q.Sub1 is
package My_G is new Q.Inner.G;
end Q.Sub1;
---
with Q.Sub1;
generic
with package F is new Q.Sub1 (<>);
package Q.Sub2 is
end Q.Sub2;
---
with R;
package body Q is
package My_R is new R (T);
package body Inner is
package body G is
package My_H is new My_R.H;
end G;
end Inner;
end Q;
---
generic
type Message is private;
package R is
pragma Elaborate_Body;
generic
package H is
end H;
end R;
---
package body R is
type Message_P is access Message;
package body H is
Obj : constant Message_P := null;
end H;
end R;
---
Tested on x86_64-pc-linux-gnu, committed on trunk
2017-10-09 Ed Schonberg <schonb...@adacore.com>
* sem_ch12.adb (Analyze_Associations, Check_Generic_Parent): If an
actual for a formal package is an instantiation of a child unit, create
a freeze node for the instance of the parent if it appears in the same
scope and is not frozen yet.
Index: sem_ch12.adb
===================================================================
--- sem_ch12.adb (revision 253546)
+++ sem_ch12.adb (working copy)
@@ -1903,7 +1903,8 @@
-- body.
Explicit_Freeze_Check : declare
- Actual : constant Entity_Id := Entity (Match);
+ Actual : constant Entity_Id := Entity (Match);
+ Gen_Par : Entity_Id;
Needs_Freezing : Boolean;
S : Entity_Id;
@@ -1912,7 +1913,11 @@
-- The actual may be an instantiation of a unit
-- declared in a previous instantiation. If that
-- one is also in the current compilation, it must
- -- itself be frozen before the actual.
+ -- itself be frozen before the actual. The actual
+ -- may be an instantiation of a generic child unit,
+ -- in which case the same applies to the instance
+ -- of the parent which must be frozen before the
+ -- actual.
-- Should this itself be recursive ???
--------------------------
@@ -1920,30 +1925,71 @@
--------------------------
procedure Check_Generic_Parent is
- Par : Entity_Id;
+ Inst : constant Node_Id :=
+ Next (Unit_Declaration_Node (Actual));
+ Par : Entity_Id;
begin
- if Nkind (Parent (Actual)) =
- N_Package_Specification
+ Par := Empty;
+
+ if Nkind (Parent (Actual)) = N_Package_Specification
then
Par := Scope (Generic_Parent (Parent (Actual)));
+ if Is_Generic_Instance (Par) then
+ null;
- if Is_Generic_Instance (Par)
- and then Scope (Par) = Current_Scope
- and then
- (No (Freeze_Node (Par))
- or else
- not Is_List_Member (Freeze_Node (Par)))
+ -- If the actual is a child generic unit, check
+ -- whether the instantiation of the parent is
+ -- also local and must also be frozen now.
+ -- We must retrieve the instance node to locate
+ -- the parent instance if any.
+
+ elsif Ekind (Par) = E_Generic_Package
+ and then Is_Child_Unit (Gen_Par)
+ and then Ekind (Scope (Gen_Par))
+ = E_Generic_Package
then
- Set_Has_Delayed_Freeze (Par);
- Append_Elmt (Par, Actuals_To_Freeze);
+ if Nkind (Inst) = N_Package_Instantiation
+ and then
+ Nkind (Name (Inst)) = N_Expanded_Name
+ then
+
+ -- Retrieve entity of psarent instance.
+
+ Par := Entity (Prefix (Name (Inst)));
+ end if;
+
+ else
+ Par := Empty;
end if;
end if;
+
+ if Present (Par)
+ and then Is_Generic_Instance (Par)
+ and then Scope (Par) = Current_Scope
+ and then
+ (No (Freeze_Node (Par))
+ or else
+ not Is_List_Member (Freeze_Node (Par)))
+ then
+ Set_Has_Delayed_Freeze (Par);
+ Append_Elmt (Par, Actuals_To_Freeze);
+ end if;
end Check_Generic_Parent;
-- Start of processing for Explicit_Freeze_Check
begin
+ if Present (Renamed_Entity (Actual)) then
+ Gen_Par :=
+ Generic_Parent (Specification (
+ Unit_Declaration_Node (
+ Renamed_Entity (Actual))));
+ else
+ Gen_Par := Generic_Parent
+ (Specification (Unit_Declaration_Node (Actual)));
+ end if;
+
if not Expander_Active
or else not Has_Completion (Actual)
or else not In_Same_Source_Unit (I_Node, Actual)
