===================================================================
@@ -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)
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 <schonberg@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.