===================================================================
@@ -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 --
---------------------------------------
===================================================================
@@ -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);
===================================================================
@@ -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
===================================================================
@@ -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,
===================================================================
@@ -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