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

login
register
mail settings
Submitter Arnaud Charlet
Date April 11, 2013, 1:38 p.m.
Message ID <20130411133833.GA31294@adacore.com>
Download mbox | patch
Permalink /patch/235748/
State New
Headers show

Comments

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
   begin
      accept E;
   end;

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

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

      function Get return Boolean is
      begin
         return Value;
      end Get;
   end p;
begin
   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.

Patch

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;
 
    begin
@@ -13456,18 +13457,37 @@ 
                     Expression
                      (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
 
                else
+                  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).
-
                else
                   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);