checks.adb (Apply_Address_Clause_Check): Remove Size_Warning_Output local…

checks.adb (Apply_Address_Clause_Check): Remove Size_Warning_Output local variable and do not test it in...

	* checks.adb (Apply_Address_Clause_Check): Remove Size_Warning_Output
	local variable and do not test it in Compile_Time_Bad_Alignment.
	Do not issue size or alignment warnings for the X'Address form.
	* sem_util.ads (Find_Overlaid_Object): Delete.
	(Find_Overlaid_Entity): New procedure.
	* sem_util.adb (Find_Overlaid_Object): Rename to...
	(Find_Overlaid_Entity): ...this and turn into a procedure.  Report
	whether the address is offseted within the overlaid entity.
	(Has_Compatible_Alignment): Track the offset globally instead of
	passing it to Check_Offset.  For an indexed component, compute the
	full offset when possible.  If the resulting offset is zero, only
	check the prefix.
	(Check_Offset): Delete.
	* sem_ch13.adb (Address_Clause_Check_Record): Add Off field.
	(Address_Aliased_Entity): Delete.
	(Analyze_Attribute_Definition_Clause) <Attribute_Address>: Call
	Find_Overlaid_Entity to find the overlaid entity and the offset.
	Adjust throughout for above change.
	(Validate_Address_Clauses): Always use attributes of entities, not of
	their type.  Tweak message for warning.  Call Has_Compatible_Alignment
	if the address is offseted to warn about incompatible alignments.
	* gcc-interface/gigi.h (annotate_object): Declare.
	* gcc-interface/decl.c (gnat_to_gnu_entity) <object>: Annotate renaming
	entity.  Call annotate_object instead of annotating manually objects.
	(annotate_object): New function.
	* gcc-interface/trans.c (Subprogram_Body_to_gnu): Annotate parameters
	at the end.

From-SVN: r149520

gcc/ada/ChangeLog

 2009-07-11  Eric Botcazou  <ebotcazou@adacore.com>
 
+	* checks.adb (Apply_Address_Clause_Check): Remove Size_Warning_Output
+	local variable and do not test it in Compile_Time_Bad_Alignment.
+	Do not issue size or alignment warnings for the X'Address form.
+	* sem_util.ads (Find_Overlaid_Object): Delete.
+	(Find_Overlaid_Entity): New procedure.
+	* sem_util.adb (Find_Overlaid_Object): Rename to...
+	(Find_Overlaid_Entity): ...this and turn into a procedure.  Report
+	whether the address is offseted within the overlaid entity.
+	(Has_Compatible_Alignment): Track the offset globally instead of
+	passing it to Check_Offset.  For an indexed component, compute the
+	full offset when possible.  If the resulting offset is zero, only
+	check the prefix.
+	(Check_Offset): Delete.
+	* sem_ch13.adb (Address_Clause_Check_Record): Add Off field.
+	(Address_Aliased_Entity): Delete.
+	(Analyze_Attribute_Definition_Clause) <Attribute_Address>: Call
+	Find_Overlaid_Entity to find the overlaid entity and the offset.
+	Adjust throughout for above change.
+	(Validate_Address_Clauses): Always use attributes of entities, not of
+	their type.  Tweak message for warning.  Call Has_Compatible_Alignment
+	if the address is offseted to warn about incompatible alignments.
+	* gcc-interface/gigi.h (annotate_object): Declare.
+	* gcc-interface/decl.c (gnat_to_gnu_entity) <object>: Annotate renaming
+	entity.  Call annotate_object instead of annotating manually objects.
+	(annotate_object): New function.
+	* gcc-interface/trans.c (Subprogram_Body_to_gnu): Annotate parameters
+	at the end.
+
+2009-07-11  Eric Botcazou  <ebotcazou@adacore.com>
+
 	* gcc-interface/ada-tree.h: Minor reorganization.
 	* gcc-interface/misc.c (gnat_print_decl): Minor tweaks.
 	(gnat_print_type): Likewise.

gcc/ada/checks.adb

@@ -532,16 +532,11 @@ package body Checks is
       --  when Aexp is a reference to a constant, in which case Expr gets
       --  reset to reference the value expression of the constant.
 
-      Size_Warning_Output : Boolean := False;
-      --  If we output a size warning we set this True, to stop generating
-      --  what is likely to be an unuseful redundant alignment warning.
-
       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. Also this warning
-      --  is suppressed if we already complained about the size.
+      --  underaligned address turns out to be OK after all.
 
       --------------------------------
       -- Compile_Time_Bad_Alignment --
