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.

1 files changed, 16 insertions, 0 deletions

diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 8db729f..2fc891a 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