diff mbox series

[COMMITTED] ada: Finalization not performed for component of protected type

Message ID 20230706113805.1765789-1-poulhies@adacore.com
State Accepted
Headers
Series [COMMITTED] ada: Finalization not performed for component of protected type |

Checks

Context Check Description
snail/gcc-patch-check success Github commit url

Commit Message

Marc Poulhiès July 6, 2023, 11:38 a.m. UTC 
  From: Steve Baird <baird@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 mbox series

Patch

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