===================================================================
@@ -10198,7 +10198,8 @@
function In_Protected_Function (E : Entity_Id) return Boolean;
-- Within a protected function, the private components of the enclosing
-- protected type are constants. A function nested within a (protected)
- -- procedure is not itself protected.
+ -- procedure is not itself protected. Within the body of a protected
+ -- function the current instance of the protected type is a constant.
function Is_Variable_Prefix (P : Node_Id) return Boolean;
-- Prefixes can involve implicit dereferences, in which case we must
@@ -10210,12 +10211,24 @@
---------------------------
function In_Protected_Function (E : Entity_Id) return Boolean is
- Prot : constant Entity_Id := Scope (E);
+ Prot : Entity_Id;
S : Entity_Id;
begin
+ if Is_Type (E) then
+ -- E is the current instance of a type.
+
+ Prot := E;
+
+ else
+ -- E is an object.
+
+ Prot := Scope (E);
+ end if;
+
if not Is_Protected_Type (Prot) then
return False;
+
else
S := Current_Scope;
while Present (S) and then S /= Prot loop
@@ -10336,9 +10349,14 @@
or else K = E_In_Out_Parameter
or else K = E_Generic_In_Out_Parameter
- -- Current instance of type
+ -- Current instance of type. If this is a protected type, check
+ -- that we are not within the body of one of its protected
+ -- functions.
- or else (Is_Type (E) and then In_Open_Scopes (E))
+ or else (Is_Type (E)
+ and then In_Open_Scopes (E)
+ and then not In_Protected_Function (E))
+
or else (Is_Incomplete_Or_Private_Type (E)
and then In_Open_Scopes (Full_View (E)));
end;
In the body of a protected function, the protected object itself is a constant (not just its components). Compiling p.adb must yield: p.adb:12:20: actual for "It" must be a variable p.adb:18:17: actual for "It" must be a variable procedure P is protected type Prot is function F return integer; private buffer : String (1 .. 100); end; procedure Stack_it (It : in out Prot) is begin null; end; protected body Prot is function F return integer is begin Stack_it (prot); -- ERROR return 15; end; end Prot; procedure Wrapper (It : Prot) is begin Stack_It (It); -- ERROR end; begin null; end; Tested on x86_64-pc-linux-gnu, committed on trunk 2013-10-14 Ed Schonberg <schonberg@adacore.com> * sem_util.adb (Is_Variable, In_Protected_Function): In the body of a protected function, the protected object itself is a constant (not just its components).