sem_util.ads (Indexed_Component_Bit_Offset): Declare.

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

	* sem_util.ads (Indexed_Component_Bit_Offset): Declare.
	* sem_util.adb (Indexed_Component_Bit_Offset): New
	function returning the offset of an indexed component.
	(Has_Compatible_Alignment_Internal): Call it.
	* sem_ch13.adb (Offset_Value): New function returning the offset of an
	Address attribute reference from the underlying entity.
	(Validate_Address_Clauses): Call it and take the offset into
	account for the size warning.

From-SVN: r237511

gcc/ada/ChangeLog

+2016-06-16  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* sem_util.ads (Indexed_Component_Bit_Offset): Declare.
+	* sem_util.adb (Indexed_Component_Bit_Offset): New
+	function returning the offset of an indexed component.
+	(Has_Compatible_Alignment_Internal): Call it.
+	* sem_ch13.adb (Offset_Value): New function returning the offset of an
+	Address attribute reference from the underlying entity.
+	(Validate_Address_Clauses): Call it and take the offset into
+	account for the size warning.
+
 2016-06-16  Hristian Kirtchev  <kirtchev@adacore.com>
 
 	* bindgen.adb, exp_util.adb, sem_ch9.adb, sem_util.adb: Minor

gcc/ada/sem_ch13.adb

@@ -13626,6 +13626,53 @@ package body Sem_Ch13 is
    ------------------------------
 
    procedure Validate_Address_Clauses is
+      function Offset_Value (Expr : Node_Id) return Uint;
+      --  Given an Address attribute reference, return the value in bits of its
+      --  offset from the first bit of the underlying entity, or 0 if it is not
+      --  known at compile time.
+
+      ------------------
+      -- Offset_Value --
+      ------------------
+
+      function Offset_Value (Expr : Node_Id) return Uint is
+         N   : Node_Id := Prefix (Expr);
+         Off : Uint;
+         Val : Uint := Uint_0;
+
+      begin
+         --  Climb the prefix chain and compute the cumulative offset
+
+         loop
+            if Is_Entity_Name (N) then
+               return Val;
+
+            elsif Nkind (N) = N_Selected_Component then
+               Off := Component_Bit_Offset (Entity (Selector_Name (N)));
+               if Off /= No_Uint and then Off >= Uint_0 then
+                  Val := Val + Off;
+                  N   := Prefix (N);
+               else
+                  return Uint_0;
+               end if;
+
+            elsif Nkind (N) = N_Indexed_Component then
+               Off := Indexed_Component_Bit_Offset (N);
+               if Off /= No_Uint then
+                  Val := Val + Off;
+                  N   := Prefix (N);
+               else
+                  return Uint_0;
+               end if;
+
+            else
+               return Uint_0;
+            end if;
+         end loop;
+      end Offset_Value;
+
+   --  Start of processing for Validate_Address_Clauses
+
    begin
       for J in Address_Clause_Checks.First .. Address_Clause_Checks.Last loop
          declare
@@ -13640,6 +13687,8 @@ package body Sem_Ch13 is
             X_Size : Uint;
             Y_Size : Uint;
 
+            X_Offs : Uint;
+
          begin
             --  Skip processing of this entry if warning already posted
 
@@ -13651,16 +13700,25 @@ package body Sem_Ch13 is
                X_Alignment := Alignment (ACCR.X);
                Y_Alignment := Alignment (ACCR.Y);
 
-               --  Similarly obtain sizes
+               --  Similarly obtain sizes and offset
 
                X_Size := Esize (ACCR.X);
                Y_Size := Esize (ACCR.Y);
 
+               if ACCR.Off
+                 and then Nkind (Expr) = N_Attribute_Reference
+                 and then Attribute_Name (Expr) = Name_Address
+               then
+                  X_Offs := Offset_Value (Expr);
+               else
+                  X_Offs := Uint_0;
+               end if;
+
                --  Check for large object overlaying smaller one
 
                if Y_Size > Uint_0
                  and then X_Size > Uint_0
-                 and then X_Size > Y_Size
+                 and then X_Offs + X_Size > Y_Size
                then
                   Error_Msg_NE ("??& overlays smaller object", ACCR.N, ACCR.X);
                   Error_Msg_N
@@ -13672,6 +13730,11 @@ package body Sem_Ch13 is
                   Error_Msg_Uint_1 := Y_Size;
                   Error_Msg_NE ("\??size of & is ^", ACCR.N, ACCR.Y);
 
