trans.c (gnat_to_gnu): Account for dummy types pointed to by the converted pointer...

	* trans.c (gnat_to_gnu) <N_Validate_Unchecked_Conversion>: Account
	for dummy types pointed to by the converted pointer types.

From-SVN: r135464

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 83e9177af7159c1dd94765d1d486fc2eea53d768..5975265e9e5312e54fda724b87468edd888e7860 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,8 @@
+2008-05-17  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * trans.c (gnat_to_gnu) <N_Validate_Unchecked_Conversion>: Account
+       for dummy types pointed to by the converted pointer types.
+
 2008-05-15  Eric Botcazou  <ebotcazou@adacore.com>
 
        * trans.c (add_decl_expr): At toplevel, mark the TYPE_ADA_SIZE field

diff --git a/gcc/ada/trans.c b/gcc/ada/trans.c
index f7dd9b9aadfe866836a4ba32a384a886b6838627..76592fe2b460469b994c3d93c8bf009cdb4b64a4 100644 (file)
--- a/gcc/ada/trans.c
+++ b/gcc/ada/trans.c
@@ -4777,45 +4777,71 @@ gnat_to_gnu (Node_Id gnat_node)
       break;
 
     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.  */
       {
+       Entity_Id gnat_target_type = 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)))))
+       tree gnu_target_type = gnat_to_gnu_type (gnat_target_type);
+
+       /* No need for any warning in this case.  */
+       if (!flag_strict_aliasing)
+         ;
+
+       /* 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 is defined in the same
+          unit as this unchecked conversion, we can allow this because we
+          can know to make the pointer type behave properly.  */
+       else if (POINTER_TYPE_P (gnu_target_type)
+                && !In_Same_Source_Unit (gnat_target_type, gnat_node)
+                && !No_Strict_Aliasing (Underlying_Type (gnat_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);
-           post_error_ne
-             ("\\?or use `pragma No_Strict_Aliasing (&);`",
-              gnat_node, Target_Type (gnat_node));
+           tree gnu_source_desig_type = POINTER_TYPE_P (gnu_source_type)
+                                        ? TREE_TYPE (gnu_source_type)
+                                        : NULL_TREE;
+           tree gnu_target_desig_type = TREE_TYPE (gnu_target_type);
+
+           if ((TYPE_DUMMY_P (gnu_target_desig_type)
+                || get_alias_set (gnu_target_desig_type) != 0)
+               && (!POINTER_TYPE_P (gnu_source_type)
+                   || (TYPE_DUMMY_P (gnu_source_desig_type)
+                       != TYPE_DUMMY_P (gnu_target_desig_type))
+                   || (TYPE_DUMMY_P (gnu_source_desig_type)
+                       && gnu_source_desig_type != gnu_target_desig_type)
+                   || (get_alias_set (gnu_source_desig_type)
+                       != get_alias_set (gnu_target_desig_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);
+               post_error_ne
+                 ("\\?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
-          fat pointers so unconditionally warn in problematic cases.  */
+       /* But if the result is a fat pointer type, we have no mechanism to
+          do that, so we unconditionally warn in problematic cases.  */
        else if (TYPE_FAT_POINTER_P (gnu_target_type))
          {
-           tree array_type
+           tree gnu_source_array_type
+             = TYPE_FAT_POINTER_P (gnu_source_type)
+               ? TREE_TYPE (TREE_TYPE (TYPE_FIELDS (gnu_source_type)))
+               : NULL_TREE;
+           tree gnu_target_array_type
              = TREE_TYPE (TREE_TYPE (TYPE_FIELDS (gnu_target_type)));
 
-           if (get_alias_set (array_type) != 0
+           if ((TYPE_DUMMY_P (gnu_target_array_type)
+                || get_alias_set (gnu_target_array_type) != 0)
                && (!TYPE_FAT_POINTER_P (gnu_source_type)
-                   || (get_alias_set (TREE_TYPE (TREE_TYPE (TYPE_FIELDS (gnu_source_type))))
-                       != get_alias_set (array_type))))
+                   || (TYPE_DUMMY_P (gnu_source_array_type)
+                       != TYPE_DUMMY_P (gnu_target_array_type))
+                   || (TYPE_DUMMY_P (gnu_source_array_type)
+                       && gnu_source_array_type != gnu_target_array_type)
+                   || (get_alias_set (gnu_source_array_type)
+                       != get_alias_set (gnu_target_array_type))))
              {
                post_error_ne
                  ("?possible aliasing problem for type&",

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 7bed29c77bca44b808c9554ef965625bae7a02b2..a50160189cd44a1eda4ffd0341b65391d1350117 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2008-05-17  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * gnat.dg/warn4.adb: New test.
+
 2008-05-16  Paul Thomas  <pault@gcc.gnu.org>
 
        PR fortran/35756

diff --git a/gcc/testsuite/gnat.dg/warn4.adb b/gcc/testsuite/gnat.dg/warn4.adb
new file mode 100644 (file)
index 0000000..94147c1
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/warn4.adb
@@ -0,0 +1,30 @@
+-- { dg-do compile }
+-- { dg-options "-O2" }
+
+with Unchecked_Conversion;
+
+procedure Warn4 is
+
+   type POSIX_Character is new Standard.Character;
+   type POSIX_String is array (Positive range <>) of aliased POSIX_Character;
+
+   type String_Ptr is access all String;
+   type POSIX_String_Ptr is access all POSIX_String;
+
+   function sptr_to_psptr is new Unchecked_Conversion -- { dg-warning "aliasing problem" }
+     (String_Ptr, POSIX_String_Ptr); -- { dg-warning "" "" { target *-*-* } 14 }
+
+   function To_POSIX_String (Str : String) return POSIX_String;
+   function To_POSIX_String (Str : String)
+      return POSIX_String is
+   begin
+      return sptr_to_psptr (Str'Unrestricted_Access).all;
+   end To_POSIX_String;
+
+   A : Boolean;
+   S : String := "ABCD/abcd";
+   P : Posix_String := "ABCD/abcd";
+
+begin
+   A := To_POSIX_String (S) = P;
+end;