FreeChainXenon/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

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

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

From-SVN: r135464
This commit is contained in:
Eric Botcazou 2008-05-17 08:21:08 +00:00 • committed by Eric Botcazou
parent 30da41ed0e
commit 74c11a6c4d
4 changed files with 93 additions and 28 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
gcc/ada/ChangeLog
View file

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

82
gcc/ada/trans.c
View file

@ -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));
tree gnu_target_type = gnat_to_gnu_type (gnat_target_type);
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)))))
/* 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&",

4
gcc/testsuite/ChangeLog
View file

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

30
gcc/testsuite/gnat.dg/warn4.adb Normal file
View file

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