From: Steve Baird <ba...@adacore.com>
In some cases involving a discriminated protected type with an array
component that is subject to a discriminant-dependent index constraint,
where the element type of the array requires finalization and the array
type has not yet been frozen at the point of the declaration of the protected
type, finalization of an object of the protected type may incorrectly omit
finalization of the array component. One case where this scenario can arise
is an instantiation of Ada.Containers.Bounded_Synchronized_Queues, passing in
an Element type that requires finalization.
gcc/ada/
* exp_ch7.adb (Make_Final_Call): Add assertion that if no
finalization call is generated, then the type of the object being
finalized does not require finalization.
* freeze.adb (Freeze_Entity): If freezing an already-frozen
subtype, do not assume that nothing needs to be done. In the case
of a frozen subtype of a non-frozen type or subtype (which is
possible), freeze the non-frozen entity.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/exp_ch7.adb | 2 ++
gcc/ada/freeze.adb | 15 ++++++++++++++-
2 files changed, 16 insertions(+), 1 deletion(-)
diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
index 1b16839ddf3..aa16c707887 100644
--- a/gcc/ada/exp_ch7.adb
+++ b/gcc/ada/exp_ch7.adb
@@ -8387,6 +8387,8 @@ package body Exp_Ch7 is
Param => Ref,
Skip_Self => Skip_Self);
else
+ pragma Assert (Serious_Errors_Detected > 0
+ or else not Has_Controlled_Component (Utyp));
return Empty;
end if;
end Make_Final_Call;
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index 83ce0300871..38aeb2456ff 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -6188,7 +6188,20 @@ package body Freeze is
-- Do not freeze if already frozen since we only need one freeze node
if Is_Frozen (E) then
- Result := No_List;
+
+ if Is_Itype (E)
+ and then not Is_Base_Type (E)
+ and then not Is_Frozen (Etype (E))
+ then
+ -- If a frozen subtype of an unfrozen type seems impossible
+ -- then see Analyze_Protected_Definition.Undelay_Itypes.
+
+ Result := Freeze_Entity
+ (Etype (E), N, Do_Freeze_Profile => Do_Freeze_Profile);
+ else
+ Result := No_List;
+ end if;
+
goto Leave;
-- Do not freeze if we are preanalyzing without freezing
--
2.40.0
