mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-05 13:41:18 +08:00
Code Issues Packages Projects Releases Wiki Activity

[multiple changes]

Browse Source 
2017-04-28  Bob Duff  <duff@adacore.com>

	* sem_util.ads, sem_util.adb (Might_Raise): New function
	that replaces Is_Exception_Safe, but has the opposite
	sense. Is_Exception_Safe was missing various cases -- calls inside
	a pragma Debug, calls inside an 'if' or assignment statement,
	etc. Might_Raise now walks the entire subtree looking for things
	that can raise.
	* exp_ch9.adb (Is_Exception_Safe): Remove.
	(Build_Protected_Subprogram_Body): Replace call to
	Is_Exception_Safe with "not Might_Raise". Misc cleanup (use
	constants where possible).
	* exp_ch7.adb: Rename Is_Protected_Body -->
	Is_Protected_Subp_Body. A protected_body is something different
	in the grammar.

2017-04-28  Eric Botcazou  <ebotcazou@adacore.com>

	* inline.adb (Expand_Inlined_Call): Initialize Targ1 variable.
	* par-ch3.adb (P_Component_Items): Initialize Decl_Node variable.
	(P_Discrete_Choice_List): Initialize Expr_Node variable.
	* par-ch9.adb (P_Task): Initialize Aspect_Sloc variable.
	(P_Protected): Likewise.
	* sem_case.adb (Check_Duplicates):
	Add pragma Warnings on variable.
	* sem_ch12.adb (Preanalyze_Actuals): Initialize Vis variable.
	* sem_ch4.adb (List_Operand_Interps):  Add pragma Warnings on variable.
	* sem_ch5.adb (Analyze_Assignment): Initialize Save_Full_Analysis.
	(Analyze_Exit_Statement): Initialize Scope_Id variable.
	(Analyze_Iterator_Specification): Initialize Bas variable.
	* sem_ch9.adb (Allows_Lock_Free_Implementation): Initialize
	Error_Count (Satisfies_Lock_Free_Requirements): Likewise.
	(Analyze_Accept_Statement): Initialize Task_Nam.

2017-04-28  Hristian Kirtchev  <kirtchev@adacore.com>

	* checks.adb (Install_Primitive_Elaboration_Check):
	Do not generate an elaboration check if all checks have been
	suppressed.

2017-04-28  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch13.adb (Analyze_Aspect_Specifications, case
	Interrupt_Handler and Attach_Handler): Generate reference
	to protected operation to prevent spurious warnings about
	unreferenced entities. Previous scheme failed with style checks
	enabled.

2017-04-28  Ed Schonberg  <schonberg@adacore.com>

	* sem_prag.adb (Relocate_Pragmas_To_Body): A pragma Warnings
	that follows an expression function must not be relocated to
	the generated body, because it applies to the code that follows.

From-SVN: r247387
This commit is contained in:
Arnaud Charlet 2017-04-28 15:37:44 +02:00
parent 99f8abb6af
commit 85be939ea9
16 changed files with 199 additions and 171 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

54
gcc/ada/ChangeLog
View File

