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

	* 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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index b473b8e6fc21800c9c861ca106003a7e56e744ea..83e9177af7159c1dd94765d1d486fc2eea53d768 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,9 @@
+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>
 

diff --git a/gcc/ada/trans.c b/gcc/ada/trans.c
index 122857a9bbd79d5ba9a6c21b86b98694946c23af..f7dd9b9aadfe866836a4ba32a384a886b6838627 100644 (file)
--- a/gcc/ada/trans.c
+++ b/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))

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 4c08485a0bd92fe1186f8e6ff8e27c04d2051f09..10769c8b2c399755b0e0058b2fe8e55d30d0030f 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+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.

diff --git a/gcc/testsuite/gnat.dg/discr8.adb b/gcc/testsuite/gnat.dg/discr8.adb
new file mode 100644 (file)
index 0000000..cfb3d48
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/discr8.adb
@@ -0,0 +1,38 @@
+-- { 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;

diff --git a/gcc/testsuite/gnat.dg/discr8.ads b/gcc/testsuite/gnat.dg/discr8.ads
new file mode 100644 (file)
index 0000000..80dd2f6
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/discr8.ads
@@ -0,0 +1,20 @@
+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;

diff --git a/gcc/testsuite/gnat.dg/discr8_pkg1.ads b/gcc/testsuite/gnat.dg/discr8_pkg1.ads
new file mode 100644 (file)
index 0000000..ae93dc4
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/discr8_pkg1.ads
@@ -0,0 +1,11 @@
+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;

diff --git a/gcc/testsuite/gnat.dg/discr8_pkg2.ads b/gcc/testsuite/gnat.dg/discr8_pkg2.ads
new file mode 100644 (file)
index 0000000..f98318a
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/discr8_pkg2.ads
@@ -0,0 +1,13 @@
+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;

diff --git a/gcc/testsuite/gnat.dg/discr8_pkg3.ads b/gcc/testsuite/gnat.dg/discr8_pkg3.ads
new file mode 100644 (file)
index 0000000..576b40f
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/discr8_pkg3.ads
@@ -0,0 +1,3 @@
+package Discr8_Pkg3 is
+  function Value return Natural;
+end Discr8_Pkg3;