diff mbox series

[COMMITTED,09/22] ada: Fix missing index check with declare expression

Message ID 20240621085819.2485987-9-poulhies@adacore.com
State New
Headers show
Series [COMMITTED,01/22] ada: Spurious style error with mutiple square brackets | expand

Commit Message

Marc Poulhiès June 21, 2024, 8:58 a.m. UTC 
From: Eric Botcazou <ebotcazou@adacore.com>

The Do_Range_Check flag is properly set on the Expression of the EWA node
built for the declare expression, so this instructs Generate_Index_Checks
to look into this Expression.

gcc/ada/

	* checks.adb (Generate_Index_Checks): Add specific treatment for
	index expressions that are N_Expression_With_Actions nodes.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/checks.adb | 36 ++++++++++++++++++++++++++----------
 1 file changed, 26 insertions(+), 10 deletions(-)
diff mbox series

Patch

diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
index bada3dffcbf..c8a0696be67 100644
--- a/gcc/ada/checks.adb
+++ b/gcc/ada/checks.adb
@@ -7248,7 +7248,8 @@  package body Checks is
       Loc   : constant Source_Ptr := Sloc (N);
       A     : constant Node_Id    := Prefix (N);
       A_Ent : constant Entity_Id  := Entity_Of_Prefix;
-      Sub   : Node_Id;
+
+      Expr : Node_Id;
 
    --  Start of processing for Generate_Index_Checks
 
@@ -7294,13 +7295,13 @@  package body Checks is
       --  us to omit the check have already been taken into account in the
       --  setting of the Do_Range_Check flag earlier on.
 
-      Sub := First (Expressions (N));
+      Expr := First (Expressions (N));
 
       --  Handle string literals
 
       if Ekind (Etype (A)) = E_String_Literal_Subtype then
-         if Do_Range_Check (Sub) then
-            Set_Do_Range_Check (Sub, False);
+         if Do_Range_Check (Expr) then
+            Set_Do_Range_Check (Expr, False);
 
             --  For string literals we obtain the bounds of the string from the
             --  associated subtype.
@@ -7310,8 +7311,8 @@  package body Checks is
                 Condition =>
                    Make_Not_In (Loc,
                      Left_Opnd  =>
-                       Convert_To (Base_Type (Etype (Sub)),
-                         Duplicate_Subexpr_Move_Checks (Sub)),
+                       Convert_To (Base_Type (Etype (Expr)),
+                         Duplicate_Subexpr_Move_Checks (Expr)),
                      Right_Opnd =>
                        Make_Attribute_Reference (Loc,
                          Prefix         => New_Occurrence_Of (Etype (A), Loc),
@@ -7330,11 +7331,19 @@  package body Checks is
             Ind     : Pos;
             Num     : List_Id;
             Range_N : Node_Id;
+            Stmt    : Node_Id;
+            Sub     : Node_Id;
 
          begin
             A_Idx := First_Index (Etype (A));
             Ind   := 1;
-            while Present (Sub) loop
+            while Present (Expr) loop
+               if Nkind (Expr) = N_Expression_With_Actions then
+                  Sub := Expression (Expr);
+               else
+                  Sub := Expr;
+               end if;
+
                if Do_Range_Check (Sub) then
                   Set_Do_Range_Check (Sub, False);
 
@@ -7396,7 +7405,7 @@  package body Checks is
                          Expressions    => Num);
                   end if;
 
-                  Insert_Action (N,
+                  Stmt :=
                     Make_Raise_Constraint_Error (Loc,
                       Condition =>
                          Make_Not_In (Loc,
@@ -7404,14 +7413,21 @@  package body Checks is
                              Convert_To (Base_Type (Etype (Sub)),
                                Duplicate_Subexpr_Move_Checks (Sub)),
                            Right_Opnd => Range_N),
-                      Reason => CE_Index_Check_Failed));
+                      Reason => CE_Index_Check_Failed);
+
+                  if Nkind (Expr) = N_Expression_With_Actions then
+                     Append_To (Actions (Expr), Stmt);
+                     Analyze (Stmt);
+                  else
+                     Insert_Action (Expr, Stmt);
+                  end if;
 
                   Checks_Generated.Elements (Ind) := True;
                end if;
 
                Next_Index (A_Idx);
                Ind := Ind + 1;
-               Next (Sub);
+               Next (Expr);
             end loop;
          end;
       end if;