From 74c11a6c4d7b55e0e903a99fe58dfd491ce4fc2c Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Sat, 17 May 2008 08:21:08 +0000 Subject: [PATCH] trans.c (gnat_to_gnu): Account for dummy types pointed to by the converted pointer types. * trans.c (gnat_to_gnu) : Account for dummy types pointed to by the converted pointer types. From-SVN: r135464 --- gcc/ada/ChangeLog | 5 ++ gcc/ada/trans.c | 84 +++++++++++++++++++++------------ gcc/testsuite/ChangeLog | 4 ++ gcc/testsuite/gnat.dg/warn4.adb | 30 ++++++++++++ 4 files changed, 94 insertions(+), 29 deletions(-) create mode 100644 gcc/testsuite/gnat.dg/warn4.adb diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 83e9177af71..5975265e9e5 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,8 @@ +2008-05-17 Eric Botcazou + + * trans.c (gnat_to_gnu) : Account + for dummy types pointed to by the converted pointer types. + 2008-05-15 Eric Botcazou * 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 f7dd9b9aadf..76592fe2b46 100644 --- 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 7bed29c77bc..a50160189cd 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2008-05-17 Eric Botcazou + + * gnat.dg/warn4.adb: New test. + 2008-05-16 Paul Thomas PR fortran/35756 diff --git a/gcc/testsuite/gnat.dg/warn4.adb b/gcc/testsuite/gnat.dg/warn4.adb new file mode 100644 index 00000000000..94147c1e6f5 --- /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; -- 2.30.2