sem_aggr.adb (New_Copy_Tree_And_Copy_Dimensions): New routine.

2012-10-01  Vincent Pucci  <pucci@adacore.com>

	* sem_aggr.adb (New_Copy_Tree_And_Copy_Dimensions): New routine.
	(Resolve_Record_Aggregate): New_Copy_Tree calls replaced by
	New_Copy_Tree_And_Copy_Dimensions calls. Move_Dimensions call
	replaced by Copy_Dimensions call.
	* sem_dim.adb (Analyze_Dimension_Component_Declaration): Don't
	remove the dimensions of expression in component declaration anymore.
	(Copy_Dimensions): New routine.
	(Move_Dimensions): Add call to Copy_Dimensions.
	* sem_dim.ads (Copy_Dimensions): New routine.
	(Move_Dimensions): Spec moved to body of Sem_Dim.

From-SVN: r191922

gcc/ada/ChangeLog

+2012-10-01  Vincent Pucci  <pucci@adacore.com>
+
+	* sem_aggr.adb (New_Copy_Tree_And_Copy_Dimensions): New routine.
+	(Resolve_Record_Aggregate): New_Copy_Tree calls replaced by
+	New_Copy_Tree_And_Copy_Dimensions calls. Move_Dimensions call
+	replaced by Copy_Dimensions call.
+	* sem_dim.adb (Analyze_Dimension_Component_Declaration): Don't
+	remove the dimensions of expression in component declaration anymore.
+	(Copy_Dimensions): New routine.
+	(Move_Dimensions): Add call to Copy_Dimensions.
+	* sem_dim.ads (Copy_Dimensions): New routine.
+	(Move_Dimensions): Spec moved to body of Sem_Dim.
+
 2012-10-01  Ed Schonberg  <schonberg@adacore.com>
 
 	* checks.adb (Apply_Predicate_Check): If the predicate is a

gcc/ada/sem_aggr.adb

@@ -2933,6 +2933,14 @@ package body Sem_Aggr is
       --  An error message is emitted if the components taking their value from
       --  the others choice do not have same type.
 
+      function New_Copy_Tree_And_Copy_Dimensions
+        (Source    : Node_Id;
+         Map       : Elist_Id   := No_Elist;
+         New_Sloc  : Source_Ptr := No_Location;
+         New_Scope : Entity_Id  := Empty) return Node_Id;
+      --  Same as New_Copy_Tree (defined in Sem_Util), except that this routine
+      --  also copies the dimensions of Source to the returned node.
+
       procedure Resolve_Aggr_Expr (Expr : Node_Id; Component : Node_Id);
       --  Analyzes and resolves expression Expr against the Etype of the
       --  Component. This routine also applies all appropriate checks to Expr.
@@ -3134,7 +3142,7 @@ package body Sem_Aggr is
 
                         if Expander_Active then
                            return
-                             New_Copy_Tree
+                             New_Copy_Tree_And_Copy_Dimensions
                                (Expression (Parent (Compon)),
                                 New_Sloc => Sloc (Assoc));
                         else
@@ -3153,7 +3161,9 @@ package body Sem_Aggr is
                         Others_Etype := Etype (Compon);
 
                         if Expander_Active then
-                           return New_Copy_Tree (Expression (Assoc));
+                           return
+                             New_Copy_Tree_And_Copy_Dimensions
+                               (Expression (Assoc));
                         else
                            return Expression (Assoc);
                         end if;
@@ -3189,18 +3199,20 @@ package body Sem_Aggr is
                         --  order to create a proper association for the
                         --  expanded aggregate.
 
-                        Expr := New_Copy_Tree (Expression (Parent (Compon)));
-
                         --  Component may have no default, in which case the
                         --  expression is empty and the component is default-
                         --  initialized, but an association for the component
                         --  exists, and it is not covered by an others clause.
 
-                        return Expr;
+                        return
+                          New_Copy_Tree_And_Copy_Dimensions
+                            (Expression (Parent (Compon)));
 
                      else
                         if Present (Next (Selector_Name)) then
-                           Expr := New_Copy_Tree (Expression (Assoc));
+                           Expr :=
+                             New_Copy_Tree_And_Copy_Dimensions
+                               (Expression (Assoc));
                         else
                            Expr := Expression (Assoc);
                         end if;
@@ -3225,6 +3237,25 @@ package body Sem_Aggr is
          return Expr;
       end Get_Value;
 
