[multiple changes]

2014-06-13  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_prag.adb (Analyze_Pragma): Add local
	variable Missing_Parentheses. Emit an error when a state
	declaration with options appears without parentheses. Add a
	guard to prevent a bogus error when a state declaration may be
	interpreted as an option if a previous declaration with options
	was not parenthesized.

2014-06-13  Robert Dewar  <dewar@adacore.com>

	* checks.adb: Validate_Alignment_Check_Warnings: New procedure
	(Apply_Address_Clause_Check): Make Aligment_Warnings table entry.
	* checks.ads (Alignment_Warnings_Record): New type.
	(Alignment_Warnings): New table
	(Validate_Alignment_Check_Warnings): New procedure.
	* errout.adb (Delete_Warning_And_Continuations): New procedure
	(Error_Msg_Internal): Set Warning_Msg (Delete_Warning): Handle
	Warnings_Treated_As_Errors (Finalize): Minor reformatting
	* errout.ads (Warning_Msg): New variable
	(Delete_Warning_And_Continuations): New procedure
	* erroutc.adb (Delete_Msg): Handle Warnings_Treated_As_Errors count.
	* gnat1drv.adb (Post_Compilation_Validation_Checks): New procedure.

2014-06-13  Ed Schonberg  <schonberg@adacore.com>

	* a-coinho.adb, a-coinho.ads: Add Reference machinery.

From-SVN: r211627

1 files changed, 47 insertions, 17 deletions

diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
index 66c0d91..61d0324 100644
--- a/gcc/ada/checks.adb
+++ b/gcc/ada/checks.adb
@@ -27,15 +27,14 @@ with Atree;    use Atree;
 with Casing;   use Casing;
 with Debug;    use Debug;
 with Einfo;    use Einfo;
-with Errout;   use Errout;
+with Elists;   use Elists;
+with Eval_Fat; use Eval_Fat;
+with Exp_Ch11; use Exp_Ch11;
 with Exp_Ch2;  use Exp_Ch2;
 with Exp_Ch4;  use Exp_Ch4;
-with Exp_Ch11; use Exp_Ch11;
 with Exp_Pakd; use Exp_Pakd;
 with Exp_Util; use Exp_Util;
-with Elists;   use Elists;
 with Expander; use Expander;
-with Eval_Fat; use Eval_Fat;
 with Freeze;   use Freeze;
 with Lib;      use Lib;
 with Nlists;   use Nlists;
@@ -47,9 +46,9 @@ with Rident;   use Rident;
 with Rtsfind;  use Rtsfind;
 with Sem;      use Sem;
 with Sem_Aux;  use Sem_Aux;
-with Sem_Eval; use Sem_Eval;
 with Sem_Ch3;  use Sem_Ch3;
 with Sem_Ch8;  use Sem_Ch8;
+with Sem_Eval; use Sem_Eval;
 with Sem_Res;  use Sem_Res;
 with Sem_Util; use Sem_Util;
 with Sem_Warn; use Sem_Warn;
@@ -589,7 +588,7 @@ package body Checks is
       Expr : Node_Id;
       --  Address expression (not necessarily the same as Aexp, for example
       --  when Aexp is a reference to a constant, in which case Expr gets
-      --  reset to reference the value expression of the constant.
+      --  reset to reference the value expression of the constant).
 
       procedure Compile_Time_Bad_Alignment;
       --  Post error warnings when alignment is known to be incompatible. Note
@@ -758,21 +757,32 @@ package body Checks is
                          Prefix         => New_Occurrence_Of (E, Loc),
                          Attribute_Name => Name_Alignment)),
                  Right_Opnd => Make_Integer_Literal (Loc, Uint_0)),
-             Reason => PE_Misaligned_Address_Value));
+                       Reason    => PE_Misaligned_Address_Value));
+
+         Warning_Msg := No_Error_Msg;
          Analyze (First (Actions (N)), Suppress => All_Checks);
 
-         --  If the address clause generates an alignment check and we are
-         --  in ZFP or some restricted run-time, add a warning to explain
-         --  the propagation warning that is generated by the check.
+         --  If the address clause generated a warning message (for example,
+         --  from Warn_On_Non_Local_Exception mode with the active restriction
+         --  No_Exception_Propagation).
+
+         if Warning_Msg /= No_Error_Msg then
+
+            --  If the expression has a known at compile time value, then
+            --  once we know the alignment of the type, we can check if the
+            --  exception will be raised or not, and if not, we don't need
+            --  the warning so we will kill the warning later on.
+
+            if Compile_Time_Known_Value (Expr) then
+               Alignment_Warnings.Append
+                 ((E => E, A => Expr_Value (Expr), W => Warning_Msg));
+            end if;
+
+            --  Add explanation of the warning that is generated by the check
 
-         if Nkind (First (Actions (N))) = N_Raise_Program_Error
-           and then not Warnings_Off (E)
-           and then Warn_On_Non_Local_Exception
-           and then Restriction_Active (No_Exception_Propagation)
-         then
             Error_Msg_N
-              ("address value may be incompatible with alignment of object?",
-               N);
+              ("\address value may be incompatible with alignment "
+               & "of object?X?", AC);
          end if;
 
          return;
@@ -9483,6 +9493,26 @@ package body Checks is
       end if;
    end Tag_Checks_Suppressed;
 
+   ---------------------------------------
+   -- Validate_Alignment_Check_Warnings --
+   ---------------------------------------
+
+   procedure Validate_Alignment_Check_Warnings is
+   begin
+      for J in Alignment_Warnings.First .. Alignment_Warnings.Last loop
+         declare
+            AWR : Alignment_Warnings_Record
+                    renames Alignment_Warnings.Table (J);
+         begin
+            if Known_Alignment (AWR.E)
+              and then AWR.A mod Alignment (AWR.E) = 0
+            then
+               Delete_Warning_And_Continuations (AWR.W);
+            end if;
+         end;
+      end loop;
+   end Validate_Alignment_Check_Warnings;
+
    --------------------------
    -- Validity_Check_Range --
    --------------------------