Patchwork [Ada] Ada 2012 legality checks on uses of names of protected procedures

login
register
mail settings
Submitter Arnaud Charlet
Date Oct. 1, 2012, 8:24 a.m.
Message ID <20121001082452.GA26799@adacore.com>
Download mbox | patch
Permalink /patch/188237/
State New
Headers show

Comments

Arnaud Charlet - Oct. 1, 2012, 8:24 a.m.
Ada 2012 AI05-0225 clarifies that most uses of the  names of protected
procedures and entries require that the target object (explicit or implicit)
be a variable. This applies to calls, generic actuals, and prefixes of 'Access.
It applies in particular to such uses within the body a protected function.

Example is ACATS Test b950001.

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

2012-10-01  Ed Schonberg  <schonberg@adacore.com>

	* sem_util.ads sem_util.adb (Check_Internal_Protected_Use):
	reject use of protected procedure or entry within the body of
	a protected function of the same protected type, when usage is
	a call, an actual in an instantiation, a or prefix of 'Access.
	* sem_ch8.adb (Analyze_Subprogram_Renaming): Verify that target
	object in renaming of protected procedure is a variable, and
	apply Check_Internal_Protected_Use.
	* sem_res.adb (Analyze_Call, Analyze_Entry_Call): apply
	Check_Internal_Protected_Use rather than on-line code.
	* sem_attr.adb (Analyze_Access_Attribute): Verify that target
	object in accsss to protected procedure is a variable, and apply
	Check_Internal_Protected_Use.

Patch

Index: sem_util.adb
===================================================================
--- sem_util.adb	(revision 191890)
+++ sem_util.adb	(working copy)
@@ -1191,6 +1191,50 @@ 
       end if;
    end Check_Implicit_Dereference;
 
+   ----------------------------------
+   -- Check_Internal_Protected_Use --
+   ----------------------------------
+
+   procedure Check_Internal_Protected_Use (N : Node_Id; Nam : Entity_Id) is
+      S    : Entity_Id;
+      Prot : Entity_Id;
+
+   begin
+      S := Current_Scope;
+      while Present (S) loop
+         if S = Standard_Standard then
+            return;
+
+         elsif Ekind (S) = E_Function
+           and then Ekind (Scope (S)) = E_Protected_Type
+         then
+            Prot := Scope (S);
+            exit;
+         end if;
+
+         S := Scope (S);
+      end loop;
+
+      if Scope (Nam) = Prot and then Ekind (Nam) /= E_Function then
+         if Nkind (N) = N_Subprogram_Renaming_Declaration then
+            Error_Msg_N
+              ("within protected function cannot use protected "
+               & "procedure in renaming or as generic actual", N);
+
+         elsif Nkind (N) = N_Attribute_Reference then
+            Error_Msg_N
+              ("within protected function cannot take access of "
+               & " protected procedure", N);
+
+         else
+            Error_Msg_N
+              ("within protected function, protected object is constant", N);
+            Error_Msg_N
+              ("\cannot call operation that may modify it", N);
+         end if;
+      end if;
+   end Check_Internal_Protected_Use;
+
    ---------------------------------------
    -- Check_Later_Vs_Basic_Declarations --
    ---------------------------------------
Index: sem_util.ads
===================================================================
--- sem_util.ads	(revision 191888)
+++ sem_util.ads	(working copy)
@@ -170,6 +170,12 @@ 
    --  checks whether T is a reference type, and if so it adds an interprettion
    --  to Expr whose type is the designated type of the reference_discriminant.
 
+   procedure Check_Internal_Protected_Use (N : Node_Id; Nam : Entity_Id);
+   --  Within a protected function, the current object is a constant, and
+   --  internal calls to a procedure or entry are illegal. Similarly, other
+   --  uses of a protected procedure in a renaming or a generic instantiation
+   --  in the context of a protected function are illegal (AI05-0225).
+
    procedure Check_Later_Vs_Basic_Declarations
      (Decls          : List_Id;
       During_Parsing : Boolean);
Index: sem_res.adb
===================================================================
--- sem_res.adb	(revision 191888)
+++ sem_res.adb	(working copy)
@@ -5314,15 +5314,7 @@ 
       --  Check that this is not a call to a protected procedure or entry from
       --  within a protected function.
 
