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>
* a-calend-vms.adb: Minor comment fix.
......
......@@ -6,7 +6,7 @@
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -1458,6 +1458,15 @@ package body Errout is
return S;
end First_Sloc;
-----------------------
-- Get_Ignore_Errors --
-----------------------
function Get_Ignore_Errors return Boolean is
begin
return Errors_Must_Be_Ignored;
end Get_Ignore_Errors;
----------------
-- Initialize --
----------------
......
......@@ -6,7 +6,7 @@
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -746,6 +746,9 @@ package Errout is
-- where the expression is parenthesized, an attempt is made to include
-- 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)
renames Erroutc.Purge_Messages;
-- All error messages whose location is in the range From .. To (not
......
......@@ -6,7 +6,7 @@
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -1595,8 +1595,9 @@ package Opt is
Warn_On_Overlap : Boolean := False;
-- GNAT
-- Set to True to generate warnings when a writable actual which is not
-- a by-copy type overlaps with another actual in a subprogram call.
-- Set to True to generate warnings when a writable actual overlaps with
-- 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.
Warn_On_Questionable_Missing_Parens : Boolean := True;
......
......@@ -6,7 +6,7 @@
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -1252,6 +1252,8 @@ package body Sem_Aggr is
Set_Etype (N, Aggr_Subtyp);
Set_Analyzed (N);
end if;
Check_Function_Writable_Actuals (N);
end Resolve_Aggregate;
-----------------------------
......@@ -2816,6 +2818,8 @@ package body Sem_Aggr is
else
Error_Msg_N ("no unique type for this aggregate", A);
end if;
Check_Function_Writable_Actuals (N);
end Resolve_Extension_Aggregate;
------------------------------
......
......@@ -6,7 +6,7 @@
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -8061,6 +8061,8 @@ package body Sem_Ch3 is
Set_Last_Entity
(Class_Wide_Type (Derived_Type), Last_Entity (Derived_Type));
end if;
Check_Function_Writable_Actuals (N);
end Build_Derived_Record_Type;
------------------------
......@@ -19678,6 +19680,8 @@ package body Sem_Ch3 is
then
Derive_Progenitor_Subprograms (T, T);
end if;
Check_Function_Writable_Actuals (N);
end Record_Type_Declaration;
----------------------------
......
......@@ -6,7 +6,7 @@
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -3611,6 +3611,8 @@ package body Sem_Ch4 is
Check_Universal_Expression (L);
Check_Universal_Expression (H);
end if;
Check_Function_Writable_Actuals (N);
end Analyze_Range;
-----------------------
......
......@@ -6,7 +6,7 @@
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -692,7 +692,6 @@ package body Sem_Ch5 is
-- checks have been applied.
Note_Possible_Modification (Lhs, Sure => True);
Check_Order_Dependence;
-- ??? a real accessibility check is needed when ???
......
......@@ -6,7 +6,7 @@
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -978,10 +978,6 @@ package body Sem_Ch6 is
& "null-excluding return??",
Reason => CE_Null_Not_Allowed);
end if;
-- Apply checks suggested by AI05-0144 (dangerous order dependence)
Check_Order_Dependence;
end if;
end Analyze_Function_Return;
......@@ -1266,11 +1262,6 @@ package body Sem_Ch6 is
if Nkind (N) = N_Procedure_Call_Statement then
Analyze_Call (N);
Resolve (N, Standard_Void_Type);
-- Apply checks suggested by AI05-0144
Check_Order_Dependence;
else
Analyze (N);
end if;
......
......@@ -6,7 +6,7 @@
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -2864,18 +2864,6 @@ package body Sem_Res is
return;
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
-- we reset the Is_Overloaded flag to avoid any confusion when
-- reanalyzing the node.
......@@ -3378,6 +3366,7 @@ package body Sem_Res is
begin
Check_Argument_Order;
Check_Function_Writable_Actuals (N);
if Present (First_Actual (N)) then
Check_Prefixed_Call;
......@@ -3776,21 +3765,6 @@ package body Sem_Res is
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
-- the calling entity. The reason for this is to catch cases like
-- GNAT.Spitbol.Patterns.Vstring_Var where the called subprogram
......@@ -5108,6 +5082,7 @@ package body Sem_Res is
Check_Unset_Reference (L);
Check_Unset_Reference (R);
Check_Function_Writable_Actuals (N);
end Resolve_Arithmetic_Op;
------------------
......@@ -7632,6 +7607,8 @@ package body Sem_Res is
end if;
end;
end if;
Check_Function_Writable_Actuals (N);
end Resolve_Logical_Op;
---------------------------
......@@ -7729,6 +7706,7 @@ package body Sem_Res is
if Present (Alternatives (N)) then
Resolve_Set_Membership;
Check_Function_Writable_Actuals (N);
return;
elsif not Is_Overloaded (R)
......@@ -7793,6 +7771,7 @@ package body Sem_Res is
end if;
Eval_Membership_Op (N);
Check_Function_Writable_Actuals (N);
end Resolve_Membership_Op;
------------------
......
......@@ -178,6 +178,17 @@ package Sem_Util is
-- not necessarily mean that CE could be raised, but a response of True
-- 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);
-- AI05-139-2: Accessors and iterators for containers. This procedure
-- checks whether T is a reference type, and if so it adds an interprettion
......@@ -215,11 +226,6 @@ package Sem_Util is
-- is accessed inside a nested procedure, and set Has_Up_Level_Access flag
-- 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);
-- N is one of the statement forms that is a potentially blocking
-- operation. If it appears within a protected action, emit warning.
......@@ -1404,11 +1410,6 @@ package Sem_Util is
-- 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.
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;
-- Like Scope_Within_Or_Same, except that this function returns
-- False in the case where Scope1 and Scope2 are the same scope.
......
......@@ -6,7 +6,7 @@
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -502,8 +502,8 @@ begin
Write_Line (" .H* turn off warnings for holes in records");
Write_Line (" i*+ turn on 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 off warnings for overlapping actuals");
Write_Line (" .i*+ turn on warnings for overlapping actuals");
Write_Line (" .I turn off warnings for overlapping actuals");
Write_Line (" j+ turn on warnings for obsolescent " &
"(annex J) feature");
Write_Line (" J* turn off warnings for obsolescent " &
......
......@@ -6,7 +6,7 @@
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -292,6 +292,7 @@ package body Warnsw is
Warn_On_Non_Local_Exception := True;
Warn_On_Object_Renames_Function := True;
Warn_On_Obsolescent_Feature := True;
Warn_On_Overlap := True;
Warn_On_Parameter_Order := True;
Warn_On_Questionable_Missing_Parens := 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