+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
-- 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.
if Expander_Active then
return
- New_Copy_Tree
+ New_Copy_Tree_And_Copy_Dimensions
(Expression (Parent (Compon)),
New_Sloc => Sloc (Assoc));
else
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;
-- 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;
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 --
-----------------------
-- 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;
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));
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
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;
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 --
--------------------------
---------------------
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;
-- 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;
------------
-- 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);
-- 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
projects / thirdparty / gcc.git / commitdiff
