https://gcc.gnu.org/g:02263316169d4299df24ef91b4d469d3a3d50220
commit r15-1313-g02263316169d4299df24ef91b4d469d3a3d50220
Author: Javier Miranda <mira...@adacore.com>
Date: Thu May 9 21:48:18 2024 +0000
ada: Missing initialization of multidimensional array using sliding
When a multidimensional array is initialized with an array
aggregate, and inner dimensions of the array are initialized
with array subaggregates using sliding, the code generated
by the compiler does not initialize the inner dimensions
of the array.
gcc/ada/
* exp_aggr.adb (Must_Slide): Add missing support for
multidimensional arrays.
Diff:
---
gcc/ada/exp_aggr.adb | 54 ++++++++++++++++++++++++++++++++--------------------
1 file changed, 33 insertions(+), 21 deletions(-)
diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index 796b0f1e0de1..2686f5b3b826 100644
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -154,8 +154,8 @@ package body Exp_Aggr is
-- case the aggregate must slide, and we must introduce an intermediate
-- temporary to hold it.
--
- -- The same holds in an assignment to one-dimensional array of arrays,
- -- when a component may be given with bounds that differ from those of the
+ -- The same holds in an assignment to multi-dimensional arrays, when
+ -- components may be given with bounds that differ from those of the
-- component type.
function Number_Of_Choices (N : Node_Id) return Nat;
@@ -9550,32 +9550,44 @@ package body Exp_Aggr is
elsif Is_Others_Aggregate (Aggr) then
return False;
- else
- -- Sliding can only occur along the first dimension
- -- If any the bounds of non-static sliding is required
- -- to force potential range checks.
+ -- Check if sliding is required
+ else
declare
- Bounds1 : constant Range_Nodes :=
- Get_Index_Bounds (First_Index (Typ));
- Bounds2 : constant Range_Nodes :=
- Get_Index_Bounds (First_Index (Obj_Type));
+ Obj_Index : Node_Id := First_Index (Obj_Type);
+ Obj_Bounds : Range_Nodes;
+ Typ_Index : Node_Id := First_Index (Typ);
+ Typ_Bounds : Range_Nodes;
begin
- if not Is_OK_Static_Expression (Bounds1.First) or else
- not Is_OK_Static_Expression (Bounds2.First) or else
- not Is_OK_Static_Expression (Bounds1.Last) or else
- not Is_OK_Static_Expression (Bounds2.Last)
- then
- return True;
+ while Present (Typ_Index) loop
+ pragma Assert (Present (Obj_Index));
- else
- return Expr_Value (Bounds1.First) /= Expr_Value (Bounds2.First)
- or else
- Expr_Value (Bounds1.Last) /= Expr_Value (Bounds2.Last);
- end if;
+ Typ_Bounds := Get_Index_Bounds (Typ_Index);
+ Obj_Bounds := Get_Index_Bounds (Obj_Index);
+
+ if not Is_OK_Static_Expression (Typ_Bounds.First) or else
+ not Is_OK_Static_Expression (Obj_Bounds.First) or else
+ not Is_OK_Static_Expression (Typ_Bounds.Last) or else
+ not Is_OK_Static_Expression (Obj_Bounds.Last)
+ then
+ return True;
+
+ elsif Expr_Value (Typ_Bounds.First)
+ /= Expr_Value (Obj_Bounds.First)
+ or else Expr_Value (Typ_Bounds.Last)
+ /= Expr_Value (Obj_Bounds.Last)
+ then
+ return True;
+ end if;
+
+ Next_Index (Typ_Index);
+ Next_Index (Obj_Index);
+ end loop;
end;
end if;
+
+ return False;
end Must_Slide;
---------------------
