* gnat_ugn.texi: Minor update.
* gnat_rm.texi: Add example to Restriction_Warnings documentation.
* exp_util.adb: Minor reformatting.
2014-01-31 Ed Schonberg <schonberg@adacore.com>
* 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
+2014-01-31 Robert Dewar <dewar@adacore.com>
+
+ * gnat_ugn.texi: Minor update.
+ * gnat_rm.texi: Add example to Restriction_Warnings documentation.
+ * exp_util.adb: Minor reformatting.
+
+2014-01-31 Ed Schonberg <schonberg@adacore.com>
+
+ * 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 <moy@adacore.com>
* erroutc.adb (Validate_Specific_Warnings): Remove special case for
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);
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;
------------------------------
-- the expander introduces several levels of address arithmetic
-- to perform dispatch table displacement. In this scenario the
-- object appears as:
- --
+
-- Tag_Ptr (Base_Address (<object>'Address))
- --
+
-- Detect this case and utilize the whole expression as the
-- "object" since it now points to the proper dispatch table.
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
-- Detect a special case where interface class-wide types
-- are involved as the object appears as:
- --
+
-- Tag_Ptr (Base_Address (<object>'Address))
- --
+
-- The expression already yields the proper tag, generate:
- --
+
-- Temp.all
if Is_RTE (Etype (Temp), RE_Tag_Ptr) then
-- In the default case, obtain the tag of the object about
-- to be allocated / deallocated. Generate:
- --
+
-- Temp'Tag
else
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
-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.
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).
projects / platform / upstream / linaro-gcc.git / commitdiff