--- gcc/ada/checks.adb +++ gcc/ada/checks.adb @@ -7429,6 +7429,19 @@ package body Checks is return; end if; + -- Entities declared in Lock_free protected types must be treated + -- as volatile, and we must inhibit validity checks to prevent + -- improper constant folding. + + if Is_Entity_Name (Expr) + and then Is_Subprogram (Scope (Entity (Expr))) + and then Present (Protected_Subprogram (Scope (Entity (Expr)))) + and then Uses_Lock_Free + (Scope (Protected_Subprogram (Scope (Entity (Expr))))) + then + return; + end if; + -- If we have a checked conversion, then validity check applies to -- the expression inside the conversion, not the result, since if -- the expression inside is valid, then so is the conversion result. --- /dev/null new file mode 100644 +++ gcc/testsuite/gnat.dg/prot7.adb @@ -0,0 +1,22 @@ +-- { dg-do compile } +-- { dg-options "-gnatwa -gnatVa" } + +package body Prot7 is + protected body Default_Slice is + function Get return Instance_Pointer is + begin + return Default; + end Get; + + procedure Set ( + Discard : in out Boolean; + Slice : in Instance_Pointer + ) is + begin + Discard := Default /= null; + if not Discard then + Default := Slice; + end if; + end Set; + end Default_Slice; +end Prot7; --- /dev/null new file mode 100644 +++ gcc/testsuite/gnat.dg/prot7.ads @@ -0,0 +1,16 @@ +package Prot7 is + type Instance_Pointer is access Integer; + + protected Default_Slice + with Lock_Free + is + function Get return Instance_Pointer; + + procedure Set ( + Discard : in out Boolean; + Slice : in Instance_Pointer + ); + private + Default : Instance_Pointer; + end Default_Slice; +end Prot7;