procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

sem_aggr.adb (New_Copy_Tree_And_Copy_Dimensions): New routine.

Browse source 
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
This commit is contained in:
Vincent Pucci 2012-10-01 13:23:22 +00:00 • committed by Arnaud Charlet
parent 804fc056d5
commit ba9144840f
4 changed files with 79 additions and 21 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

13
gcc/ada/ChangeLog
View file

@ -1,3 +1,16 @@
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

47
gcc/ada/sem_aggr.adb
View file

@ -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));

34
gcc/ada/sem_dim.adb
View file

@ -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;
------------

6
gcc/ada/sem_dim.ads
View file

@ -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