[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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 19369aee7db68c54dbe3b1c70c3c0ac50bd8d3a7..c309e5785d4af365725e925707f509788b46ac5a 100644 (file)
--- 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 4a3ce980f51217f1b729692467ef22347c604b5b..58b8422ccdd2df0232b35e5c2b1ec58450e6cb9d 100644 (file)
--- 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 7302f0770122a3e1be5e1afcc34ae9c4ae015820..058b8274e0433f6afe26a2d9cca01440cfb7215f 100644 (file)
--- 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)));