@ -1,3 +1,57 @@
2017-04-28 Bob Duff <duff@adacore.com>
* sem_util.ads, sem_util.adb (Might_Raise): New function
that replaces Is_Exception_Safe, but has the opposite
sense. Is_Exception_Safe was missing various cases -- calls inside
a pragma Debug, calls inside an 'if' or assignment statement,
etc. Might_Raise now walks the entire subtree looking for things
that can raise.
* exp_ch9.adb (Is_Exception_Safe): Remove.
(Build_Protected_Subprogram_Body): Replace call to
Is_Exception_Safe with "not Might_Raise". Misc cleanup (use
constants where possible).
* exp_ch7.adb: Rename Is_Protected_Body -->
Is_Protected_Subp_Body. A protected_body is something different
in the grammar.
2017-04-28 Eric Botcazou <ebotcazou@adacore.com>
* inline.adb (Expand_Inlined_Call): Initialize Targ1 variable.
* par-ch3.adb (P_Component_Items): Initialize Decl_Node variable.
(P_Discrete_Choice_List): Initialize Expr_Node variable.
* par-ch9.adb (P_Task): Initialize Aspect_Sloc variable.
(P_Protected): Likewise.
* sem_case.adb (Check_Duplicates):
Add pragma Warnings on variable.
* sem_ch12.adb (Preanalyze_Actuals): Initialize Vis variable.
* sem_ch4.adb (List_Operand_Interps): Add pragma Warnings on variable.
* sem_ch5.adb (Analyze_Assignment): Initialize Save_Full_Analysis.
(Analyze_Exit_Statement): Initialize Scope_Id variable.
(Analyze_Iterator_Specification): Initialize Bas variable.
* sem_ch9.adb (Allows_Lock_Free_Implementation): Initialize
Error_Count (Satisfies_Lock_Free_Requirements): Likewise.
(Analyze_Accept_Statement): Initialize Task_Nam.
2017-04-28 Hristian Kirtchev <kirtchev@adacore.com>
* checks.adb (Install_Primitive_Elaboration_Check):
Do not generate an elaboration check if all checks have been
suppressed.
2017-04-28 Ed Schonberg <schonberg@adacore.com>
* sem_ch13.adb (Analyze_Aspect_Specifications, case
Interrupt_Handler and Attach_Handler): Generate reference
to protected operation to prevent spurious warnings about
unreferenced entities. Previous scheme failed with style checks
enabled.
2017-04-28 Ed Schonberg <schonberg@adacore.com>
* sem_prag.adb (Relocate_Pragmas_To_Body): A pragma Warnings
that follows an expression function must not be relocated to
the generated body, because it applies to the code that follows.
2017-04-28 Gary Dismukes <dismukes@adacore.com>
* sem_util.adb (Is_Dependent_Component_Of_Mutable_Object): Test

10
gcc/ada/checks.adb
View File

@ -7795,9 +7795,10 @@ package body Checks is
if ASIS_Mode or GNATprove_Mode then
return;
-- Do not generate an elaboration check if such code is not desirable
-- Do not generate an elaboration check if all checks have been
-- suppressed.
elsif Restriction_Active (No_Elaboration_Code) then
elsif Suppress_Checks then
return;
-- Do not generate an elaboration check if the related subprogram is
@ -7806,6 +7807,11 @@ package body Checks is
elsif Elaboration_Checks_Suppressed (Subp_Id) then
return;
-- Do not generate an elaboration check if such code is not desirable
elsif Restriction_Active (No_Elaboration_Code) then
return;
-- Do not consider subprograms which act as compilation units, because
-- they cannot be the target of a dispatching call.

60
gcc/ada/exp_ch7.adb
View File

