From: Eric Botcazou <ebotcazou@adacore.com>
Date: Fri, 17 Nov 2023 10:56:37 +0000 (+0100)
Subject: ada: Fix predicate check failure in Expand_Allocator_Expression
X-Git-Tag: basepoints/gcc-15~4143
X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=925f96eab82bad8e237887d5860442d012b68e36;p=thirdparty%2Fgcc.git

ada: Fix predicate check failure in Expand_Allocator_Expression

The For_Special_Return_Object flag needs to be accessed on entry of the
procedure in case the allocator is rewritten during the processing.

gcc/ada/

	* exp_ch4.adb (Expand_Allocator_Expression): Add Special_Return
	boolean constant to hold the value of For_Special_Return_Object
	for the allocator and use it throughout the procedure.
---

diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index f04ac615be90..e708ed350d14 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -555,15 +555,16 @@ package body Exp_Ch4 is
    ---------------------------------
 
    procedure Expand_Allocator_Expression (N : Node_Id) is
-      Loc    : constant Source_Ptr := Sloc (N);
-      Exp    : constant Node_Id    := Expression (Expression (N));
-      PtrT   : constant Entity_Id  := Etype (N);
-      DesigT : constant Entity_Id  := Designated_Type (PtrT);
+      Loc            : constant Source_Ptr := Sloc (N);
+      Exp            : constant Node_Id    := Expression (Expression (N));
+      Indic          : constant Node_Id    := Subtype_Mark (Expression (N));
+      T              : constant Entity_Id  := Entity (Indic);
+      PtrT           : constant Entity_Id  := Etype (N);
+      DesigT         : constant Entity_Id  := Designated_Type (PtrT);
+      Special_Return : constant Boolean    := For_Special_Return_Object (N);
 
       --  Local variables
 
-      Indic         : constant Node_Id   := Subtype_Mark (Expression (N));
-      T             : constant Entity_Id := Entity (Indic);
       Adj_Call      : Node_Id;
       Aggr_In_Place : Boolean;
       Node          : Node_Id;
@@ -902,7 +903,7 @@ package body Exp_Ch4 is
 
          --  Likewise if the allocator is made for a special return object
 
-         elsif For_Special_Return_Object (N) then
+         elsif Special_Return then
             null;
 
          elsif Is_Tagged_Type (T) and then not Is_Class_Wide_Type (T) then
@@ -944,7 +945,7 @@ package body Exp_Ch4 is
            and then not Is_Inherently_Limited_Type (T)
            and then not Aggr_In_Place
            and then Nkind (Exp) /= N_Function_Call
-           and then not For_Special_Return_Object (N)
+           and then not Special_Return
          then
             --  An unchecked conversion is needed in the classwide case because
             --  the designated type can be an ancestor of the subtype mark of