+                  if X_Offs /= Uint_0 then
+                     Error_Msg_Uint_1 := X_Offs;
+                     Error_Msg_NE ("\??and offset of & is ^", ACCR.N, ACCR.X);
+                  end if;
+
                --  Check for inadequate alignment, both of the base object
                --  and of the offset, if any. We only do this check if the
                --  run-time Alignment_Check is active. No point in warning

gcc/ada/sem_util.adb

@@ -8780,7 +8780,6 @@ package body Sem_Util is
          elsif Nkind (Expr) = N_Indexed_Component then
             declare
                Typ : constant Entity_Id := Etype (Prefix (Expr));
-               Ind : constant Node_Id   := First_Index (Typ);
 
             begin
                --  Packing generates unknown alignment if layout is not done
@@ -8789,22 +8788,12 @@ package body Sem_Util is
                   Set_Result (Unknown);
                end if;
 
-               --  Check prefix and component offset
+               --  Check prefix and component offset (or at least size)
 
                Check_Prefix;
-               Offs := Component_Size (Typ);
-
-               --  Small optimization: compute the full offset when possible
-
-               if Offs /= No_Uint
-                 and then Offs > Uint_0
-                 and then Present (Ind)
-                 and then Nkind (Ind) = N_Range
-                 and then Compile_Time_Known_Value (Low_Bound (Ind))
-                 and then Compile_Time_Known_Value (First (Expressions (Expr)))
-               then
-                  Offs := Offs * (Expr_Value (First (Expressions (Expr)))
-                                    - Expr_Value (Low_Bound ((Ind))));
+               Offs := Indexed_Component_Bit_Offset (Expr);
+               if Offs = No_Uint then
+                  Offs := Component_Size (Typ);
                end if;
             end;
          end if;
@@ -11064,6 +11053,59 @@ package body Sem_Util is
       return Empty;
    end Incomplete_Or_Partial_View;
 
+   ----------------------------------
+   -- Indexed_Component_Bit_Offset --
+   ----------------------------------
+
+   function Indexed_Component_Bit_Offset (N : Node_Id) return Uint is
+      Exp : constant Node_Id   := First (Expressions (N));
+      Typ : constant Entity_Id := Etype (Prefix (N));
+      Off : constant Uint      := Component_Size (Typ);
+      Ind : Node_Id;
+
+   begin
+      --  Return early if the component size is not known or variable
+
+      if Off = No_Uint or else Off < Uint_0 then
+         return No_Uint;
+      end if;
+
+      --  Deal with the degenerate case of an empty component
+
+      if Off = Uint_0 then
+         return Off;
+      end if;
+
+      --  Check that both the index value and the low bound are known
+
+      if not Compile_Time_Known_Value (Exp) then
+         return No_Uint;
+      end if;
+
+      Ind := First_Index (Typ);
+      if No (Ind) then
+         return No_Uint;
+      end if;
+
+      if Nkind (Ind) = N_Subtype_Indication then
+         Ind := Constraint (Ind);
+
+         if Nkind (Ind) = N_Range_Constraint then
+            Ind := Range_Expression (Ind);
+         end if;
+      end if;
+
+      if Nkind (Ind) /= N_Range
+        or else not Compile_Time_Known_Value (Low_Bound (Ind))
+      then
+         return No_Uint;
+      end if;
+
+      --  Return the scaled offset
+
+      return Off * (Expr_Value (Exp) - Expr_Value (Low_Bound ((Ind))));
+   end Indexed_Component_Bit_Offset;
+
    -----------------------------------------
    -- Inherit_Default_Init_Cond_Procedure --
    -----------------------------------------

gcc/ada/sem_util.ads

@@ -1232,6 +1232,12 @@ package Sem_Util is
    --  partial view of the same entity. Note that Id may not have a partial
    --  view in which case the function returns Empty.
 
+   function Indexed_Component_Bit_Offset (N : Node_Id) return Uint;
+   --  Given an N_Indexed_Component node, return the first bit position of the
+   --  component if it is known at compile time. A value of No_Uint means that
+   --  either the value is not yet known before back-end processing or it is
+   --  not known at compile time after back-end processing.
+
    procedure Inherit_Default_Init_Cond_Procedure (Typ : Entity_Id);
    --  Inherit the default initial condition procedure from the parent type of
    --  derived type Typ.