From d3db6e37b6c61ccc55b51e23de2b95d3ee6447d2 Mon Sep 17 00:00:00 2001 From: charlet Date: Fri, 31 Jan 2014 15:59:59 +0000 Subject: [PATCH] 2014-01-31 Robert Dewar * gnat_ugn.texi: Minor update. * gnat_rm.texi: Add example to Restriction_Warnings documentation. * exp_util.adb: Minor reformatting. 2014-01-31 Ed Schonberg * exp_ch9.adb (Expand_Entry_Barrier): Warn if the barrier depends on data that is not private to the protected object, and potentially modifiable in unsynchronized fashion. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@207357 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/ChangeLog | 12 ++++++++++ gcc/ada/exp_ch9.adb | 55 ++++++++++++++++++++++++++++++++++++++++++- gcc/ada/exp_util.adb | 17 ++++++------- gcc/ada/gnat_rm.texi | 20 ++++++++++++++++ gcc/ada/gnat_ugn.texi | 4 +++- 5 files changed, 98 insertions(+), 10 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 27d0c3fff13e..b46a2d50dbd7 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,15 @@ +2014-01-31 Robert Dewar + + * gnat_ugn.texi: Minor update. + * gnat_rm.texi: Add example to Restriction_Warnings documentation. + * exp_util.adb: Minor reformatting. + +2014-01-31 Ed Schonberg + + * exp_ch9.adb (Expand_Entry_Barrier): Warn if the barrier + depends on data that is not private to the protected object, + and potentially modifiable in unsynchronized fashion. + 2014-01-31 Yannick Moy * erroutc.adb (Validate_Specific_Warnings): Remove special case for diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index 1f9e05bd8754..94674378f8c4 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -6180,10 +6180,60 @@ package body Exp_Ch9 is Condition (Entry_Body_Formal_Part (N)); Prot : constant Entity_Id := Scope (Ent); Spec_Decl : constant Node_Id := Parent (Prot); - Func : Node_Id; + Func : Entity_Id; B_F : Node_Id; Body_Decl : Node_Id; + function Is_Global_Entity (N : Node_Id) return Traverse_Result; + -- Check whether entity in Barrier is external to protected type. + -- If so, barrier may not be properly synchronized. + + ---------------------- + -- Is_Global_Entity -- + ---------------------- + + function Is_Global_Entity (N : Node_Id) return Traverse_Result is + E : Entity_Id; + S : Entity_Id; + begin + if Is_Entity_Name (N) and then Present (Entity (N)) then + E := Entity (N); + S := Scope (E); + + if Ekind (E) = E_Variable then + if Scope (E) = Func then + null; + + -- A protected call from a barrier to another object is ok + + elsif Ekind (Etype (E)) = E_Protected_Type then + null; + + -- If the variable is within the package body we consider + -- this safe. This is a common (if dubious) idiom. + + elsif S = Scope (Prot) + and then (Ekind (S) = E_Package + or else Ekind (S) = E_Generic_Package) + and then Nkind (Parent (E)) = N_Object_Declaration + and then Nkind (Parent (Parent (E))) = N_Package_Body + then + null; + + else + Error_Msg_N ("potentially unsynchronized barrier ?", N); + Error_Msg_N ("!& should be private component of type?", N); + end if; + end if; + end if; + + return OK; + end Is_Global_Entity; + + procedure Check_Unprotected_Barrier is + new Traverse_Proc (Is_Global_Entity); + -- Start of processing for Expand_Entry_Barrier + begin if No_Run_Time_Mode then Error_Msg_CRT ("entry barrier", N); @@ -6268,8 +6318,11 @@ package body Exp_Ch9 is end if; -- It is not a boolean variable or literal, so check the restriction + -- and otherwise emit warning if barrier contains global entities and + -- is thus potentially unsynchronized. Check_Restriction (Simple_Barriers, Cond); + Check_Unprotected_Barrier (Cond); end Expand_Entry_Barrier; ------------------------------ diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index c79c06739fa3..7c1c75c8bf33 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -523,9 +523,9 @@ package body Exp_Util is -- the expander introduces several levels of address arithmetic -- to perform dispatch table displacement. In this scenario the -- object appears as: - -- + -- Tag_Ptr (Base_Address ('Address)) - -- + -- Detect this case and utilize the whole expression as the -- "object" since it now points to the proper dispatch table. @@ -831,8 +831,9 @@ package body Exp_Util is and then Is_Type (Entity (Temp)) then Flag_Expr := - New_Reference_To (Boolean_Literals - (Needs_Finalization (Entity (Temp))), Loc); + New_Reference_To + (Boolean_Literals + (Needs_Finalization (Entity (Temp))), Loc); -- The allocation / deallocation of a class-wide object relies -- on a runtime check to determine whether the object is truly @@ -844,11 +845,11 @@ package body Exp_Util is -- Detect a special case where interface class-wide types -- are involved as the object appears as: - -- + -- Tag_Ptr (Base_Address ('Address)) - -- + -- The expression already yields the proper tag, generate: - -- + -- Temp.all if Is_RTE (Etype (Temp), RE_Tag_Ptr) then @@ -858,7 +859,7 @@ package body Exp_Util is -- In the default case, obtain the tag of the object about -- to be allocated / deallocated. Generate: - -- + -- Temp'Tag else diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index abb00383157a..19e22cee98a4 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -6026,6 +6026,26 @@ the compiler checks for violations of the restriction, but generates a warning message rather than an error message if the restriction is violated. +One use of this is in situations where you want to know +about violations of a restriction, but you want to ignore some of +these violations. Consider this example, where you want to set +Ada_95 mode and enable style checks, but you want to know about +any other use of implementation pragmas: + +@smallexample @c ada +pragma Restriction_Warnings (No_Implementation_Pragmas); +pragma Warnings (Off, "violation of*No_Implementation_Pragmas*"); +pragma Ada_95; +pragma Style_Checks ("2bfhkM160"); +pragma Warnings (On, "violation of*No_Implementation_Pragmas*"); +@end smallexample + +@noindent +By including the above lines in a configuration pragmas file, +the Ada_95 and Style_Checks pragmas are accepted without +generating a warning, but any other use of implementation +defined pragmas will cause a warning to be generated. + @node Pragma Share_Generic @unnumberedsec Pragma Share_Generic @findex Share_Generic diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index b6d05cdb7af4..af3d2c2a2215 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -15262,7 +15262,7 @@ Options: -mdir -- generate one .xml file for each Ada source file, in directory @file{dir}. (Default is to generate the XML to standard output.) --q -- debugging version, with interspersed source, and a more +--compact -- debugging version, with interspersed source, and a more compact representation of "sloc". This version does not conform to any schema. @@ -15270,6 +15270,8 @@ Options: directories to search for dependencies You can also set the ADA_INCLUDE_PATH environment variable for this. +-q -- quiet + -v -- verbose (print out the command line options, and the names of output files as they are generated). -- 2.47.2