@ -4176,37 +4176,37 @@ package body Exp_Ch7 is
procedure Expand_Cleanup_Actions (N : Node_Id) is
Scop : constant Entity_Id := Current_Scope;
Is_Asynchronous_Call : constant Boolean :=
Nkind (N) = N_Block_Statement
and then Is_Asynchronous_Call_Block (N);
Is_Master : constant Boolean :=
Nkind (N) /= N_Entry_Body
and then Is_Task_Master (N);
Is_Protected_Body : constant Boolean :=
Nkind (N) = N_Subprogram_Body
and then Is_Protected_Subprogram_Body (N);
Is_Task_Allocation : constant Boolean :=
Nkind (N) = N_Block_Statement
and then Is_Task_Allocation_Block (N);
Is_Task_Body : constant Boolean :=
Nkind (Original_Node (N)) = N_Task_Body;
Needs_Sec_Stack_Mark : constant Boolean :=
Uses_Sec_Stack (Scop)
and then
not Sec_Stack_Needed_For_Return (Scop);
Needs_Custom_Cleanup : constant Boolean :=
Nkind (N) = N_Block_Statement
and then Present (Cleanup_Actions (N));
Is_Asynchronous_Call : constant Boolean :=
Nkind (N) = N_Block_Statement
and then Is_Asynchronous_Call_Block (N);
Is_Master : constant Boolean :=
Nkind (N) /= N_Entry_Body
and then Is_Task_Master (N);
Is_Protected_Subp_Body : constant Boolean :=
Nkind (N) = N_Subprogram_Body
and then Is_Protected_Subprogram_Body (N);
Is_Task_Allocation : constant Boolean :=
Nkind (N) = N_Block_Statement
and then Is_Task_Allocation_Block (N);
Is_Task_Body : constant Boolean :=
Nkind (Original_Node (N)) = N_Task_Body;
Needs_Sec_Stack_Mark : constant Boolean :=
Uses_Sec_Stack (Scop)
and then
not Sec_Stack_Needed_For_Return (Scop);
Needs_Custom_Cleanup : constant Boolean :=
Nkind (N) = N_Block_Statement
and then Present (Cleanup_Actions (N));
Actions_Required : constant Boolean :=
Requires_Cleanup_Actions (N, True)
or else Is_Asynchronous_Call
or else Is_Master
or else Is_Protected_Body
or else Is_Task_Allocation
or else Is_Task_Body
or else Needs_Sec_Stack_Mark
or else Needs_Custom_Cleanup;
Actions_Required : constant Boolean :=
Requires_Cleanup_Actions (N, True)
or else Is_Asynchronous_Call
or else Is_Master
or else Is_Protected_Subp_Body
or else Is_Task_Allocation
or else Is_Task_Body
or else Needs_Sec_Stack_Mark
or else Needs_Custom_Cleanup;
HSS : Node_Id := Handled_Statement_Sequence (N);
Loc : Source_Ptr;

131
gcc/ada/exp_ch9.adb
View File

