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 <[email protected]>
* 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.
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
