This fixes a corner case for pragma Priority (0) set on the main subprogram.
Does not affect usual platforms.
Tested on x86_64-pc-linux-gnu, committed on trunk
2016-06-16 Tristan Gingold <ging...@adacore.com>
* sem_prag.adb (Analyze_Pragma): Simplify code
for Pragma_Priority.
Index: exp_aggr.adb
===================================================================
--- exp_aggr.adb (revision 237429)
+++ exp_aggr.adb (working copy)
@@ -5433,8 +5433,8 @@
-- STEP 3
- -- Delay expansion for nested aggregates: it will be taken care of
- -- when the parent aggregate is expanded.
+ -- Delay expansion for nested aggregates: it will be taken care of when
+ -- the parent aggregate is expanded.
Parent_Node := Parent (N);
Parent_Kind := Nkind (Parent_Node);
@@ -5524,14 +5524,18 @@
and then Parent_Kind = N_Object_Declaration
and then not
Must_Slide (Etype (Defining_Identifier (Parent_Node)), Typ)
- and then N = Expression (Parent_Node)
+ and then Present (Expression (Parent_Node))
+ and then not Has_Controlled_Component (Typ)
and then not Is_Bit_Packed_Array (Typ)
- and then not Has_Controlled_Component (Typ)
+
+ -- ??? the test for SPARK 05 needs documentation
+
+ and then not Restriction_Check_Required (SPARK_05)
then
In_Place_Assign_OK_For_Declaration := True;
- Tmp := Defining_Identifier (Parent (N));
- Set_No_Initialization (Parent (N));
- Set_Expression (Parent (N), Empty);
+ Tmp := Defining_Identifier (Parent_Node);
+ Set_No_Initialization (Parent_Node);
+ Set_Expression (Parent_Node, Empty);
-- Set kind and type of the entity, for use in the analysis
-- of the subsequent assignments. If the nominal type is not
@@ -5544,10 +5548,10 @@
if not Is_Constrained (Typ) then
Build_Constrained_Type (Positional => False);
- elsif Is_Entity_Name (Object_Definition (Parent (N)))
- and then Is_Constrained (Entity (Object_Definition (Parent (N))))
+ elsif Is_Entity_Name (Object_Definition (Parent_Node))
+ and then Is_Constrained (Entity (Object_Definition (Parent_Node)))
then
- Set_Etype (Tmp, Entity (Object_Definition (Parent (N))));
+ Set_Etype (Tmp, Entity (Object_Definition (Parent_Node)));
else
Set_Size_Known_At_Compile_Time (Typ, False);
Index: sem_prag.adb
===================================================================
--- sem_prag.adb (revision 237433)
+++ sem_prag.adb (working copy)
@@ -18903,22 +18903,15 @@
-- where we ignore the value if out of range.
else
- declare
- Val : constant Uint := Expr_Value (Arg);
- begin
- if not Relaxed_RM_Semantics
- and then
- (Val < 0
- or else Val > Expr_Value (Expression
- (Parent (RTE (RE_Max_Priority)))))
- then
- 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;
+ if not Relaxed_RM_Semantics
+ and then not Is_In_Range (Arg, RTE (RE_Priority))
+ then
+ 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 if;
-- Load an arbitrary entity from System.Tasking.Stages or