@ -24,7 +24,6 @@
------------------------------------------------------------------------------
with Atree; use Atree;
with Checks; use Checks;
with Einfo; use Einfo;
with Elists; use Elists;
with Errout; use Errout;
@ -421,9 +420,6 @@ package body Exp_Ch9 is
-- the Task_Body_Procedure of Spec_Id. The returned entity denotes formal
-- parameter _E.
function Is_Exception_Safe (Subprogram : Node_Id) return Boolean;
-- Tell whether a given subprogram cannot raise an exception
function Is_Potentially_Large_Family
(Base_Index : Entity_Id;
Conctyp : Entity_Id;
@ -3889,30 +3885,28 @@ package body Exp_Ch9 is
Pid : Node_Id;
N_Op_Spec : Node_Id) return Node_Id
is
Loc : constant Source_Ptr := Sloc (N);
Op_Spec : Node_Id;
P_Op_Spec : Node_Id;
Uactuals : List_Id;
Pformal : Node_Id;
Unprot_Call : Node_Id;
Sub_Body : Node_Id;
Exc_Safe : constant Boolean := not Might_Raise (N);
-- True if N cannot raise an exception
Loc : constant Source_Ptr := Sloc (N);
Op_Spec : constant Node_Id := Specification (N);
P_Op_Spec : constant Node_Id :=
Build_Protected_Sub_Specification (N, Pid, Protected_Mode);
Lock_Kind : RE_Id;
Lock_Name : Node_Id;
Lock_Stmt : Node_Id;
Object_Parm : Node_Id;
Pformal : Node_Id;
R : Node_Id;
Return_Stmt : Node_Id := Empty; -- init to avoid gcc 3 warning
Pre_Stmts : List_Id := No_List; -- init to avoid gcc 3 warning
Stmts : List_Id;
Object_Parm : Node_Id;
Exc_Safe : Boolean;
Lock_Kind : RE_Id;
Sub_Body : Node_Id;
Uactuals : List_Id;
Unprot_Call : Node_Id;
begin
Op_Spec := Specification (N);
Exc_Safe := Is_Exception_Safe (N);
P_Op_Spec :=
Build_Protected_Sub_Specification (N, Pid, Protected_Mode);
-- Build a list of the formal parameters of the protected version of
-- the subprogram to use as the actual parameters of the unprotected
-- version.
@ -13545,103 +13539,6 @@ package body Exp_Ch9 is
end if;
end Install_Private_Data_Declarations;
-----------------------
-- Is_Exception_Safe --
-----------------------
function Is_Exception_Safe (Subprogram : Node_Id) return Boolean is
function Has_Side_Effect (N : Node_Id) return Boolean;
-- Return True whenever encountering a subprogram call or raise
-- statement of any kind in the sequence of statements
---------------------
-- Has_Side_Effect --
---------------------
-- What is this doing buried two levels down in exp_ch9. It seems like a
-- generally useful function, and indeed there may be code duplication
-- going on here ???
function Has_Side_Effect (N : Node_Id) return Boolean is
Stmt : Node_Id;
Expr : Node_Id;
function Is_Call_Or_Raise (N : Node_Id) return Boolean;
-- Indicate whether N is a subprogram call or a raise statement
----------------------
-- Is_Call_Or_Raise --
----------------------
function Is_Call_Or_Raise (N : Node_Id) return Boolean is
begin
return Nkind_In (N, N_Procedure_Call_Statement,
N_Function_Call,
N_Raise_Statement,
N_Raise_Constraint_Error,
N_Raise_Program_Error,
N_Raise_Storage_Error);
end Is_Call_Or_Raise;
-- Start of processing for Has_Side_Effect
begin
Stmt := N;
while Present (Stmt) loop
if Is_Call_Or_Raise (Stmt) then
return True;
end if;
-- An object declaration can also contain a function call or a
-- raise statement.
if Nkind (Stmt) = N_Object_Declaration then
Expr := Expression (Stmt);
if Present (Expr) and then Is_Call_Or_Raise (Expr) then
return True;
end if;
end if;
Next (Stmt);
end loop;
return False;
end Has_Side_Effect;
-- Start of processing for Is_Exception_Safe
begin
-- When exceptions can't be propagated, the subprogram returns normally
if No_Exception_Handlers_Set then
return True;
end if;
-- If the checks handled by the back end are not disabled, we cannot
-- ensure that no exception will be raised.
if not Access_Checks_Suppressed (Empty)
or else not Discriminant_Checks_Suppressed (Empty)
or else not Range_Checks_Suppressed (Empty)
or else not Index_Checks_Suppressed (Empty)
or else Opt.Stack_Checking_Enabled
then
return False;
end if;
if Has_Side_Effect (First (Declarations (Subprogram)))
or else
Has_Side_Effect
(First (Statements (Handled_Statement_Sequence (Subprogram))))
then
return False;
else
return True;
end if;
end Is_Exception_Safe;
---------------------------------
-- Is_Potentially_Large_Family --
---------------------------------

2
gcc/ada/inline.adb
View File

@ -2301,7 +2301,7 @@ package body Inline is
-- this is the left-hand side of the assignment, else it is a temporary
-- to which the return value is assigned prior to rewriting the call.
Targ1 : Node_Id;
Targ1 : Node_Id := Empty;
-- A separate target used when the return type is unconstrained
Temp : Entity_Id;

4
gcc/ada/par-ch3.adb
View File

@ -3494,7 +3494,7 @@ package body Ch3 is
procedure P_Component_Items (Decls : List_Id) is
Aliased_Present : Boolean := False;
CompDef_Node : Node_Id;
Decl_Node : Node_Id;
Decl_Node : Node_Id := Empty; -- initialize to prevent warning
Scan_State : Saved_Scan_State;
Not_Null_Present : Boolean := False;
Num_Idents : Nat;
@ -3754,7 +3754,7 @@ package body Ch3 is
function P_Discrete_Choice_List return List_Id is
Choices : List_Id;
Expr_Node : Node_Id;
Expr_Node : Node_Id := Empty; -- initialize to prevent warning
Choice_Node : Node_Id;
begin