@@ -549,9 +544,7 @@ package body Checks is
 
       procedure Compile_Time_Bad_Alignment is
       begin
-         if not Size_Warning_Output
-           and then Address_Clause_Overlay_Warnings
-         then
+         if Address_Clause_Overlay_Warnings then
             Error_Msg_FE
               ("?specified address for& may be inconsistent with alignment ",
                Aexp, E);
@@ -565,7 +558,24 @@ package body Checks is
    --  Start of processing for Apply_Address_Clause_Check
 
    begin
-      --  First obtain expression from address clause
+      --  See if alignment check needed. Note that we never need a check if the
+      --  maximum alignment is one, since the check will always succeed.
+
+      --  Note: we do not check for checks suppressed here, since that check
+      --  was done in Sem_Ch13 when the address clause was processed. We are
+      --  only called if checks were not suppressed. The reason for this is
+      --  that we have to delay the call to Apply_Alignment_Check till freeze
+      --  time (so that all types etc are elaborated), but we have to check
+      --  the status of check suppressing at the point of the address clause.
+
+      if No (AC)
+        or else not Check_Address_Alignment (AC)
+        or else Maximum_Alignment = 1
+      then
+         return;
+      end if;
+
+      --  Obtain expression from address clause
 
       Expr := Expression (AC);
 
@@ -603,69 +613,7 @@ package body Checks is
          end if;
       end loop;
 
-      --  Output a warning if we have the situation of
-
-      --      for X'Address use Y'Address
-
-      --  and X and Y both have known object sizes, and Y is smaller than X
-
-      if Nkind (Expr) = N_Attribute_Reference
-        and then Attribute_Name (Expr) = Name_Address
-        and then Is_Entity_Name (Prefix (Expr))
-      then
-         declare
-            Exp_Ent  : constant Entity_Id := Entity (Prefix (Expr));
-            Obj_Size : Uint := No_Uint;
-            Exp_Size : Uint := No_Uint;
-
-         begin
-            if Known_Esize (E) then
-               Obj_Size := Esize (E);
-            elsif Known_Esize (Etype (E)) then
-               Obj_Size := Esize (Etype (E));
-            end if;
-
-            if Known_Esize (Exp_Ent) then
-               Exp_Size := Esize (Exp_Ent);
-            elsif Known_Esize (Etype (Exp_Ent)) then
-               Exp_Size := Esize (Etype (Exp_Ent));
-            end if;
-
-            if Obj_Size /= No_Uint
-              and then Exp_Size /= No_Uint
-              and then Obj_Size > Exp_Size
-              and then not Has_Warnings_Off (E)
-            then
-               if Address_Clause_Overlay_Warnings then
-                  Error_Msg_FE
-                    ("?& overlays smaller object", Aexp, E);
-                  Error_Msg_FE
-                    ("\?program execution may be erroneous", Aexp, E);
-                  Size_Warning_Output := True;
-                  Set_Address_Warning_Posted (AC);
-               end if;
-            end if;
-         end;
-      end if;
-
-      --  See if alignment check needed. Note that we never need a check if the
-      --  maximum alignment is one, since the check will always succeed.
-
-      --  Note: we do not check for checks suppressed here, since that check
-      --  was done in Sem_Ch13 when the address clause was processed. We are
-      --  only called if checks were not suppressed. The reason for this is
-      --  that we have to delay the call to Apply_Alignment_Check till freeze
-      --  time (so that all types etc are elaborated), but we have to check
-      --  the status of check suppressing at the point of the address clause.
-
-      if No (AC)
-        or else not Check_Address_Alignment (AC)
-        or else Maximum_Alignment = 1
-      then
-         return;
-      end if;
-
-      --  See if we know that Expr is a bad alignment at compile time
+      --  See if we know that Expr has a bad alignment at compile time
 
       if Compile_Time_Known_Value (Expr)
         and then (Known_Alignment (E) or else Known_Alignment (Typ))
@@ -690,20 +638,14 @@ package body Checks is
 
       --  If the expression has the form X'Address, then we can find out if
       --  the object X has an alignment that is compatible with the object E.
+      --  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.
 
       elsif Nkind (Expr) = N_Attribute_Reference
         and then Attribute_Name (Expr) = Name_Address
+        and then Has_Compatible_Alignment (E, Prefix (Expr)) = Known_Compatible
       then
-         declare
-            AR : constant Alignment_Result :=
-                   Has_Compatible_Alignment (E, Prefix (Expr));
-         begin
-            if AR = Known_Compatible then
          return;
