From: Arnaud Charlet Date: Mon, 20 Jan 2014 15:37:46 +0000 (+0100) Subject: [multiple changes] X-Git-Tag: releases/gcc-4.9.0~1537 X-Git-Url: http://git.ipfire.org/gitweb.cgi?a=commitdiff_plain;h=3b4598a761a9eb685e5a5013416f6c4f790ec6aa;p=thirdparty%2Fgcc.git [multiple changes] 2014-01-20 Bob Duff * exp_intr.adb (Expand_Unc_Deallocation): Remove warning on abort followed by free. 2014-01-20 Ed Schonberg * checks.adb (Apply_Address_Clause_Check): If there is an alignment check on the expression in an address clause, and there is no local exception propagation, add an additional explanatory message to clarify the cause of previous warning. From-SVN: r206828 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 19369aee7db6..c309e5785d4a 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,15 @@ +2014-01-20 Bob Duff + + * exp_intr.adb (Expand_Unc_Deallocation): Remove warning on abort + followed by free. + +2014-01-20 Ed Schonberg + + * checks.adb (Apply_Address_Clause_Check): If there is an + alignment check on the expression in an address clause, and there + is no local exception propagation, add an additional explanatory + message to clarify the cause of previous warning. + 2014-01-20 Robert Dewar * exp_ch7.adb: Minor reformatting. diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index 4a3ce980f512..58b8422ccdd2 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -758,6 +758,18 @@ package body Checks is Right_Opnd => Make_Integer_Literal (Loc, Uint_0)), Reason => PE_Misaligned_Address_Value)); Analyze (First (Actions (N)), Suppress => All_Checks); + + -- If the address clause generates an alignment check and we are + -- in ZPF or some restricted run-time, add a warning to explain + -- the propagation warning that is generated by the check. + + if Nkind (First (Actions (N))) = N_Raise_Program_Error + and then not Warnings_Off (E) + and then Restriction_Active (No_Exception_Propagation) + then + Error_Msg_N ("address value may be incompatible with " & + "alignment of object?", N); + end if; return; end if; diff --git a/gcc/ada/exp_intr.adb b/gcc/ada/exp_intr.adb index 7302f0770122..058b8274e043 100644 --- a/gcc/ada/exp_intr.adb +++ b/gcc/ada/exp_intr.adb @@ -27,7 +27,6 @@ with Atree; use Atree; with Checks; use Checks; with Einfo; use Einfo; with Elists; use Elists; -with Errout; use Errout; with Exp_Atag; use Exp_Atag; with Exp_Ch4; use Exp_Ch4; with Exp_Ch7; use Exp_Ch7; @@ -1019,39 +1018,11 @@ package body Exp_Intr is -- For a task type, call Free_Task before freeing the ATCB if Is_Task_Type (Desig_T) then - declare - Stat : Node_Id := Prev (N); - Nam1 : Node_Id; - Nam2 : Node_Id; - - begin - -- An Abort followed by a Free will not do what the user expects, - -- because the abort is not immediate. This is worth a warning. - - while Present (Stat) - and then not Comes_From_Source (Original_Node (Stat)) - loop - Prev (Stat); - end loop; - - if Present (Stat) - and then Nkind (Original_Node (Stat)) = N_Abort_Statement - then - Stat := Original_Node (Stat); - Nam1 := First (Names (Stat)); - Nam2 := Original_Node (First (Parameter_Associations (N))); - - if Nkind (Nam1) = N_Explicit_Dereference - and then Is_Entity_Name (Prefix (Nam1)) - and then Is_Entity_Name (Nam2) - and then Entity (Prefix (Nam1)) = Entity (Nam2) - then - Error_Msg_N ("abort may take time to complete??", N); - Error_Msg_N ("\deallocation might have no effect??", N); - Error_Msg_N ("\safer to wait for termination??", N); - end if; - end if; - end; + -- We used to detect the case of Abort followed by a Free here, + -- because the Free wouldn't actually free if it happens before the + -- aborted task actually terminates. The warning is removed, because + -- Free now works properly (the task will be freed once it + -- terminates). Append_To (Stmts, Cleanup_Task (N, Duplicate_Subexpr_No_Checks (Arg)));