+      ---------------------------------------
+      -- New_Copy_Tree_And_Copy_Dimensions --
+      ---------------------------------------
+
+      function New_Copy_Tree_And_Copy_Dimensions
+        (Source    : Node_Id;
+         Map       : Elist_Id   := No_Elist;
+         New_Sloc  : Source_Ptr := No_Location;
+         New_Scope : Entity_Id  := Empty) return Node_Id
+      is
+         New_Copy : constant Node_Id :=
+                      New_Copy_Tree (Source, Map, New_Sloc, New_Scope);
+      begin
+         --  Move the dimensions of Source to New_Copy
+
+         Copy_Dimensions (Source, New_Copy);
+         return New_Copy;
+      end New_Copy_Tree_And_Copy_Dimensions;
+
       -----------------------
       -- Resolve_Aggr_Expr --
       -----------------------
@@ -3391,7 +3422,7 @@ package body Sem_Aggr is
             --  Since New_Expr is not gonna be analyzed later on, we need to
             --  propagate here the dimensions form Expr to New_Expr.
 
-            Move_Dimensions (Expr, New_Expr);
+            Copy_Dimensions (Expr, New_Expr);
 
          else
             New_Expr := Expr;
@@ -3986,7 +4017,7 @@ package body Sem_Aggr is
                  and then Present (Expression (Parent (Component)))
                then
                   Expr :=
-                    New_Copy_Tree
+                    New_Copy_Tree_And_Copy_Dimensions
                       (Expression (Parent (Component)),
                        New_Scope => Current_Scope,
                        New_Sloc  => Sloc (N));

gcc/ada/sem_dim.adb

@@ -336,6 +336,9 @@ package body Sem_Dim is
    function Is_Invalid (Position : Dimension_Position) return Boolean;
    --  Return True if Pos denotes the invalid position
 
+   procedure Move_Dimensions (From : Node_Id; To : Node_Id);
+   --  Copy dimension vector of From to To and delete dimension vector of From
+
    procedure Remove_Dimensions (N : Node_Id);
    --  Remove the dimension vector of node N
 
@@ -1718,10 +1721,6 @@ package body Sem_Dim is
                Error_Dim_Msg_For_Component_Declaration (N, Etyp, Expr);
             end if;
          end if;
-
-         --  Removal of dimensions in expression
-
-         Remove_Dimensions (Expr);
       end if;
    end Analyze_Dimension_Component_Declaration;
 
@@ -2199,6 +2198,25 @@ package body Sem_Dim is
       end case;
    end Analyze_Dimension_Unary_Op;
 
+   ---------------------
+   -- Copy_Dimensions --
+   ---------------------
+
+   procedure Copy_Dimensions (From, To : Node_Id) is
+      Dims_Of_From : constant Dimension_Type := Dimensions_Of (From);
+
+   begin
+      if Ada_Version < Ada_2012 then
+         return;
+      end if;
+
+      --  Copy the dimension of 'From to 'To'
+
+      if Exists (Dims_Of_From) then
+         Set_Dimensions (To, Dims_Of_From);
+      end if;
+   end Copy_Dimensions;
+
    --------------------------
    -- Create_Rational_From --
    --------------------------
@@ -3221,8 +3239,6 @@ package body Sem_Dim is
    ---------------------
 
    procedure Move_Dimensions (From, To : Node_Id) is
-      Dims_Of_From : constant Dimension_Type := Dimensions_Of (From);
-
    begin
       if Ada_Version < Ada_2012 then
          return;
@@ -3230,10 +3246,8 @@ package body Sem_Dim is
 
       --  Copy the dimension of 'From to 'To' and remove dimension of 'From'
 
-      if Exists (Dims_Of_From) then
-         Set_Dimensions (To, Dims_Of_From);
-         Remove_Dimensions (From);
-      end if;
+      Copy_Dimensions   (From, To);
+      Remove_Dimensions (From);
    end Move_Dimensions;
 
    ------------

gcc/ada/sem_dim.ads

@@ -162,6 +162,9 @@ package Sem_Dim is
    --  For sub spec N, issue a warning for each dimensioned formal with a
    --  literal default value in the list of formals Formals.
 
+   procedure Copy_Dimensions (From, To : Node_Id);
+   --  Copy dimension vector of From to To.
+
    procedure Eval_Op_Expon_For_Dimensioned_Type
      (N    : Node_Id;
       Btyp : Entity_Id);
@@ -183,9 +186,6 @@ package Sem_Dim is
    --  Return True if N is a package instantiation of System.Dim.Integer_IO or
    --  of System.Dim.Float_IO.
 
-   procedure Move_Dimensions (From : Node_Id; To : Node_Id);
-   --  Copy dimension vector of From to To, delete dimension vector of From
-
    procedure Remove_Dimension_In_Statement (Stmt : Node_Id);
    --  Remove the dimensions associated with Stmt