Commit 5ed4ba15 by Arnaud Charlet

[multiple changes]

2016-06-16  Justin Squirek  <squirek@adacore.com>

	* sem_ch3.adb (Analyze_Object_Declaration): Add a missing check
	for optimized aggregate arrays with qualified expressions.
	* exp_aggr.adb (Expand_Array_Aggregate): Fix block and
	conditional statement in charge of deciding whether to perform
	in-place expansion. Specifically, use Parent_Node to jump over
	the qualified expression to the object declaration node. Also,
	a check has been inserted to skip the optimization if SPARK 2005
	is being used in strict adherence to RM 4.3(5).

2016-06-16  Tristan Gingold  <gingold@adacore.com>

	* sem_prag.adb (Analyze_Pragma): Simplify code
	for Pragma_Priority.

From-SVN: r237514
parent c577adb2
2016-06-16 Justin Squirek <squirek@adacore.com>
* sem_ch3.adb (Analyze_Object_Declaration): Add a missing check
for optimized aggregate arrays with qualified expressions.
* exp_aggr.adb (Expand_Array_Aggregate): Fix block and
conditional statement in charge of deciding whether to perform
in-place expansion. Specifically, use Parent_Node to jump over
the qualified expression to the object declaration node. Also,
a check has been inserted to skip the optimization if SPARK 2005
is being used in strict adherence to RM 4.3(5).
2016-06-16 Tristan Gingold <gingold@adacore.com>
* sem_prag.adb (Analyze_Pragma): Simplify code
for Pragma_Priority.
2016-06-16 Eric Botcazou <ebotcazou@adacore.com> 2016-06-16 Eric Botcazou <ebotcazou@adacore.com>
* sem_util.ads (Indexed_Component_Bit_Offset): Declare. * sem_util.ads (Indexed_Component_Bit_Offset): Declare.
......
...@@ -5433,8 +5433,8 @@ package body Exp_Aggr is ...@@ -5433,8 +5433,8 @@ package body Exp_Aggr is
-- STEP 3 -- STEP 3
-- Delay expansion for nested aggregates: it will be taken care of -- Delay expansion for nested aggregates: it will be taken care of when
-- when the parent aggregate is expanded. -- the parent aggregate is expanded.
Parent_Node := Parent (N); Parent_Node := Parent (N);
Parent_Kind := Nkind (Parent_Node); Parent_Kind := Nkind (Parent_Node);
...@@ -5524,14 +5524,18 @@ package body Exp_Aggr is ...@@ -5524,14 +5524,18 @@ package body Exp_Aggr is
and then Parent_Kind = N_Object_Declaration and then Parent_Kind = N_Object_Declaration
and then not and then not
Must_Slide (Etype (Defining_Identifier (Parent_Node)), Typ) Must_Slide (Etype (Defining_Identifier (Parent_Node)), Typ)
and then N = Expression (Parent_Node) and then Present (Expression (Parent_Node))
and then not Is_Bit_Packed_Array (Typ)
and then not Has_Controlled_Component (Typ) and then not Has_Controlled_Component (Typ)
and then not Is_Bit_Packed_Array (Typ)
-- ??? the test for SPARK 05 needs documentation
and then not Restriction_Check_Required (SPARK_05)
then then
In_Place_Assign_OK_For_Declaration := True; In_Place_Assign_OK_For_Declaration := True;
Tmp := Defining_Identifier (Parent (N)); Tmp := Defining_Identifier (Parent_Node);
Set_No_Initialization (Parent (N)); Set_No_Initialization (Parent_Node);
Set_Expression (Parent (N), Empty); Set_Expression (Parent_Node, Empty);
-- Set kind and type of the entity, for use in the analysis -- Set kind and type of the entity, for use in the analysis
-- of the subsequent assignments. If the nominal type is not -- of the subsequent assignments. If the nominal type is not
...@@ -5544,10 +5548,10 @@ package body Exp_Aggr is ...@@ -5544,10 +5548,10 @@ package body Exp_Aggr is
if not Is_Constrained (Typ) then if not Is_Constrained (Typ) then
Build_Constrained_Type (Positional => False); Build_Constrained_Type (Positional => False);
elsif Is_Entity_Name (Object_Definition (Parent (N))) elsif Is_Entity_Name (Object_Definition (Parent_Node))
and then Is_Constrained (Entity (Object_Definition (Parent (N)))) and then Is_Constrained (Entity (Object_Definition (Parent_Node)))
then then
Set_Etype (Tmp, Entity (Object_Definition (Parent (N)))); Set_Etype (Tmp, Entity (Object_Definition (Parent_Node)));
else else
Set_Size_Known_At_Compile_Time (Typ, False); Set_Size_Known_At_Compile_Time (Typ, False);
......
...@@ -3471,7 +3471,7 @@ package body Sem_Ch3 is ...@@ -3471,7 +3471,7 @@ package body Sem_Ch3 is
-- In case of aggregates we must also take care of the correct -- In case of aggregates we must also take care of the correct
-- initialization of nested aggregates bug this is done at the -- initialization of nested aggregates bug this is done at the
-- point of the analysis of the aggregate (see sem_aggr.adb). -- point of the analysis of the aggregate (see sem_aggr.adb) ???
if Present (Expression (N)) if Present (Expression (N))
and then Nkind (Expression (N)) = N_Aggregate and then Nkind (Expression (N)) = N_Aggregate
...@@ -4038,7 +4038,10 @@ package body Sem_Ch3 is ...@@ -4038,7 +4038,10 @@ package body Sem_Ch3 is
elsif Is_Array_Type (T) elsif Is_Array_Type (T)
and then No_Initialization (N) and then No_Initialization (N)
and then Nkind (Original_Node (E)) = N_Aggregate and then (Nkind (Original_Node (E)) = N_Aggregate
or else (Nkind (Original_Node (E)) = N_Qualified_Expression
and then Nkind (Original_Node (Expression
(Original_Node (E)))) = N_Aggregate))
then then
if not Is_Entity_Name (Object_Definition (N)) then if not Is_Entity_Name (Object_Definition (N)) then
Act_T := Etype (E); Act_T := Etype (E);
......
...@@ -18903,22 +18903,15 @@ package body Sem_Prag is ...@@ -18903,22 +18903,15 @@ package body Sem_Prag is
-- where we ignore the value if out of range. -- where we ignore the value if out of range.
else else
declare if not Relaxed_RM_Semantics
Val : constant Uint := Expr_Value (Arg); and then not Is_In_Range (Arg, RTE (RE_Priority))
begin then
if not Relaxed_RM_Semantics Error_Pragma_Arg
and then ("main subprogram priority is out of range", Arg1);
(Val < 0 else
or else Val > Expr_Value (Expression Set_Main_Priority
(Parent (RTE (RE_Max_Priority))))) (Current_Sem_Unit, UI_To_Int (Expr_Value (Arg)));
then end if;
Error_Pragma_Arg
("main subprogram priority is out of range", Arg1);
else
Set_Main_Priority
(Current_Sem_Unit, UI_To_Int (Expr_Value (Arg)));
end if;
end;
end if; end if;
-- Load an arbitrary entity from System.Tasking.Stages or -- Load an arbitrary entity from System.Tasking.Stages or
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment