[Ada] Missing range checks on the expression for Priority in protected types

Message ID 20130411133833.GA31294@adacore.com
State New
Headers show

Commit Message

Arnaud Charlet April 11, 2013, 1:38 p.m.
This patch fixes a missing check on the priority of a protected type, when
it is set by a pragma or an aspect. A static value for priority that is out
of the bounds of the corresponding System type is an error. A dynamic value
that is out of bounds must raise a runtime exception.

Compiling t.adb must yield:

   t.adb:6:26: warning: value not in range of type "System.Priority"
   t.adb:6:26: warning: "Constraint_Error" will be raised at run time
   t.adb:14:04: value not in range of type "System.Any_Priority"
   t.adb:14:04: static expression fails Constraint_Check

with System; use System;
with Text_IO; use Text_IO;
procedure t is

   task T is
      pragma Priority (2 * Any_Priority'Last);
      entry E;
   end T;
   task body T is
      accept E;

   protected P is
      pragma Priority (2 * Any_Priority'Last);
      procedure Set (To : Boolean);
      function Get return Boolean;
      Value : Boolean;
   end p;

   protected body P is
      procedure Set (To : Boolean) is
         Value := To;
      end Set;

      function Get return Boolean is
         return Value;
      end Get;
   end p;
   P.Set (True);
   pragma Assert (P.Get);
end t;

Tested on x86_64-pc-linux-gnu, committed on trunk

2013-04-11  Ed Schonberg  <schonberg@adacore.com>

	* sem_prag.adb (Analyze_Pragma, case Priority): pre-analyze
	expression with type Any_Priority.
	* exp_ch9.adb (Initialize_Protection): Check that the value
	of the priority expression is within the bounds of the proper
	priority type.


Index: exp_ch9.adb
--- exp_ch9.adb	(revision 197743)
+++ exp_ch9.adb	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2012, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2013, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -13388,6 +13388,7 @@ 
       Args        : List_Id;
       L           : constant List_Id := New_List;
       Has_Entry   : constant Boolean := Has_Entries (Ptyp);
+      Prio_Type   : Entity_Id;
       Restricted  : constant Boolean := Restricted_Profile;
@@ -13456,18 +13457,37 @@ 
                      (First (Pragma_Argument_Associations (Prio_Clause)));
+                  --  Get_Rep_Item returns either priority pragma.
+                  if Pragma_Name (Prio_Clause) = Name_Priority then
+                     Prio_Type := RTE (RE_Any_Priority);
+                  else
+                     Prio_Type := RTE (RE_Interrupt_Priority);
+                  end if;
                --  Attribute definition clause Priority
+                  if Chars (Prio_Clause) = Name_Priority then
+                     Prio_Type := RTE (RE_Any_Priority);
+                  else
+                     Prio_Type := RTE (RE_Interrupt_Priority);
+                  end if;
                   Prio := Expression (Prio_Clause);
                end if;
                --  If priority is a static expression, then we can duplicate it
                --  with no problem and simply append it to the argument list.
+               --  However, it has only be pre-analyzed, so we need to check
+               --  now that it is in the bounds of the priority type.
                if Is_Static_Expression (Prio) then
+                  Set_Analyzed (Prio, False);
                   Append_To (Args,
-                    Duplicate_Subexpr_No_Checks (Prio));
+                    Make_Type_Conversion (Loc,
+                      Subtype_Mark => New_Occurrence_Of (Prio_Type, Loc),
+                      Expression   => Duplicate_Subexpr (Prio)));
                --  Otherwise, the priority may be a per-object expression, if
                --  it depends on a discriminant of the type. In this case,
@@ -13477,18 +13497,13 @@ 
                --  appropriate approach, but that could generate declarations
                --  improperly placed in the enclosing scope.
-               --  Note: Use System.Any_Priority as the expected type for the
-               --  non-static priority expression, in case the expression has
-               --  not been analyzed yet (as occurs for example with pragma
-               --  Interrupt_Priority).
                   Temp := Make_Temporary (Loc, 'R', Prio);
                   Append_To (L,
                      Make_Object_Declaration (Loc,
                         Defining_Identifier => Temp,
                         Object_Definition   =>
-                          New_Occurrence_Of (RTE (RE_Any_Priority), Loc),
+                          New_Occurrence_Of (Prio_Type,  Loc),
                         Expression          => Relocate_Node (Prio)));
                   Append_To (Args, New_Occurrence_Of (Temp, Loc));
Index: sem_prag.adb
--- sem_prag.adb	(revision 197798)
+++ sem_prag.adb	(working copy)
@@ -14521,7 +14521,7 @@ 
                --  described in "Handling of Default and Per-Object
                --  Expressions" in sem.ads.
-               Preanalyze_Spec_Expression (Arg, Standard_Integer);
+               Preanalyze_Spec_Expression (Arg, RTE (RE_Any_Priority));
                if not Is_Static_Expression (Arg) then
                   Check_Restriction (Static_Priorities, Arg);