From: Eric Botcazou <ebotcazou@adacore.com>
Date: Tue, 3 Dec 2024 21:36:15 +0000 (+0100)
Subject: ada: Fix double free at run time for class-wide allocation
X-Git-Tag: basepoints/gcc-16~3032
X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=0f7b8a89c325babc2e4abf0097c9f26cb2569114;p=thirdparty%2Fgcc.git

ada: Fix double free at run time for class-wide allocation

The previous change was too aggressive and overlooked a specific case.

gcc/ada/ChangeLog:

	* exp_ch4.adb (Expand_Allocator_Expression): Put back the call to
	Remove_Side_Effects in the case of a function call, a class-wide
	designated type and a regular storage pool.
---

diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 8db729f0ce92..2fc891a4e390 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -996,6 +996,22 @@ package body Exp_Ch4 is
                 (Loc, TagR, Underlying_Type (TagT)));
          end if;
 
+         --  If the designated type is class-wide, then the alignment and the
+         --  controlled nature of the expression are computed dynamically by
+         --  the code generated by Build_Allocate_Deallocate_Proc, which will
+         --  thus need to remove side effects from Exp first. But the below
+         --  test on Exp needs to have its final form to decide whether or not
+         --  to generate an Adjust call, so we preventively remove them here.
+
+         if Nkind (Exp) = N_Function_Call
+           and then Is_Class_Wide_Type (DesigT)
+           and then Present (Storage_Pool (N))
+           and then not Is_RTE (Storage_Pool (N), RE_RS_Pool)
+           and then not Is_RTE (Storage_Pool (N), RE_SS_Pool)
+         then
+            Remove_Side_Effects (Exp);
+         end if;
+
          --  Generate an Adjust call if the object will be moved. In Ada 2005,
          --  the object may be inherently limited, in which case there is no
          --  Adjust procedure, and the object is built in place. In Ada 95, the