From fd4f48b37718748b39344129e70223a5d290c6eb Mon Sep 17 00:00:00 2001 From: Steve Baird Date: Tue, 6 Jun 2023 12:44:00 -0700 Subject: ada: Finalization not performed for component of protected type 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. --- gcc/ada/exp_ch7.adb | 2 ++ gcc/ada/freeze.adb | 15 ++++++++++++++- 2 files changed, 16 insertions(+), 1 deletion(-) (limited to 'gcc') diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index 1b16839..aa16c70 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 83ce030..38aeb24 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 -- cgit v1.1