From: Javier Miranda <mira...@adacore.com>
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.
Tested on x86_64-pc-linux-gnu, committed on master.
---
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 796b0f1e0de..2686f5b3b82 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;
---------------------
--
2.45.1