-            elsif AR = Known_Incompatible then
-               Compile_Time_Bad_Alignment;
-            end if;
-         end;
       end if;
 
       --  Here we do not know if the value is acceptable. Stricly we don't have

gcc/ada/gcc-interface/decl.c

@@ -905,6 +905,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 			  mark_visited (&gnu_decl);
 			save_gnu_tree (gnat_entity, gnu_decl, true);
 			saved = true;
+			annotate_object (gnat_entity, gnu_type, NULL_TREE,
+					 false);
 			break;
 		      }
 
@@ -1382,32 +1384,15 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 	    && Exception_Mechanism != Back_End_Exceptions)
 	  TREE_ADDRESSABLE (gnu_decl) = 1;
 
-	gnu_type = TREE_TYPE (gnu_decl);
-
-	/* Back-annotate Alignment and Esize of the object if not already
-	   known, except for when the object is actually a pointer to the
-	   real object, since alignment and size of a pointer don't have
-	   anything to do with those of the designated object.  Note that
-	   we pick the values of the type, not those of the object, to
-	   shield ourselves from low-level platform-dependent adjustments
-	   like alignment promotion.  This is both consistent with all the
-	   treatment above, where alignment and size are set on the type of
-	   the object and not on the object directly, and makes it possible
-	   to support confirming representation clauses in all cases.  */
-
-	if (!used_by_ref && Unknown_Alignment (gnat_entity))
-	  Set_Alignment (gnat_entity,
-			 UI_From_Int (TYPE_ALIGN (gnu_type) / BITS_PER_UNIT));
-
-	if (!used_by_ref && Unknown_Esize (gnat_entity))
-	  {
-	    if (TREE_CODE (gnu_type) == RECORD_TYPE
-		&& TYPE_CONTAINS_TEMPLATE_P (gnu_type))
-	      gnu_object_size
-		= TYPE_SIZE (TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (gnu_type))));
-
-	    Set_Esize (gnat_entity, annotate_value (gnu_object_size));
-	  }
+	/* Back-annotate Esize and Alignment of the object if not already
+	   known.  Note that we pick the values of the type, not those of
+	   the object, to shield ourselves from low-level platform-dependent
+	   adjustments like alignment promotion.  This is both consistent with
+	   all the treatment above, where alignment and size are set on the
+	   type of the object and not on the object directly, and makes it
+	   possible to support all confirming representation clauses.  */
+	annotate_object (gnat_entity, TREE_TYPE (gnu_decl), gnu_object_size,
+			 used_by_ref);
       }
       break;
 
@@ -7223,6 +7208,39 @@ annotate_value (tree gnu_size)
   return ret;
 }
 
+/* Given GNAT_ENTITY, an object (constant, variable, parameter, exception)
+   and GNU_TYPE, its corresponding GCC type, set Esize and Alignment to the
+   size and alignment used by Gigi.  Prefer SIZE over TYPE_SIZE if non-null.
+   BY_REF is true if the object is used by reference.  */
+
+void
+annotate_object (Entity_Id gnat_entity, tree gnu_type, tree size, bool by_ref)
+{
+  if (by_ref)
+    {
+      if (TYPE_FAT_POINTER_P (gnu_type))
+	gnu_type = TYPE_UNCONSTRAINED_ARRAY (gnu_type);
+      else
+	gnu_type = TREE_TYPE (gnu_type);
+    }
+
+  if (Unknown_Esize (gnat_entity))
+    {
+      if (TREE_CODE (gnu_type) == RECORD_TYPE
+	  && TYPE_CONTAINS_TEMPLATE_P (gnu_type))
+	size = TYPE_SIZE (TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (gnu_type))));
+      else if (!size)
+	size = TYPE_SIZE (gnu_type);
+
+      if (size)
+	Set_Esize (gnat_entity, annotate_value (size));
+    }
+
+  if (Unknown_Alignment (gnat_entity))
+    Set_Alignment (gnat_entity,
+		   UI_From_Int (TYPE_ALIGN (gnu_type) / BITS_PER_UNIT));
+}
+
 /* Given GNAT_ENTITY, a record type, and GNU_TYPE, its corresponding
    GCC type, set Component_Bit_Offset and Esize to the position and size
    used by Gigi.  */

gcc/ada/gcc-interface/gigi.h

