aboutsummaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
authorJavier Miranda <miranda@adacore.com>2024-05-09 21:48:18 +0000
committerMarc Poulhiès <poulhies@adacore.com>2024-06-14 09:34:18 +0200
commit02263316169d4299df24ef91b4d469d3a3d50220 (patch)
tree45dff9b10ff9f4f3b55eb4be714efb85d0d9c2d0 /gcc
parent464f0cb46a17cd4b941f0b3182323a883c59dcf3 (diff)
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.
Diffstat (limited to 'gcc')
-rw-r--r--gcc/ada/exp_aggr.adb54
1 files 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;
---------------------