trans.c (add_decl_expr): At toplevel, mark the TYPE_ADA_SIZE field of records and unions.

	* trans.c (add_decl_expr): At toplevel, mark the TYPE_ADA_SIZE field
	of records and unions.
	(gnat_to_gnu) <N_Validate_Unchecked_Conversion>: Fix formatting.

From-SVN: r135333

gcc/ada/ChangeLog

+2008-05-15  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* trans.c (add_decl_expr): At toplevel, mark the TYPE_ADA_SIZE field
+	of records and unions.
+	(gnat_to_gnu) <N_Validate_Unchecked_Conversion>: Fix formatting.
+
 2008-05-14  Samuel Tardieu  <sam@rfc1149.net>
             Robert Dewar <dewar@adacore.com>
 

gcc/ada/trans.c

@@ -4778,31 +4778,31 @@ gnat_to_gnu (Node_Id gnat_node)
 
     case N_Validate_Unchecked_Conversion:
       /* If the result is a pointer type, see if we are either converting
-         from a non-pointer or from a pointer to a type with a different
- 	 alias set and warn if so.  If the result defined in the same unit as
- 	 this unchecked conversion, we can allow this because we can know to
- 	 make that type have alias set 0.  */
+	 from a non-pointer or from a pointer to a type with a different
+	 alias set and warn if so.  If the result defined in the same unit as
+	 this unchecked conversion, we can allow this because we can know to
+	 make that type have alias set 0.  */
       {
- 	tree gnu_source_type = gnat_to_gnu_type (Source_Type (gnat_node));
- 	tree gnu_target_type = gnat_to_gnu_type (Target_Type (gnat_node));
-
- 	if (POINTER_TYPE_P (gnu_target_type)
- 	    && !In_Same_Source_Unit (Target_Type (gnat_node), gnat_node)
-            && get_alias_set (TREE_TYPE (gnu_target_type)) != 0
-            && !No_Strict_Aliasing (Underlying_Type (Target_Type (gnat_node)))
- 	    && (!POINTER_TYPE_P (gnu_source_type)
- 		|| (get_alias_set (TREE_TYPE (gnu_source_type))
- 		    != get_alias_set (TREE_TYPE (gnu_target_type)))))
- 	  {
-            post_error_ne
-              ("?possible aliasing problem for type&",
-               gnat_node, Target_Type (gnat_node));
+	tree gnu_source_type = gnat_to_gnu_type (Source_Type (gnat_node));
+	tree gnu_target_type = gnat_to_gnu_type (Target_Type (gnat_node));
+
+	if (POINTER_TYPE_P (gnu_target_type)
+	    && !In_Same_Source_Unit (Target_Type (gnat_node), gnat_node)
+	    && get_alias_set (TREE_TYPE (gnu_target_type)) != 0
+	    && !No_Strict_Aliasing (Underlying_Type (Target_Type (gnat_node)))
+	    && (!POINTER_TYPE_P (gnu_source_type)
+		|| (get_alias_set (TREE_TYPE (gnu_source_type))
+		    != get_alias_set (TREE_TYPE (gnu_target_type)))))
+	  {
+	    post_error_ne
+	      ("?possible aliasing problem for type&",
+	       gnat_node, Target_Type (gnat_node));
 	    post_error
-              ("\\?use -fno-strict-aliasing switch for references",
-               gnat_node);
+	      ("\\?use -fno-strict-aliasing switch for references",
+	       gnat_node);
 	    post_error_ne
-              ("\\?or use `pragma No_Strict_Aliasing (&);`",
-               gnat_node, Target_Type (gnat_node));
+	      ("\\?or use `pragma No_Strict_Aliasing (&);`",
+	       gnat_node, Target_Type (gnat_node));
 	  }
 
 	/* The No_Strict_Aliasing flag is not propagated to the back-end for
@@ -5055,7 +5055,7 @@ void
 add_decl_expr (tree gnu_decl, Entity_Id gnat_entity)
 {
   tree type = TREE_TYPE (gnu_decl);
-  tree gnu_stmt, gnu_init, gnu_lhs;
+  tree gnu_stmt, gnu_init, t;
 
   /* If this is a variable that Gigi is to ignore, we may have been given
      an ERROR_MARK.  So test for it.  We also might have been given a
@@ -5074,7 +5074,7 @@ add_decl_expr (tree gnu_decl, Entity_Id gnat_entity)
   if (global_bindings_p ())
     {
       /* Mark everything as used to prevent node sharing with subprograms.
-	 Note that walk_tree knows how to handle TYPE_DECL, but neither
+	 Note that walk_tree knows how to deal with TYPE_DECL, but neither
 	 VAR_DECL nor CONST_DECL.  This appears to be somewhat arbitrary.  */
       walk_tree (&gnu_stmt, mark_visited, NULL, NULL);
       if (TREE_CODE (gnu_decl) == VAR_DECL
@@ -5084,6 +5084,13 @@ add_decl_expr (tree gnu_decl, Entity_Id gnat_entity)
 	  walk_tree (&DECL_SIZE_UNIT (gnu_decl), mark_visited, NULL, NULL);
 	  walk_tree (&DECL_INITIAL (gnu_decl), mark_visited, NULL, NULL);
 	}
+      /* In any case, we have to deal with our own TYPE_ADA_SIZE field.  */
+      if (TREE_CODE (gnu_decl) == TYPE_DECL
+	  && (TREE_CODE (type) == RECORD_TYPE
+	      || TREE_CODE (type) == UNION_TYPE
+	      || TREE_CODE (type) == QUAL_UNION_TYPE)
+	  && (t = TYPE_ADA_SIZE (type)))
+	walk_tree (&t, mark_visited, NULL, NULL);
     }
   else
     add_stmt_with_node (gnu_stmt, gnat_entity);
@@ -5100,11 +5107,11 @@ add_decl_expr (tree gnu_decl, Entity_Id gnat_entity)
       /* If GNU_DECL has a padded type, convert it to the unpadded
 	 type so the assignment is done properly.  */
       if (TREE_CODE (type) == RECORD_TYPE && TYPE_IS_PADDING_P (type))
-	gnu_lhs = convert (TREE_TYPE (TYPE_FIELDS (type)), gnu_decl);
+	t = convert (TREE_TYPE (TYPE_FIELDS (type)), gnu_decl);
       else
-	gnu_lhs = gnu_decl;
+	t = gnu_decl;
 
-      gnu_stmt = build_binary_op (MODIFY_EXPR, NULL_TREE, gnu_lhs, gnu_init);
+      gnu_stmt = build_binary_op (MODIFY_EXPR, NULL_TREE, t, gnu_init);
 
       DECL_INITIAL (gnu_decl) = NULL_TREE;
       if (TREE_READONLY (gnu_decl))

gcc/testsuite/ChangeLog

+2008-05-15  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* gnat.dg/discr8.ad[sb]: New test.
+	* gnat.dg/discr8_pkg[123].ads: New helpers.
+
 2008-05-15  H.J. Lu  <hongjiu.lu@intel.com>
 
 	* gcc.target/i386/sse-set-ps-1.c: New.

gcc/testsuite/gnat.dg/discr8.adb

+-- { dg-do compile }
+-- { dg-options "-gnatws" }
+
+package body Discr8 is
+
+  procedure Make (C : out Local_T) is
+    Tmp : Local_T (Tag_One);
+  begin
+    C := Tmp;
+  end;
+
+  package Iteration is
+
+    type Message_T is
+      record
+        S : Local_T;
+      end record;
+
+    type Iterator_T is
+      record
+        S : Local_T;
+      end record;
+
+    type Access_Iterator_T is access Iterator_T;
+
+  end Iteration;
+
+  package body Iteration is
+
+    procedure Construct (Iterator : in out Access_Iterator_T;
+                         Message  : Message_T) is
+    begin
+      Iterator.S := Message.S;
+    end;
+
+  end Iteration;
+
+end Discr8;

gcc/testsuite/gnat.dg/discr8.ads

+with Discr8_Pkg1; use Discr8_Pkg1;
+
+package Discr8 is
+
+  type Tag_T is (Tag_One, Tag_Two);
+
+  type Local_T (Tag : Tag_T := Tag_One) is
+    record
+      case Tag is
+        when Tag_One =>
+          A : T;
+          B : Integer;
+        when Tag_Two =>
+          null;
+      end case;
+    end record;
+
+  procedure Make (C : out Local_T);
+
+end Discr8;

gcc/testsuite/gnat.dg/discr8_pkg1.ads

+with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
+with Discr8_Pkg2; use Discr8_Pkg2;
+
+package Discr8_Pkg1 is
+
+  type T is record
+    A : Unbounded_String;
+    B : L;
+  end record;
+
+end Discr8_Pkg1;

gcc/testsuite/gnat.dg/discr8_pkg2.ads

+with Discr8_Pkg3; use Discr8_Pkg3;
+
+package Discr8_Pkg2 is
+
+  Max : constant Natural := Value;
+
+  type List_T is array (Natural range <>) of Integer;
+  
+  type L is record
+    List : List_T (1 .. Max);
+  end record;
+  
+end Discr8_Pkg2;

gcc/testsuite/gnat.dg/discr8_pkg3.ads

+package Discr8_Pkg3 is
+  function Value return Natural;
+end Discr8_Pkg3;