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 <schonb...@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).
Index: sem_util.adb =================================================================== --- sem_util.adb (revision 203546) +++ sem_util.adb (working copy) @@ -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;