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

@@ -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;