-      if Ekind (Current_Scope) = E_Function
-        and then Ekind (Scope (Current_Scope)) = E_Protected_Type
-        and then Ekind (Nam) /= E_Function
-        and then Scope (Nam) = Scope (Current_Scope)
-      then
-         Error_Msg_N ("within protected function, protected " &
-           "object is constant", N);
-         Error_Msg_N ("\cannot call operation that may modify it", N);
-      end if;
+      Check_Internal_Protected_Use (N, Nam);
 
       --  Freeze the subprogram name if not in a spec-expression. Note that we
       --  freeze procedure calls as well as function calls. Procedure calls are
@@ -6732,6 +6724,7 @@ 
       end if;
 
       Resolve_Actuals (N, Nam);
+      Check_Internal_Protected_Use (N, Nam);
 
       --  Create a call reference to the entry
 
Index: sem_attr.adb
===================================================================
--- sem_attr.adb	(revision 191888)
+++ sem_attr.adb	(working copy)
@@ -9003,6 +9003,21 @@ 
                then
                   Accessibility_Message;
                   return;
+
+               --  AI05-0225: If the context is not an access to protected
+               --  function, the prefix must be a variable, given that it may
+               --  be used subsequently in a protected call.
+
+               elsif Nkind (P) = N_Selected_Component
+                 and then not Is_Variable (Prefix (P))
+                 and then Ekind (Entity (Selector_Name (P))) /= E_Function
+               then
+                  Error_Msg_N
+                    ("target object of access to protected procedure "
+                      & "must be variable", N);
+
+               elsif Is_Entity_Name (P) then
+                  Check_Internal_Protected_Use (N, Entity (P));
                end if;
 
             elsif Ekind_In (Btyp, E_Access_Subprogram_Type,
Index: sem_ch8.adb
===================================================================
--- sem_ch8.adb	(revision 191888)
+++ sem_ch8.adb	(working copy)
@@ -1456,9 +1456,10 @@ 
       New_S   : Entity_Id;
       Is_Body : Boolean)
    is
-      Nam   : constant Node_Id := Name (N);
-      Sel   : constant Node_Id := Selector_Name (Nam);
-      Old_S : Entity_Id;
+      Nam       : constant Node_Id := Name (N);
+      Sel       : constant Node_Id := Selector_Name (Nam);
+      Is_Actual : constant Boolean := Present (Corresponding_Formal_Spec (N));
+      Old_S     : Entity_Id;
 
    begin
       if Entity (Sel) = Any_Id then
@@ -1489,8 +1490,8 @@ 
 
          Inherit_Renamed_Profile (New_S, Old_S);
 
-         --  The prefix can be an arbitrary expression that yields a task type,
-         --  so it must be resolved.
+         --  The prefix can be an arbitrary expression that yields a task or
+         --  protected object, so it must be resolved.
 
          Resolve (Prefix (Nam), Scope (Old_S));
       end if;
@@ -1498,6 +1499,24 @@ 
       Set_Convention (New_S, Convention (Old_S));
       Set_Has_Completion (New_S, Inside_A_Generic);
 
+      --  AI05-0225: If the renamed entity is a procedure or entry of a
+      --  protected object, the target object must be a variable.
+
+      if Ekind (Scope (Old_S)) in Protected_Kind
+        and then Ekind (New_S) = E_Procedure
+        and then not Is_Variable (Prefix (Nam))
+      then
+         if Is_Actual then
+            Error_Msg_N
+              ("target object of protected operation used as actual for "
+               & "formal procedure must be a variable", Nam);
+         else
+            Error_Msg_N
+              ("target object of protected operation renamed as procedure, "
+               & "must be a variable", Nam);
+         end if;
+      end if;
+
       if Is_Body then
          Check_Frozen_Renaming (N, New_S);
       end if;
@@ -2572,6 +2591,8 @@ 
             Generate_Reference (Old_S, Nam);
          end if;
 
+         Check_Internal_Protected_Use (N, Old_S);
+
          --  For a renaming-as-body, require subtype conformance, but if the
          --  declaration being completed has not been frozen, then inherit the
          --  convention of the renamed subprogram prior to checking conformance