Commit d3820795 by Javier Miranda Committed by Arnaud Charlet

errout.ads, errout.adb (Get_Ignore_Errors): New subprogram.

2013-01-29  Javier Miranda  <miranda@adacore.com>

	* errout.ads, errout.adb (Get_Ignore_Errors): New subprogram.
	* opt.ads (Warn_On_Overlap): Update documentation.
	* sem_aggr.adb (Resolve_Aggregate, Resolve_Extension_Aggregate):
	Check function writable actuals.
	* sem_ch3.adb (Build_Derived_Record_Type,
	Record_Type_Declaration): Check function writable actuals.
	* sem_ch4.adb (Analyze_Range): Check function writable actuals.
	* sem_ch5.adb (Analyze_Assignment): Remove code of the initial
	implementation of AI05-0144.
	* sem_ch6.adb (Analyze_Function_Return,
	(Analyze_Procedure_Call.Analyze_Call_And_Resolve): Remove code
	of the initial implementation of AI05-0144.
	* sem_res.adb (Resolve): Remove code of the initial implementation.
	(Resolve_Actuals): Call Check_Function_Writable_Actuals and remove call
	of the initial implementation.
	(Resolve_Arithmetic_Op, Resolve_Logical_Op,
	Resolve_Membership_Op): Check function writable actuals.
	* sem_util.ad[sb] (Actuals_In_Call): Removed
	(Check_Order_Dependence): Removed (Save_Actual): Removed
	(Check_Function_Writable_Actuals): New subprogram.
	* usage.adb (Usage): Update documentation.
	* warnsw.adb (Set_Warning_Switch): Enable warn_on_overlap when
	setting all warnings.

From-SVN: r195540
parent 54bb89ca
2013-01-29 Javier Miranda <miranda@adacore.com>
* errout.ads, errout.adb (Get_Ignore_Errors): New subprogram.
* opt.ads (Warn_On_Overlap): Update documentation.
* sem_aggr.adb (Resolve_Aggregate, Resolve_Extension_Aggregate):
Check function writable actuals.
* sem_ch3.adb (Build_Derived_Record_Type,
Record_Type_Declaration): Check function writable actuals.
* sem_ch4.adb (Analyze_Range): Check function writable actuals.
* sem_ch5.adb (Analyze_Assignment): Remove code of the initial
implementation of AI05-0144.
* sem_ch6.adb (Analyze_Function_Return,
(Analyze_Procedure_Call.Analyze_Call_And_Resolve): Remove code
of the initial implementation of AI05-0144.
* sem_res.adb (Resolve): Remove code of the initial implementation.
(Resolve_Actuals): Call Check_Function_Writable_Actuals and remove call
of the initial implementation.
(Resolve_Arithmetic_Op, Resolve_Logical_Op,
Resolve_Membership_Op): Check function writable actuals.
* sem_util.ad[sb] (Actuals_In_Call): Removed
(Check_Order_Dependence): Removed (Save_Actual): Removed
(Check_Function_Writable_Actuals): New subprogram.
* usage.adb (Usage): Update documentation.
* warnsw.adb (Set_Warning_Switch): Enable warn_on_overlap when
setting all warnings.
2013-01-29 Robert Dewar <dewar@adacore.com> 2013-01-29 Robert Dewar <dewar@adacore.com>
* a-calend-vms.adb: Minor comment fix. * a-calend-vms.adb: Minor comment fix.
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -1458,6 +1458,15 @@ package body Errout is ...@@ -1458,6 +1458,15 @@ package body Errout is
return S; return S;
end First_Sloc; end First_Sloc;
-----------------------
-- Get_Ignore_Errors --
-----------------------
function Get_Ignore_Errors return Boolean is
begin
return Errors_Must_Be_Ignored;
end Get_Ignore_Errors;
---------------- ----------------
-- Initialize -- -- Initialize --
---------------- ----------------
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -746,6 +746,9 @@ package Errout is ...@@ -746,6 +746,9 @@ package Errout is
-- where the expression is parenthesized, an attempt is made to include -- where the expression is parenthesized, an attempt is made to include
-- the parentheses (i.e. to return the location of the initial paren). -- the parentheses (i.e. to return the location of the initial paren).
function Get_Ignore_Errors return Boolean;
-- Return True if all error calls are ignored.
procedure Purge_Messages (From : Source_Ptr; To : Source_Ptr) procedure Purge_Messages (From : Source_Ptr; To : Source_Ptr)
renames Erroutc.Purge_Messages; renames Erroutc.Purge_Messages;
-- All error messages whose location is in the range From .. To (not -- All error messages whose location is in the range From .. To (not
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -1595,8 +1595,9 @@ package Opt is ...@@ -1595,8 +1595,9 @@ package Opt is
Warn_On_Overlap : Boolean := False; Warn_On_Overlap : Boolean := False;
-- GNAT -- GNAT
-- Set to True to generate warnings when a writable actual which is not -- Set to True to generate warnings when a writable actual overlaps with
-- a by-copy type overlaps with another actual in a subprogram call. -- another actual in a subprogram call. This applies only in modes before
-- Ada 2012. Starting with Ada 2012, such overlaps are illegal.
-- Modified by use of -gnatw.i/.I. -- Modified by use of -gnatw.i/.I.
Warn_On_Questionable_Missing_Parens : Boolean := True; Warn_On_Questionable_Missing_Parens : Boolean := True;
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -1252,6 +1252,8 @@ package body Sem_Aggr is ...@@ -1252,6 +1252,8 @@ package body Sem_Aggr is
Set_Etype (N, Aggr_Subtyp); Set_Etype (N, Aggr_Subtyp);
Set_Analyzed (N); Set_Analyzed (N);
end if; end if;
Check_Function_Writable_Actuals (N);
end Resolve_Aggregate; end Resolve_Aggregate;
----------------------------- -----------------------------
...@@ -2816,6 +2818,8 @@ package body Sem_Aggr is ...@@ -2816,6 +2818,8 @@ package body Sem_Aggr is
else else
Error_Msg_N ("no unique type for this aggregate", A); Error_Msg_N ("no unique type for this aggregate", A);
end if; end if;
Check_Function_Writable_Actuals (N);
end Resolve_Extension_Aggregate; end Resolve_Extension_Aggregate;
------------------------------ ------------------------------
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -8061,6 +8061,8 @@ package body Sem_Ch3 is ...@@ -8061,6 +8061,8 @@ package body Sem_Ch3 is
Set_Last_Entity Set_Last_Entity
(Class_Wide_Type (Derived_Type), Last_Entity (Derived_Type)); (Class_Wide_Type (Derived_Type), Last_Entity (Derived_Type));
end if; end if;
Check_Function_Writable_Actuals (N);
end Build_Derived_Record_Type; end Build_Derived_Record_Type;
------------------------ ------------------------
...@@ -19678,6 +19680,8 @@ package body Sem_Ch3 is ...@@ -19678,6 +19680,8 @@ package body Sem_Ch3 is
then then
Derive_Progenitor_Subprograms (T, T); Derive_Progenitor_Subprograms (T, T);
end if; end if;
Check_Function_Writable_Actuals (N);
end Record_Type_Declaration; end Record_Type_Declaration;
---------------------------- ----------------------------
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -3611,6 +3611,8 @@ package body Sem_Ch4 is ...@@ -3611,6 +3611,8 @@ package body Sem_Ch4 is
Check_Universal_Expression (L); Check_Universal_Expression (L);
Check_Universal_Expression (H); Check_Universal_Expression (H);
end if; end if;
Check_Function_Writable_Actuals (N);
end Analyze_Range; end Analyze_Range;
----------------------- -----------------------
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -692,7 +692,6 @@ package body Sem_Ch5 is ...@@ -692,7 +692,6 @@ package body Sem_Ch5 is
-- checks have been applied. -- checks have been applied.
Note_Possible_Modification (Lhs, Sure => True); Note_Possible_Modification (Lhs, Sure => True);
Check_Order_Dependence;
-- ??? a real accessibility check is needed when ??? -- ??? a real accessibility check is needed when ???
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -978,10 +978,6 @@ package body Sem_Ch6 is ...@@ -978,10 +978,6 @@ package body Sem_Ch6 is
& "null-excluding return??", & "null-excluding return??",
Reason => CE_Null_Not_Allowed); Reason => CE_Null_Not_Allowed);
end if; end if;
-- Apply checks suggested by AI05-0144 (dangerous order dependence)
Check_Order_Dependence;
end if; end if;
end Analyze_Function_Return; end Analyze_Function_Return;
...@@ -1266,11 +1262,6 @@ package body Sem_Ch6 is ...@@ -1266,11 +1262,6 @@ package body Sem_Ch6 is
if Nkind (N) = N_Procedure_Call_Statement then if Nkind (N) = N_Procedure_Call_Statement then
Analyze_Call (N); Analyze_Call (N);
Resolve (N, Standard_Void_Type); Resolve (N, Standard_Void_Type);
-- Apply checks suggested by AI05-0144
Check_Order_Dependence;
else else
Analyze (N); Analyze (N);
end if; end if;
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -2864,18 +2864,6 @@ package body Sem_Res is ...@@ -2864,18 +2864,6 @@ package body Sem_Res is
return; return;
end if; end if;
-- AI05-144-2: Check dangerous order dependence within an expression
-- that is not a subexpression. Exclude RHS of an assignment, because
-- both sides may have side-effects and the check must be performed
-- over the statement.
if Nkind (Parent (N)) not in N_Subexpr
and then Nkind (Parent (N)) /= N_Assignment_Statement
and then Nkind (Parent (N)) /= N_Procedure_Call_Statement
then
Check_Order_Dependence;
end if;
-- The expression is definitely NOT overloaded at this point, so -- The expression is definitely NOT overloaded at this point, so
-- we reset the Is_Overloaded flag to avoid any confusion when -- we reset the Is_Overloaded flag to avoid any confusion when
-- reanalyzing the node. -- reanalyzing the node.
...@@ -3378,6 +3366,7 @@ package body Sem_Res is ...@@ -3378,6 +3366,7 @@ package body Sem_Res is
begin begin
Check_Argument_Order; Check_Argument_Order;
Check_Function_Writable_Actuals (N);
if Present (First_Actual (N)) then if Present (First_Actual (N)) then
Check_Prefixed_Call; Check_Prefixed_Call;
...@@ -3776,21 +3765,6 @@ package body Sem_Res is ...@@ -3776,21 +3765,6 @@ package body Sem_Res is
end if; end if;
end if; end if;
-- Save actual for subsequent check on order dependence, and
-- indicate whether actual is modifiable. For AI05-0144-2.
-- If this is a call to a reference function that is the result
-- of expansion, as in element iterator loops, this does not lead
-- to a dangerous order dependence: only subsequent use of the
-- denoted element might, in some enclosing call.
if not Has_Implicit_Dereference (Etype (Nam))
or else Comes_From_Source (N)
then
Save_Actual (A, Ekind (F) /= E_In_Parameter);
end if;
-- For mode IN, if actual is an entity, and the type of the formal
-- has warnings suppressed, then we reset Never_Set_In_Source for -- has warnings suppressed, then we reset Never_Set_In_Source for
-- the calling entity. The reason for this is to catch cases like -- the calling entity. The reason for this is to catch cases like
-- GNAT.Spitbol.Patterns.Vstring_Var where the called subprogram -- GNAT.Spitbol.Patterns.Vstring_Var where the called subprogram
...@@ -5108,6 +5082,7 @@ package body Sem_Res is ...@@ -5108,6 +5082,7 @@ package body Sem_Res is
Check_Unset_Reference (L); Check_Unset_Reference (L);
Check_Unset_Reference (R); Check_Unset_Reference (R);
Check_Function_Writable_Actuals (N);
end Resolve_Arithmetic_Op; end Resolve_Arithmetic_Op;
------------------ ------------------
...@@ -7632,6 +7607,8 @@ package body Sem_Res is ...@@ -7632,6 +7607,8 @@ package body Sem_Res is
end if; end if;
end; end;
end if; end if;
Check_Function_Writable_Actuals (N);
end Resolve_Logical_Op; end Resolve_Logical_Op;
--------------------------- ---------------------------
...@@ -7729,6 +7706,7 @@ package body Sem_Res is ...@@ -7729,6 +7706,7 @@ package body Sem_Res is
if Present (Alternatives (N)) then if Present (Alternatives (N)) then
Resolve_Set_Membership; Resolve_Set_Membership;
Check_Function_Writable_Actuals (N);
return; return;
elsif not Is_Overloaded (R) elsif not Is_Overloaded (R)
...@@ -7793,6 +7771,7 @@ package body Sem_Res is ...@@ -7793,6 +7771,7 @@ package body Sem_Res is
end if; end if;
Eval_Membership_Op (N); Eval_Membership_Op (N);
Check_Function_Writable_Actuals (N);
end Resolve_Membership_Op; end Resolve_Membership_Op;
------------------ ------------------
......
...@@ -178,6 +178,17 @@ package Sem_Util is ...@@ -178,6 +178,17 @@ package Sem_Util is
-- not necessarily mean that CE could be raised, but a response of True -- not necessarily mean that CE could be raised, but a response of True
-- means that for sure CE cannot be raised. -- means that for sure CE cannot be raised.
procedure Check_Function_Writable_Actuals (N : Node_Id);
-- (Ada 2012): If the construct N has two or more direct constituents that
-- are names or expressions whose evaluation may occur in an arbitrary
-- order, at least one of which contains a function call with an in out or
-- out parameter, then the construct is legal only if: for each name that
-- is passed as a parameter of mode in out or out to some inner function
-- call C2 (not including the construct N itself), there is no other name
-- anywhere within a direct constituent of the construct C other than
-- the one containing C2, that is known to refer to the same object (RM
-- 6.4.1(6.17/3)).
procedure Check_Implicit_Dereference (Nam : Node_Id; Typ : Entity_Id); procedure Check_Implicit_Dereference (Nam : Node_Id; Typ : Entity_Id);
-- AI05-139-2: Accessors and iterators for containers. This procedure -- AI05-139-2: Accessors and iterators for containers. This procedure
-- checks whether T is a reference type, and if so it adds an interprettion -- checks whether T is a reference type, and if so it adds an interprettion
...@@ -215,11 +226,6 @@ package Sem_Util is ...@@ -215,11 +226,6 @@ package Sem_Util is
-- is accessed inside a nested procedure, and set Has_Up_Level_Access flag -- is accessed inside a nested procedure, and set Has_Up_Level_Access flag
-- accordingly. This is currently only enabled for VM_Target /= No_VM. -- accordingly. This is currently only enabled for VM_Target /= No_VM.
procedure Check_Order_Dependence;
-- Examine the actuals in a top-level call to determine whether aliasing
-- between two actuals, one of which is writable, can make the call
-- order-dependent.
procedure Check_Potentially_Blocking_Operation (N : Node_Id); procedure Check_Potentially_Blocking_Operation (N : Node_Id);
-- N is one of the statement forms that is a potentially blocking -- N is one of the statement forms that is a potentially blocking
-- operation. If it appears within a protected action, emit warning. -- operation. If it appears within a protected action, emit warning.
...@@ -1404,11 +1410,6 @@ package Sem_Util is ...@@ -1404,11 +1410,6 @@ package Sem_Util is
-- are only partially ordered, so Scope_Within_Or_Same (A,B) and -- are only partially ordered, so Scope_Within_Or_Same (A,B) and
-- Scope_Within_Or_Same (B,A) can both be False for a given pair A,B. -- Scope_Within_Or_Same (B,A) can both be False for a given pair A,B.
procedure Save_Actual (N : Node_Id; Writable : Boolean := False);
-- Enter an actual in a call in a table global, for subsequent check of
-- possible order dependence in the presence of IN OUT parameters for
-- functions in Ada 2012 (or access parameters in older language versions).
function Scope_Within (Scope1, Scope2 : Entity_Id) return Boolean; function Scope_Within (Scope1, Scope2 : Entity_Id) return Boolean;
-- Like Scope_Within_Or_Same, except that this function returns -- Like Scope_Within_Or_Same, except that this function returns
-- False in the case where Scope1 and Scope2 are the same scope. -- False in the case where Scope1 and Scope2 are the same scope.
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -502,8 +502,8 @@ begin ...@@ -502,8 +502,8 @@ begin
Write_Line (" .H* turn off warnings for holes in records"); Write_Line (" .H* turn off warnings for holes in records");
Write_Line (" i*+ turn on warnings for implementation unit"); Write_Line (" i*+ turn on warnings for implementation unit");
Write_Line (" I turn off warnings for implementation unit"); Write_Line (" I turn off warnings for implementation unit");
Write_Line (" .i turn on warnings for overlapping actuals"); Write_Line (" .i*+ turn on warnings for overlapping actuals");
Write_Line (" .I* turn off warnings for overlapping actuals"); Write_Line (" .I turn off warnings for overlapping actuals");
Write_Line (" j+ turn on warnings for obsolescent " & Write_Line (" j+ turn on warnings for obsolescent " &
"(annex J) feature"); "(annex J) feature");
Write_Line (" J* turn off warnings for obsolescent " & Write_Line (" J* turn off warnings for obsolescent " &
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1999-2012, Free Software Foundation, Inc. -- -- Copyright (C) 1999-2013, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -292,6 +292,7 @@ package body Warnsw is ...@@ -292,6 +292,7 @@ package body Warnsw is
Warn_On_Non_Local_Exception := True; Warn_On_Non_Local_Exception := True;
Warn_On_Object_Renames_Function := True; Warn_On_Object_Renames_Function := True;
Warn_On_Obsolescent_Feature := True; Warn_On_Obsolescent_Feature := True;
Warn_On_Overlap := True;
Warn_On_Parameter_Order := True; Warn_On_Parameter_Order := True;
Warn_On_Questionable_Missing_Parens := True; Warn_On_Questionable_Missing_Parens := True;
Warn_On_Redundant_Constructs := True; Warn_On_Redundant_Constructs := True;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment