Commit 814cc240 by Arnaud Charlet

[multiple changes]

2016-04-27  Arnaud Charlet  <charlet@adacore.com>

	* s-rident.ads: Make No_Implicit_Loops non partition wide.

2016-04-27  Arnaud Charlet  <charlet@adacore.com>

	* sem_ch11.adb (Analyze_Handled_Statements): check useless
	assignments also in entries and task bodies, not only in
	procedures and declaration blocks.
	* sem_ch5.adb (Analyze_Block_Statement): check useless
	assignements in declaration blocks as part of processing their
	handled statement sequence, just like it was done for procedures
	and now is also done for entries and task bodies.
	* sem_warn.adb (Warn_On_Useless_Assignment): detect boundries
	of entries and task bodies just like of procedures.

2016-04-27  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_util.adb (Is_Volatile_Function): Recognize
	a function declared within a protected type as well as the
	protected/unprotected version of a function.

From-SVN: r235491
parent 24d2fbbe
2016-04-27 Arnaud Charlet <charlet@adacore.com>
* s-rident.ads: Make No_Implicit_Loops non partition wide.
2016-04-27 Arnaud Charlet <charlet@adacore.com>
* sem_ch11.adb (Analyze_Handled_Statements): check useless
assignments also in entries and task bodies, not only in
procedures and declaration blocks.
* sem_ch5.adb (Analyze_Block_Statement): check useless
assignements in declaration blocks as part of processing their
handled statement sequence, just like it was done for procedures
and now is also done for entries and task bodies.
* sem_warn.adb (Warn_On_Useless_Assignment): detect boundries
of entries and task bodies just like of procedures.
2016-04-27 Hristian Kirtchev <kirtchev@adacore.com>
* sem_util.adb (Is_Volatile_Function): Recognize
a function declared within a protected type as well as the
protected/unprotected version of a function.
2016-04-27 Bob Duff <duff@adacore.com> 2016-04-27 Bob Duff <duff@adacore.com>
* exp_ch3.adb (Expand_N_Object_Declaration): Rewrite an object * exp_ch3.adb (Expand_N_Object_Declaration): Rewrite an object
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 1992-2015, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2016, 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- --
...@@ -121,7 +121,6 @@ package System.Rident is ...@@ -121,7 +121,6 @@ package System.Rident is
No_Implicit_Heap_Allocations, -- (RM D.8(8), H.4(3)) No_Implicit_Heap_Allocations, -- (RM D.8(8), H.4(3))
No_Implicit_Task_Allocations, -- GNAT No_Implicit_Task_Allocations, -- GNAT
No_Implicit_Protected_Object_Allocations, -- GNAT No_Implicit_Protected_Object_Allocations, -- GNAT
No_Implicit_Loops, -- GNAT
No_Initialize_Scalars, -- GNAT No_Initialize_Scalars, -- GNAT
No_Local_Allocators, -- (RM H.4(8)) No_Local_Allocators, -- (RM H.4(8))
No_Local_Timing_Events, -- (RM D.7(10.2/2)) No_Local_Timing_Events, -- (RM D.7(10.2/2))
...@@ -179,6 +178,7 @@ package System.Rident is ...@@ -179,6 +178,7 @@ package System.Rident is
No_Implementation_Restrictions, -- GNAT No_Implementation_Restrictions, -- GNAT
No_Implementation_Units, -- Ada 2012 AI-242 No_Implementation_Units, -- Ada 2012 AI-242
No_Implicit_Aliasing, -- GNAT No_Implicit_Aliasing, -- GNAT
No_Implicit_Loops, -- GNAT
No_Elaboration_Code, -- GNAT No_Elaboration_Code, -- GNAT
No_Obsolescent_Features, -- Ada 2005 AI-368 No_Obsolescent_Features, -- Ada 2005 AI-368
No_Wide_Characters, -- GNAT No_Wide_Characters, -- GNAT
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2015, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2016, 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- --
...@@ -417,14 +417,15 @@ package body Sem_Ch11 is ...@@ -417,14 +417,15 @@ package body Sem_Ch11 is
Analyze_Statements (Statements (N)); Analyze_Statements (Statements (N));
-- If the current scope is a subprogram, then this is the right place to -- If the current scope is a subprogram, entry or task body or declare
-- check for hanging useless assignments from the statement sequence of -- block then this is the right place to check for hanging useless
-- the subprogram body. Skip this in the body of a postcondition, -- assignments from the statement sequence. Skip this in the body of a
-- since in that case there are no source references, and we need to -- postcondition, since in that case there are no source references, and
-- preserve deferred references from the enclosing scope. -- we need to preserve deferred references from the enclosing scope.
if Is_Subprogram (Current_Scope) if ((Is_Subprogram (Current_Scope) or else Is_Entry (Current_Scope))
and then Chars (Current_Scope) /= Name_uPostconditions and then Chars (Current_Scope) /= Name_uPostconditions)
or else Ekind_In (Current_Scope, E_Block, E_Task_Type)
then then
Warn_On_Useless_Assignments (Current_Scope); Warn_On_Useless_Assignments (Current_Scope);
end if; end if;
......
...@@ -1062,7 +1062,6 @@ package body Sem_Ch5 is ...@@ -1062,7 +1062,6 @@ package body Sem_Ch5 is
end if; end if;
Check_References (Ent); Check_References (Ent);
Warn_On_Useless_Assignments (Ent);
End_Scope; End_Scope;
if Unblocked_Exit_Count = 0 then if Unblocked_Exit_Count = 0 then
......
...@@ -13377,14 +13377,14 @@ package body Sem_Util is ...@@ -13377,14 +13377,14 @@ package body Sem_Util is
return return
Pref = Obj_Ref Pref = Obj_Ref
and then Present (Etype (Pref)) and then Present (Etype (Pref))
and then Is_Protected_Type (Etype (Pref)) and then Is_Protected_Type (Etype (Pref))
and then Is_Entity_Name (Subp) and then Is_Entity_Name (Subp)
and then Present (Entity (Subp)) and then Present (Entity (Subp))
and then Ekind_In (Entity (Subp), E_Entry, and then Ekind_In (Entity (Subp), E_Entry,
E_Entry_Family, E_Entry_Family,
E_Function, E_Function,
E_Procedure); E_Procedure);
else else
return False; return False;
end if; end if;
...@@ -14954,17 +14954,11 @@ package body Sem_Util is ...@@ -14954,17 +14954,11 @@ package body Sem_Util is
function Is_Volatile_Function (Func_Id : Entity_Id) return Boolean is function Is_Volatile_Function (Func_Id : Entity_Id) return Boolean is
begin begin
-- The caller must ensure that Func_Id denotes a function
pragma Assert (Ekind_In (Func_Id, E_Function, E_Generic_Function)); pragma Assert (Ekind_In (Func_Id, E_Function, E_Generic_Function));
-- A protected function is automatically volatile -- A function declared within a protected type is volatile
if Is_Primitive (Func_Id) if Is_Protected_Type (Scope (Func_Id)) then
and then Present (First_Formal (Func_Id))
and then Is_Protected_Type (Etype (First_Formal (Func_Id)))
and then Etype (First_Formal (Func_Id)) = Scope (Func_Id)
then
return True; return True;
-- An instance of Ada.Unchecked_Conversion is a volatile function if -- An instance of Ada.Unchecked_Conversion is a volatile function if
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1999-2015, Free Software Foundation, Inc. -- -- Copyright (C) 1999-2016, 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- --
...@@ -4297,8 +4297,10 @@ package body Sem_Warn is ...@@ -4297,8 +4297,10 @@ package body Sem_Warn is
-- When we hit a package/subprogram body, issue warning and exit -- When we hit a package/subprogram body, issue warning and exit
elsif Nkind (P) = N_Subprogram_Body elsif Nkind_In (P, N_Entry_Body,
or else Nkind (P) = N_Package_Body N_Package_Body,
N_Subprogram_Body,
N_Task_Body)
then then
-- Case of assigned value never referenced -- Case of assigned value never referenced
...@@ -4376,8 +4378,10 @@ package body Sem_Warn is ...@@ -4376,8 +4378,10 @@ package body Sem_Warn is
-- not generate the warning, since the variable in question -- not generate the warning, since the variable in question
-- may be accessed after an exception in the outer block. -- may be accessed after an exception in the outer block.
if Nkind (Parent (P)) /= N_Subprogram_Body if not Nkind_In (Parent (P), N_Entry_Body,
and then Nkind (Parent (P)) /= N_Package_Body N_Package_Body,
N_Subprogram_Body,
N_Task_Body)
then then
Set_Last_Assignment (Ent, Empty); Set_Last_Assignment (Ent, Empty);
return; return;
......
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