aboutsummaryrefslogtreecommitdiff
path: root/gcc/ada
diff options
context:
space:
mode:
authorArnaud Charlet <charlet@gcc.gnu.org>2014-01-20 16:37:46 +0100
committerArnaud Charlet <charlet@gcc.gnu.org>2014-01-20 16:37:46 +0100
commit3b4598a761a9eb685e5a5013416f6c4f790ec6aa (patch)
tree6536e9de95740742ea7e8b279bffc642dfa6e0fc /gcc/ada
parent4058ddccde8eaf26b69891ae873016972c87a24b (diff)
downloadgcc-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/ChangeLog12
-rw-r--r--gcc/ada/checks.adb12
-rw-r--r--gcc/ada/exp_intr.adb39
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)));