6
gcc/ada/par-ch9.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2016, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2017, 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- --
@ -79,7 +79,7 @@ package body Ch9 is
-- Error recovery: cannot raise Error_Resync
function P_Task return Node_Id is
Aspect_Sloc : Source_Ptr;
Aspect_Sloc : Source_Ptr := No_Location;
Name_Node : Node_Id;
Task_Node : Node_Id;
Task_Sloc : Source_Ptr;
@ -425,7 +425,7 @@ package body Ch9 is
-- Error recovery: cannot raise Error_Resync
function P_Protected return Node_Id is
Aspect_Sloc : Source_Ptr;
Aspect_Sloc : Source_Ptr := No_Location;
Name_Node : Node_Id;
Protected_Node : Node_Id;
Protected_Sloc : Source_Ptr;

3
gcc/ada/sem_case.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1996-2016, Free Software Foundation, Inc. --
-- Copyright (C) 1996-2017, 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- --
@ -459,6 +459,7 @@ package body Sem_Case is
Choice_Hi : Uint;
Choice_Lo : Uint;
Prev_Choice : Node_Id;
pragma Warnings (Off, Prev_Choice);
Prev_Hi : Uint;
begin

2
gcc/ada/sem_ch12.adb
View File

@ -13620,7 +13620,7 @@ package body Sem_Ch12 is
Cur : Entity_Id := Empty;
-- Current homograph of the instance name
Vis : Boolean;
Vis : Boolean := False;
-- Saved visibility status of the current homograph
begin

11
gcc/ada/sem_ch13.adb
View File

@ -1968,15 +1968,12 @@ package body Sem_Ch13 is
if A_Id = Aspect_Attach_Handler
or else A_Id = Aspect_Interrupt_Handler
then
-- Decorate the reference as comming from the sources and force
-- its reanalysis to generate the reference to E; required to
-- avoid reporting spurious warning on E as unreferenced entity
-- (because aspects are not fully analyzed).
Set_Comes_From_Source (Ent, Comes_From_Source (Id));
Set_Entity (Ent, Empty);
-- Treat the specification as a reference to the protected
-- operation, which might otherwise appear unreferenced and
-- generate spurious warnings.
Analyze (Ent);
Generate_Reference (E, Id);
end if;
-- Check for duplicate aspect. Note that the Comes_From_Source

1
gcc/ada/sem_ch4.adb
View File

@ -340,6 +340,7 @@ package body Sem_Ch4 is
procedure List_Operand_Interps (Opnd : Node_Id) is
Nam : Node_Id;
pragma Warnings (Off, Nam);
Err : Node_Id := N;
begin

6
gcc/ada/sem_ch5.adb
View File

@ -107,7 +107,7 @@ package body Sem_Ch5 is
T1 : Entity_Id;
T2 : Entity_Id;
Save_Full_Analysis : Boolean;
Save_Full_Analysis : Boolean := False; -- initialize to prevent warning
procedure Diagnose_Non_Variable_Lhs (N : Node_Id);
-- N is the node for the left hand side of an assignment, and it is not
@ -1387,7 +1387,7 @@ package body Sem_Ch5 is
procedure Analyze_Exit_Statement (N : Node_Id) is
Target : constant Node_Id := Name (N);
Cond : constant Node_Id := Condition (N);
Scope_Id : Entity_Id;
Scope_Id : Entity_Id := Empty; -- initialize to prevent warning
U_Name : Entity_Id;
Kind : Entity_Kind;
@ -1864,7 +1864,7 @@ package body Sem_Ch5 is
Loc : constant Source_Ptr := Sloc (N);
Subt : constant Node_Id := Subtype_Indication (N);
Bas : Entity_Id;
Bas : Entity_Id := Empty; -- initialize to prevent warning
Typ : Entity_Id;
-- Start of processing for Analyze_Iterator_Specification