@@ -135,6 +135,13 @@ extern tree maybe_pad_type (tree type, tree size, unsigned int align,
    the value passed against the list of choices.  */
 extern tree choices_to_gnu (tree operand, Node_Id choices);
 
+/* Given GNAT_ENTITY, an object (constant, variable, parameter, exception)
+   and GNU_TYPE, its corresponding GCC type, set Esize and Alignment to the
+   size and alignment used by Gigi.  Prefer SIZE over TYPE_SIZE if non-null.
+   BY_REF is true if the object is used by reference.  */
+extern void annotate_object (Entity_Id gnat_entity, tree gnu_type, tree size,
+			     bool by_ref);
+
 /* Given a type T, a FIELD_DECL F, and a replacement value R, return a new
    type with all size expressions that contain F updated by replacing F
    with R.  If F is NULL_TREE, always make a new RECORD_TYPE, even if

gcc/ada/gcc-interface/trans.c

@@ -2328,13 +2328,18 @@ Subprogram_Body_to_gnu (Node_Id gnat_node)
 
   end_subprog_body (gnu_result, false);
 
-  /* Disconnect the trees for parameters that we made variables for from the
-     GNAT entities since these are unusable after we end the function.  */
+  /* Finally annotate the parameters and disconnect the trees for parameters
+     that we have turned into variables since they are now unusable.  */
   for (gnat_param = First_Formal_With_Extras (gnat_subprog_id);
        Present (gnat_param);
        gnat_param = Next_Formal_With_Extras (gnat_param))
-    if (TREE_CODE (get_gnu_tree (gnat_param)) == VAR_DECL)
+    {
+      tree gnu_param = get_gnu_tree (gnat_param);
+      annotate_object (gnat_param, TREE_TYPE (gnu_param), NULL_TREE,
+		       DECL_BY_REF_P (gnu_param));
+      if (TREE_CODE (gnu_param) == VAR_DECL)
 	save_gnu_tree (gnat_param, NULL_TREE, false);
+    }
 
   if (DECL_FUNCTION_STUB (gnu_subprog_decl))
     build_function_stub (gnu_subprog_decl, gnat_subprog_id);

gcc/ada/sem_util.ads

@@ -320,12 +320,16 @@ package Sem_Util is
    --  denotes when analyzed. Subsequent uses of this id on a different
    --  type denote the discriminant at the same position in this new type.
 
-   function Find_Overlaid_Object (N : Node_Id) return Entity_Id;
-   --  The node N should be an address representation clause. This function
-   --  checks if the target expression is the address of some stand alone
-   --  object (variable or constant), and if so, returns its entity. If N is
-   --  not an address representation clause, or if it is not possible to
-   --  determine that the address is of this form, then Empty is returned.
+   procedure Find_Overlaid_Entity
+     (N : Node_Id;
+      Ent : out Entity_Id;
+      Off : out Boolean);
+   --  The node N should be an address representation clause. Determines if
+   --  the target expression is the address of an entity with an optional
+   --  offset. If so, set Ent to the entity and, if there is an offset, set
+   --  Off to True, otherwise to False. If N is not an address representation
+   --  clause, or if it is not possible to determine that the address is of
+   --  this form, then set Ent to Empty.
 
    function Find_Parameter_Type (Param : Node_Id) return Entity_Id;
    --  Return the type of formal parameter Param as determined by its

gcc/testsuite/ChangeLog

+2009-07-11  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* gnat.dg/specs/addr1.ads: New test.
+
 2009-07-11  Jan Hubicka  <jh@suse.cz>
 
 	PR middle-end/48388

gcc/testsuite/gnat.dg/specs/addr1.ads

+-- { dg-do compile }
+
+with Interfaces; use Interfaces;
+
+package Addr1 is
+
+  type Arr is array (Integer range <>) of Unsigned_16;
+
+  type Rec1 is record
+    I1, I2: Integer;
+  end record;
+
+  type Rec2 is record
+    I1, I2: Integer;
+  end record;
+  for Rec2'Size use 64;
+
+  A: Arr (1 .. 12);
+
+  Obj1: Rec1;
+  for Obj1'Address use A'Address; -- { dg-bogus "alignment" }
+
+  Obj2: Rec2;
+  for Obj2'Address use A'Address; -- { dg-bogus "alignment" }
+
+  Obj3: Rec1;
+  for Obj3'Address use A(1)'Address; -- { dg-bogus "alignment" }
+
+  Obj4: Rec1;
+  for Obj4'Address use A(2)'Address; -- { dg-warning "(alignment|erroneous)" }
+
+  Obj5: Rec1;
+  for Obj5'Address use A(3)'Address; -- { dg-bogus "alignment" }
+
+end Addr1;