diff options
author | Arnaud Charlet <charlet@gcc.gnu.org> | 2014-01-20 16:37:46 +0100 |
---|---|---|
committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2014-01-20 16:37:46 +0100 |
commit | 3b4598a761a9eb685e5a5013416f6c4f790ec6aa (patch) | |
tree | 6536e9de95740742ea7e8b279bffc642dfa6e0fc /gcc/ada | |
parent | 4058ddccde8eaf26b69891ae873016972c87a24b (diff) | |
download | gcc-3b4598a761a9eb685e5a5013416f6c4f790ec6aa.zip gcc-3b4598a761a9eb685e5a5013416f6c4f790ec6aa.tar.gz gcc-3b4598a761a9eb685e5a5013416f6c4f790ec6aa.tar.bz2 |
[multiple changes]
2014-01-20 Bob Duff <duff@adacore.com>
* exp_intr.adb (Expand_Unc_Deallocation): Remove warning on abort
followed by free.
2014-01-20 Ed Schonberg <schonberg@adacore.com>
* 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
Diffstat (limited to 'gcc/ada')
-rw-r--r-- | gcc/ada/ChangeLog | 12 | ||||
-rw-r--r-- | gcc/ada/checks.adb | 12 | ||||
-rw-r--r-- | gcc/ada/exp_intr.adb | 39 |
3 files changed, 29 insertions, 34 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 19369ae..c309e57 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,15 @@ +2014-01-20 Bob Duff <duff@adacore.com> + + * exp_intr.adb (Expand_Unc_Deallocation): Remove warning on abort + followed by free. + +2014-01-20 Ed Schonberg <schonberg@adacore.com> + + * 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 <dewar@adacore.com> * exp_ch7.adb: Minor reformatting. diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index 4a3ce98..58b8422 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 7302f07..058b827 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))); |