Commit 980a0501 by Eric Botcazou Committed by Eric Botcazou

re PR ada/44892 (internal error on gnat.dg/unchecked_convert5.adb)

	PR ada/44892
	* gcc-interface/utils.c (convert): Fix thinko in test.
	(unchecked_convert): When converting from a scalar type to a type with
	a different size, pad to have the same size on both sides.

From-SVN: r162425
parent cfa0bd19
2010-07-22 Eric Botcazou <ebotcazou@adacore.com> 2010-07-22 Eric Botcazou <ebotcazou@adacore.com>
PR ada/44892
* gcc-interface/utils.c (convert): Fix thinko in test.
(unchecked_convert): When converting from a scalar type to a type with
a different size, pad to have the same size on both sides.
2010-07-22 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/utils.c (gnat_types_compatible_p): Don't require strict * gcc-interface/utils.c (gnat_types_compatible_p): Don't require strict
equality for the component type of array types. equality for the component type of array types.
......
...@@ -3702,9 +3702,10 @@ convert (tree type, tree expr) ...@@ -3702,9 +3702,10 @@ convert (tree type, tree expr)
if (ecode == RECORD_TYPE if (ecode == RECORD_TYPE
&& CONTAINS_PLACEHOLDER_P (DECL_SIZE (TYPE_FIELDS (type)))) && CONTAINS_PLACEHOLDER_P (DECL_SIZE (TYPE_FIELDS (type))))
{ {
if (TREE_CONSTANT (TYPE_SIZE (etype))) if (TREE_CODE (TYPE_SIZE (etype)) == INTEGER_CST)
expr = convert (maybe_pad_type (etype, TYPE_SIZE (type), 0, Empty, expr = convert (maybe_pad_type (etype, TYPE_SIZE (type), 0, Empty,
false, false, false, true), expr); false, false, false, true),
expr);
return unchecked_convert (type, expr, false); return unchecked_convert (type, expr, false);
} }
...@@ -4353,6 +4354,7 @@ unchecked_convert (tree type, tree expr, bool notrunc_p) ...@@ -4353,6 +4354,7 @@ unchecked_convert (tree type, tree expr, bool notrunc_p)
tree etype = TREE_TYPE (expr); tree etype = TREE_TYPE (expr);
enum tree_code ecode = TREE_CODE (etype); enum tree_code ecode = TREE_CODE (etype);
enum tree_code code = TREE_CODE (type); enum tree_code code = TREE_CODE (type);
int c;
/* If the expression is already of the right type, we are done. */ /* If the expression is already of the right type, we are done. */
if (etype == type) if (etype == type)
...@@ -4393,7 +4395,8 @@ unchecked_convert (tree type, tree expr, bool notrunc_p) ...@@ -4393,7 +4395,8 @@ unchecked_convert (tree type, tree expr, bool notrunc_p)
/* If we are converting to an integral type whose precision is not equal /* If we are converting to an integral type whose precision is not equal
to its size, first unchecked convert to a record that contains an to its size, first unchecked convert to a record that contains an
object of the output type. Then extract the field. */ object of the output type. Then extract the field. */
else if (INTEGRAL_TYPE_P (type) && TYPE_RM_SIZE (type) else if (INTEGRAL_TYPE_P (type)
&& TYPE_RM_SIZE (type)
&& 0 != compare_tree_int (TYPE_RM_SIZE (type), && 0 != compare_tree_int (TYPE_RM_SIZE (type),
GET_MODE_BITSIZE (TYPE_MODE (type)))) GET_MODE_BITSIZE (TYPE_MODE (type))))
{ {
...@@ -4410,9 +4413,10 @@ unchecked_convert (tree type, tree expr, bool notrunc_p) ...@@ -4410,9 +4413,10 @@ unchecked_convert (tree type, tree expr, bool notrunc_p)
/* Similarly if we are converting from an integral type whose precision /* Similarly if we are converting from an integral type whose precision
is not equal to its size. */ is not equal to its size. */
else if (INTEGRAL_TYPE_P (etype) && TYPE_RM_SIZE (etype) else if (INTEGRAL_TYPE_P (etype)
&& 0 != compare_tree_int (TYPE_RM_SIZE (etype), && TYPE_RM_SIZE (etype)
GET_MODE_BITSIZE (TYPE_MODE (etype)))) && 0 != compare_tree_int (TYPE_RM_SIZE (etype),
GET_MODE_BITSIZE (TYPE_MODE (etype))))
{ {
tree rec_type = make_node (RECORD_TYPE); tree rec_type = make_node (RECORD_TYPE);
tree field = create_field_decl (get_identifier ("OBJ"), etype, rec_type, tree field = create_field_decl (get_identifier ("OBJ"), etype, rec_type,
...@@ -4427,6 +4431,38 @@ unchecked_convert (tree type, tree expr, bool notrunc_p) ...@@ -4427,6 +4431,38 @@ unchecked_convert (tree type, tree expr, bool notrunc_p)
expr = unchecked_convert (type, expr, notrunc_p); expr = unchecked_convert (type, expr, notrunc_p);
} }
/* If we are converting from a scalar type to a type with a different size,
we need to pad to have the same size on both sides.
??? We cannot do it unconditionally because unchecked conversions are
used liberally by the front-end to implement polymorphism, e.g. in:
S191s : constant ada__tags__addr_ptr := ada__tags__addr_ptr!(S190s);
return p___size__4 (p__object!(S191s.all));
so we skip all expressions that are references. */
else if (!REFERENCE_CLASS_P (expr)
&& !AGGREGATE_TYPE_P (etype)
&& TREE_CODE (TYPE_SIZE (type)) == INTEGER_CST
&& (c = tree_int_cst_compare (TYPE_SIZE (etype), TYPE_SIZE (type))))
{
if (c < 0)
{
expr = convert (maybe_pad_type (etype, TYPE_SIZE (type), 0, Empty,
false, false, false, true),
expr);
expr = unchecked_convert (type, expr, notrunc_p);
}
else
{
tree rec_type = maybe_pad_type (type, TYPE_SIZE (etype), 0, Empty,
false, false, false, true);
expr = unchecked_convert (rec_type, expr, notrunc_p);
expr = build_component_ref (expr, NULL_TREE, TYPE_FIELDS (rec_type),
false);
}
}
/* We have a special case when we are converting between two unconstrained /* We have a special case when we are converting between two unconstrained
array types. In that case, take the address, convert the fat pointer array types. In that case, take the address, convert the fat pointer
types, and dereference. */ types, and dereference. */
......
2010-07-22 Eric Botcazou <ebotcazou@adacore.com> 2010-07-22 Eric Botcazou <ebotcazou@adacore.com>
* gnat.dg/unchecked_convert5b.adb: New test.
* gnat.dg/unchecked_convert6.adb: Likewise.
* gnat.dg/unchecked_convert6b.adb: Likewise.
2010-07-22 Eric Botcazou <ebotcazou@adacore.com>
* gnat.dg/aggr15.ad[sb]: New test. * gnat.dg/aggr15.ad[sb]: New test.
2010-07-22 Dodji Seketeli <dodji@redhat.com> 2010-07-22 Dodji Seketeli <dodji@redhat.com>
......
-- { dg-do run { target i?86-*-* x86_64-*-* alpha*-*-* ia64-*-* } }
with Unchecked_Conversion;
procedure Unchecked_Convert5b is
subtype c_1 is string(1..1);
function int2c1 is -- { dg-warning "different sizes" }
new unchecked_conversion (source => integer, target => c_1);
c1 : c_1;
begin
c1 := int2c1(16#12#);
if c1 (1) /= ASCII.DC2 then
raise Program_Error;
end if;
end;
-- { dg-do run { target hppa*-*-* sparc*-*-* powerpc*-*-* } }
with Unchecked_Conversion;
procedure Unchecked_Convert6 is
subtype c_5 is string(1..5);
function int2c5 is -- { dg-warning "different sizes" }
new unchecked_conversion (source => integer, target => c_5);
c5 : c_5;
begin
c5 := int2c5(16#12#);
if c5 (4) /= ASCII.DC2 then
raise Program_Error;
end if;
end;
-- { dg-do run { target i?86-*-* x86_64-*-* alpha*-*-* ia64-*-* } }
with Unchecked_Conversion;
procedure Unchecked_Convert6b is
subtype c_5 is string(1..5);
function int2c5 is -- { dg-warning "different sizes" }
new unchecked_conversion (source => integer, target => c_5);
c5 : c_5;
begin
c5 := int2c5(16#12#);
if c5 (1) /= ASCII.DC2 then
raise Program_Error;
end if;
end;
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment