From: Hristian Kirtchev Date: Thu, 11 Jan 2018 08:55:52 +0000 (+0000) Subject: [Ada] Detection of illegal constituent assignments X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=5efc1c00c88b7758d628ce8e2d1e6d54d5996216;p=gcc.git [Ada] Detection of illegal constituent assignments This patch modifies the analysis of assignment statements to detect an illegal attempt to alter the value of single protected type Part_Of constituent when inside a protected function. 2018-01-11 Hristian Kirtchev gcc/ada/ * sem_ch5.adb (Analyze_Assignment): Assignments to variables that act as Part_Of consituents of single protected types are illegal when they take place inside a protected function. (Diagnose_Non_Variable_Lhs): Use Within_Function to check for an enclosing function. (Is_Protected_Part_Of_Constituent): New routine. (Within_Function): New routine. gcc/testsuite/ * gnat.dg/protected_func.adb, gnat.dg/protected_func.ads: New testcase. From-SVN: r256520 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 415a42c3efa..cd66210109b 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,13 @@ +2018-01-11 Hristian Kirtchev + + * sem_ch5.adb (Analyze_Assignment): Assignments to variables that act + as Part_Of consituents of single protected types are illegal when they + take place inside a protected function. + (Diagnose_Non_Variable_Lhs): Use Within_Function to check for an + enclosing function. + (Is_Protected_Part_Of_Constituent): New routine. + (Within_Function): New routine. + 2018-01-11 Arnaud Charlet Bump copyright notices to 2018. diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index 6d46d659f9e..b94c9e8c17b 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -107,6 +107,11 @@ package body Sem_Ch5 is -- N is the node for the left hand side of an assignment, and it is not -- a variable. This routine issues an appropriate diagnostic. + function Is_Protected_Part_Of_Constituent + (Nod : Node_Id) return Boolean; + -- Determine whether arbitrary node Nod denotes a Part_Of constituent of + -- a single protected type. + procedure Kill_Lhs; -- This is called to kill current value settings of a simple variable -- on the left hand side. We call it if we find any error in analyzing @@ -141,6 +146,10 @@ package body Sem_Ch5 is -- assignment statements that are really initializations. These are -- marked No_Ctrl_Actions. + function Within_Function return Boolean; + -- Determine whether the current scope is a function or appears within + -- one. + ------------------------------- -- Diagnose_Non_Variable_Lhs -- ------------------------------- @@ -170,11 +179,7 @@ package body Sem_Ch5 is -- of single protected types, the private component appears -- directly. - elsif (Is_Prival (Ent) - and then - (Ekind (Current_Scope) = E_Function - or else Ekind (Enclosing_Dynamic_Scope - (Current_Scope)) = E_Function)) + elsif (Is_Prival (Ent) and then Within_Function) or else (Ekind (Ent) = E_Component and then Is_Protected_Type (Scope (Ent))) @@ -222,6 +227,39 @@ package body Sem_Ch5 is Error_Msg_N ("left hand side of assignment must be a variable", N); end Diagnose_Non_Variable_Lhs; + -------------------------------------- + -- Is_Protected_Part_Of_Constituent -- + -------------------------------------- + + function Is_Protected_Part_Of_Constituent + (Nod : Node_Id) return Boolean + is + Encap_Id : Entity_Id; + Var_Id : Entity_Id; + + begin + -- Abstract states and variables may act as Part_Of constituents of + -- single protected types, however only variables can be modified by + -- an assignment. + + if Is_Entity_Name (Nod) then + Var_Id := Entity (Nod); + + if Present (Var_Id) and then Ekind (Var_Id) = E_Variable then + Encap_Id := Encapsulating_State (Var_Id); + + -- To qualify, the node must denote a reference to a variable + -- whose encapsulating state is a single protected object. + + return + Present (Encap_Id) + and then Is_Single_Protected_Object (Encap_Id); + end if; + end if; + + return False; + end Is_Protected_Part_Of_Constituent; + -------------- -- Kill_Lhs -- -------------- @@ -386,6 +424,24 @@ package body Sem_Ch5 is Insert_Action (N, Obj_Decl); end Transform_BIP_Assignment; + --------------------- + -- Within_Function -- + --------------------- + + function Within_Function return Boolean is + Scop_Id : constant Entity_Id := Current_Scope; + + begin + if Ekind (Scop_Id) = E_Function then + return True; + + elsif Ekind (Enclosing_Dynamic_Scope (Scop_Id)) = E_Function then + return True; + end if; + + return False; + end Within_Function; + -- Local variables T1 : Entity_Id; @@ -713,6 +769,15 @@ package body Sem_Ch5 is ("target of assignment operation must not be abstract", Lhs); end if; + -- Variables which are Part_Of constituents of single protected types + -- behave in similar fashion to protected components. Such variables + -- cannot be modified by protected functions. + + if Is_Protected_Part_Of_Constituent (Lhs) and then Within_Function then + Error_Msg_N + ("protected function cannot modify protected object", Lhs); + end if; + -- Resolution may have updated the subtype, in case the left-hand side -- is a private protected component. Use the correct subtype to avoid -- scoping issues in the back-end. diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index e5d9ddea599..43dcbedcad3 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2018-01-11 Hristian Kirtchev + + * gnat.dg/protected_func.adb, gnat.dg/protected_func.ads: New testcase. + 2018-01-11 Justin Squirek * gnat.dg/expr_func4.adb: New testcase. diff --git a/gcc/testsuite/gnat.dg/protected_func.adb b/gcc/testsuite/gnat.dg/protected_func.adb new file mode 100644 index 00000000000..f3eead4dc26 --- /dev/null +++ b/gcc/testsuite/gnat.dg/protected_func.adb @@ -0,0 +1,13 @@ +-- { dg-do compile } + +package body Protected_Func with SPARK_Mode is + protected body Prot_Obj is + function Prot_Func return Integer is + begin + Comp := Comp + 1; -- { dg-error "protected function cannot modify protected object" } + Part_Of_Constit := Part_Of_Constit + 1; -- { dg-error "protected function cannot modify protected object" } + + return Comp + Part_Of_Constit; + end Prot_Func; + end Prot_Obj; +end Protected_Func; diff --git a/gcc/testsuite/gnat.dg/protected_func.ads b/gcc/testsuite/gnat.dg/protected_func.ads new file mode 100644 index 00000000000..b9d519418cb --- /dev/null +++ b/gcc/testsuite/gnat.dg/protected_func.ads @@ -0,0 +1,9 @@ +package Protected_Func with SPARK_Mode is + protected Prot_Obj is + function Prot_Func return Integer; + private + Comp : Integer := 0; + end Prot_Obj; + + Part_Of_Constit : Integer := 0 with Part_Of => Prot_Obj; +end Protected_Func;