[multiple changes]

2016-06-22  Hristian Kirtchev  <kirtchev@adacore.com>

	* lib-xref-spark_specific.adb, a-cuprqu.ads, sem_ch6.adb: Minor
	reformatting.

2016-06-22  Eric Botcazou  <ebotcazou@adacore.com>

	* sem_util.ads (Address_Value): Declare new function.
	* sem_util.adb (Address_Value): New function extracted
	unmodified from Apply_Address_Clause_Check, which returns the
	underlying value of the expression of an address clause.
	* checks.adb (Compile_Time_Bad_Alignment): Delete.
	(Apply_Address_Clause_Check): Call Address_Value on
	the expression.  Do not issue the main warning here and
	issue the secondary warning only when the value of the
	expression is not known at compile time.
	* sem_ch13.adb (Address_Clause_Check_Record): Add A component and
	adjust the description.
	(Analyze_Attribute_Definition_Clause): In the case
	of an address, move up the code creating an entry in the table of
	address clauses.  Also create an entry for an absolute address.
	(Validate_Address_Clauses): Issue the warning for absolute
	addresses here too.  Tweak condition associated with overlays
	for consistency.

From-SVN: r237688

1 files changed, 12 insertions, 71 deletions

diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
index cd8d144..157bd06 100644
--- a/gcc/ada/checks.adb
+++ b/gcc/ada/checks.adb
@@ -638,36 +638,12 @@ package body Checks is
       AC   : constant Node_Id    := Address_Clause (E);
       Loc  : constant Source_Ptr := Sloc (AC);
       Typ  : constant Entity_Id  := Etype (E);
-      Aexp : constant Node_Id    := Expression (AC);
 
       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).
 
-      procedure Compile_Time_Bad_Alignment;
-      --  Post error warnings when alignment is known to be incompatible. Note
-      --  that we do not go as far as inserting a raise of Program_Error since
-      --  this is an erroneous case, and it may happen that we are lucky and an
-      --  underaligned address turns out to be OK after all.
-
-      --------------------------------
-      -- Compile_Time_Bad_Alignment --
-      --------------------------------
-
-      procedure Compile_Time_Bad_Alignment is
-      begin
-         if Address_Clause_Overlay_Warnings then
-            Error_Msg_FE
-              ("?o?specified address for& may be inconsistent with alignment",
-               Aexp, E);
-            Error_Msg_FE
-              ("\?o?program execution may be erroneous (RM 13.3(27))",
-               Aexp, E);
-            Set_Address_Warning_Posted (AC);
-         end if;
-      end Compile_Time_Bad_Alignment;
-
    --  Start of processing for Apply_Address_Clause_Check
 
    begin
@@ -690,43 +666,11 @@ package body Checks is
 
       --  Obtain expression from address clause
 
-      Expr := Expression (AC);
-
-      --  The following loop digs for the real expression to use in the check
-
-      loop
-         --  For constant, get constant expression
-
-         if Is_Entity_Name (Expr)
-           and then Ekind (Entity (Expr)) = E_Constant
-         then
-            Expr := Constant_Value (Entity (Expr));
-
-         --  For unchecked conversion, get result to convert
+      Expr := Address_Value (Expression (AC));
 
-         elsif Nkind (Expr) = N_Unchecked_Type_Conversion then
-            Expr := Expression (Expr);
-
-         --  For (common case) of To_Address call, get argument
-
-         elsif Nkind (Expr) = N_Function_Call
-           and then Is_Entity_Name (Name (Expr))
-           and then Is_RTE (Entity (Name (Expr)), RE_To_Address)
-         then
-            Expr := First (Parameter_Associations (Expr));
-
-            if Nkind (Expr) = N_Parameter_Association then
-               Expr := Explicit_Actual_Parameter (Expr);
-            end if;
-
-         --  We finally have the real expression
-
-         else
-            exit;
-         end if;
-      end loop;
-
-      --  See if we know that Expr has a bad alignment at compile time
+      --  See if we know that Expr has an acceptable value at compile time. If
+      --  it hasn't or we don't know, we defer issuing the warning until the
+      --  end of the compilation to take into account back end annotations.
 
       if Compile_Time_Known_Value (Expr)
         and then (Known_Alignment (E) or else Known_Alignment (Typ))
@@ -742,9 +686,7 @@ package body Checks is
                AL := Alignment (E);
             end if;
 
-            if Expr_Value (Expr) mod AL /= 0 then
-               Compile_Time_Bad_Alignment;
-            else
+            if Expr_Value (Expr) mod AL = 0 then
                return;
             end if;
          end;
@@ -818,12 +760,11 @@ package body Checks is
          Warning_Msg := No_Error_Msg;
          Analyze (First (Actions (N)), Suppress => All_Checks);
 
-         --  If the address clause generated a warning message (for example,
+         --  If the above raise action 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
@@ -832,13 +773,13 @@ package body Checks is
             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
+            else
+               --  Add explanation of the warning generated by the check
 
-            Error_Msg_N
-              ("\address value may be incompatible with alignment "
-               & "of object?X?", AC);
+               Error_Msg_N
+                 ("\address value may be incompatible with alignment "
+                  & "of object?X?", AC);
+            end if;
          end if;
 
          return;