6
gcc/ada/sem_ch9.adb
View File

@ -127,7 +127,7 @@ package body Sem_Ch9 is
(N : Node_Id;
Lock_Free_Given : Boolean := False) return Boolean
is
Errors_Count : Nat;
Errors_Count : Nat := 0;
-- Errors_Count is a count of errors detected by the compiler so far
-- when Lock_Free_Given is True.
@ -257,7 +257,7 @@ package body Sem_Ch9 is
Comp : Entity_Id := Empty;
-- Track the current component which the body references
Errors_Count : Nat;
Errors_Count : Nat := 0;
-- Errors_Count is a count of errors detected by the compiler
-- so far when Lock_Free_Given is True.
@ -772,7 +772,7 @@ package body Sem_Ch9 is
Entry_Nam : Entity_Id;
E : Entity_Id;
Kind : Entity_Kind;
Task_Nam : Entity_Id;
Task_Nam : Entity_Id := Empty; -- initialize to prevent warning
begin
Tasking_Used := True;

12
gcc/ada/sem_prag.adb
View File

@ -29959,7 +29959,17 @@ package body Sem_Prag is
if Nkind (Stmt) = N_Pragma
and then Pragma_On_Body_Or_Stub_OK (Get_Pragma_Id (Stmt))
then
Relocate_Pragma (Stmt);
-- If a source pragma Warnings follows the body, it applies to
-- following statements and does not belong in the body.
if Get_Pragma_Id (Stmt) = Pragma_Warnings
and then Comes_From_Source (Stmt)
then
null;
else
Relocate_Pragma (Stmt);
end if;
-- Skip internally generated code

57
gcc/ada/sem_util.adb
View File

@ -16869,6 +16869,63 @@ package body Sem_Util is
Mark_Allocators (Root_Nod);
end Mark_Coextensions;
-----------------
-- Might_Raise --
-----------------
function Might_Raise (N : Node_Id) return Boolean is
Result : Boolean := False;
function Process (N : Node_Id) return Traverse_Result;
-- Set Result to True if we find something that could raise an exception
-------------
-- Process --
-------------
function Process (N : Node_Id) return Traverse_Result is
begin
if Nkind_In (N, N_Procedure_Call_Statement,
N_Function_Call,
N_Raise_Statement,
N_Raise_Constraint_Error,
N_Raise_Program_Error,
N_Raise_Storage_Error)
then
Result := True;
return Abandon;
else
return OK;
end if;
end Process;
procedure Set_Result is new Traverse_Proc (Process);
-- Start of processing for Might_Raise
begin
-- False if exceptions can't be propagated
if No_Exception_Handlers_Set then
return False;
end if;
-- If the checks handled by the back end are not disabled, we cannot
-- ensure that no exception will be raised.
if not Access_Checks_Suppressed (Empty)
or else not Discriminant_Checks_Suppressed (Empty)
or else not Range_Checks_Suppressed (Empty)
or else not Index_Checks_Suppressed (Empty)
or else Opt.Stack_Checking_Enabled
then
return True;
end if;
Set_Result (N);
return Result;
end Might_Raise;
--------------------------------
-- Nearest_Enclosing_Instance --
--------------------------------

5
gcc/ada/sem_util.ads
View File

@ -1984,6 +1984,11 @@ package Sem_Util is
-- to guarantee this in all cases. Note that it is more possible to give
-- correct answer if the tree is fully analyzed.
function Might_Raise (N : Node_Id) return Boolean;
-- True if evaluation of N might raise an exception. This is conservative;
-- if we're not sure, we return True. If N is a subprogram body, this is
-- about whether execution of that body can raise.
function Nearest_Enclosing_Instance (E : Entity_Id) return Entity_Id;
-- Return the entity of the nearest enclosing instance which encapsulates
-- entity E. If no such instance exits, return Empty.