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.

1 files changed, 33 insertions, 21 deletions

diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index 796b0f1..2686f5b 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;
 
    ---------------------