diff mbox

[Ada] Use System.Priority to validate pragma Priority value for subprogram.

Message ID 20160616102319.GA66732@adacore.com
State New
Headers show

Commit Message

Arnaud Charlet June 16, 2016, 10:23 a.m. UTC
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  <gingold@adacore.com>

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

Patch

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