[Ada] fix wrong code for assignment from packed component
Olivier Hainque
hainque@adacore.com
Mon Mar 31 18:07:00 GMT 2008
For a binary op involving possibly different GCC type nodes (e.g. a
packable type vs a regular one for the same Ada type), find_common_type
selects the common type to use for the operation, to which both
operands will be converted.
For the assignment to Pos in the testcase below ...
package Pixels is
type U16 is mod 2 ** 16;
type Position is record
X, Y, Z : U16;
end record;
for Position'Size use 48;
type Pixel is record
Pos : Position;
end record;
pragma Pack (Pixel);
Minus_One : Integer := -1;
Pix : Pixel := (Pos => (X => 0, Y => 0, Z => 0));
end;
with Pixels; use Pixels;
procedure Q is
A : Integer := Minus_One;
Pos : Position;
begin
Pos := Pix.Pos;
if A /= Minus_One then
raise Program_Error;
end if;
end;
... we have a BLKmode 48bits type on the lhs and a DImode
"packable" type on the rhs. find_common_type favors the rhs type
because it is integral vs BLK mode in this case, and we end up
with a 64bit store visible from the .original dump:
Q ()
{
const integer a = (const integer) pixels__minus_one;
struct pixels__position pos;
VIEW_CONVERT_EXPR<struct pixels__position>(pos) = pixels__pix.pos;
The lhs is only 48bits long, however, so this assignment is clobbering
data around, for instance a piece of the "A" local variable on X86-linux.
The testcase above is expected to compile and run silently.
The fix here is to make sure we select the lhs type when it is known
to be smaller, whatever the modes, as this might be for an assignment
and we must prevent writing more than what the target object may hold.
This would be wrong for tagged types but this case is handled by
build_binary_op directly.
Bootstrapped and regtested on x86_64-suse-linux.
2008-03-31 Olivier Hainque <hainque@adacore.com>
Eric Botcazou <botcazou@adacore.com>
ada/
* utils2.c (find_common_type): Document assumption on t1/t2 vs
lhs/rhs. Force use of lhs type if smaller, whatever the modes.
testsuite/
* gnat.dg/assign_from_packed.adb: New testcase.
-------------- next part --------------
Index: testsuite/gnat.dg/assign_from_packed_pixels.ads
===================================================================
*** testsuite/gnat.dg/assign_from_packed_pixels.ads (revision 0)
--- testsuite/gnat.dg/assign_from_packed_pixels.ads (revision 0)
***************
*** 0 ****
--- 1,18 ----
+
+ package Assign_From_Packed_Pixels is
+
+ type U16 is mod 2 ** 16;
+
+ type Position is record
+ X, Y, Z : U16;
+ end record;
+ for Position'Size use 48;
+
+ type Pixel is record
+ Pos : Position;
+ end record;
+ pragma Pack (Pixel);
+
+ Minus_One : Integer := -1;
+ Pix : Pixel := (Pos => (X => 0, Y => 0, Z => 0));
+ end;
Index: testsuite/gnat.dg/assign_from_packed.adb
===================================================================
*** testsuite/gnat.dg/assign_from_packed.adb (revision 0)
--- testsuite/gnat.dg/assign_from_packed.adb (revision 0)
***************
*** 0 ****
--- 1,15 ----
+ -- { dg-do run }
+
+ with assign_from_packed_pixels;
+ use assign_from_packed_pixels;
+
+ procedure assign_from_packed is
+
+ A : Integer := Minus_One;
+ Pos : Position;
+ begin
+ Pos := Pix.Pos;
+ if A /= Minus_One then
+ raise Program_Error;
+ end if;
+ end;
Index: testsuite/ChangeLog
===================================================================
*** testsuite/ChangeLog (revision 133756)
--- testsuite/ChangeLog (working copy)
***************
*** 1,3 ****
--- 1,8 ----
+ 2008-03-31 Olivier Hainque <hainque@adacore.com>
+
+ * gnat.dg/assign_from_packed_pixels.ads: Support for ...
+ * gnat.dg/assign_from_packed.adb: New testcase.
+
2008-03-31 Zdenek Dvorak <ook@ucw.cz>
PR rtl-optimization/35729
Index: ada/ChangeLog
===================================================================
*** ada/ChangeLog (revision 133423)
--- ada/ChangeLog (working copy)
***************
*** 1,3 ****
--- 1,9 ----
+ 2008-03-31 Olivier Hainque <hainque@adacore.com>
+ Eric Botcazou <botcazou@adacore.com>
+
+ * utils2.c (find_common_type): Document assumption on t1/t2 vs
+ lhs/rhs. Force use of lhs type if smaller, whatever the modes.
+
2008-03-21 Olivier Hainque <hainque@adacore.com>
* trans.c (Attribute_to_gnu) <'length>: Compute as (hb < lb)
Index: ada/utils2.c
===================================================================
*** ada/utils2.c (revision 133345)
--- ada/utils2.c (working copy)
*************** known_alignment (tree exp)
*** 228,264 ****
return MAX (type_alignment, this_alignment);
}
! /* We have a comparison or assignment operation on two types, T1 and T2,
! which are both either array types or both record types.
! Return the type that both operands should be converted to, if any.
Otherwise return zero. */
static tree
find_common_type (tree t1, tree t2)
{
! /* If either type is non-BLKmode, use it. Note that we know that we will
! not have any alignment problems since if we did the non-BLKmode
! type could not have been used. */
if (TYPE_MODE (t1) != BLKmode)
return t1;
- else if (TYPE_MODE (t2) != BLKmode)
- return t2;
! /* If both types have constant size, use the smaller one. Keep returning
! T1 if we have a tie, to be consistent with the other cases. */
! if (TREE_CONSTANT (TYPE_SIZE (t1)) && TREE_CONSTANT (TYPE_SIZE (t2)))
! return tree_int_cst_lt (TYPE_SIZE (t2), TYPE_SIZE (t1)) ? t2 : t1;
! /* Otherwise, if either type has a constant size, use it. */
! else if (TREE_CONSTANT (TYPE_SIZE (t1)))
! return t1;
! else if (TREE_CONSTANT (TYPE_SIZE (t2)))
return t2;
! /* In this case, both types have variable size. It's probably
! best to leave the "type mismatch" because changing it could
! case a bad self-referential reference. */
! return 0;
}
/* See if EXP contains a SAVE_EXPR in a position where we would
--- 228,280 ----
return MAX (type_alignment, this_alignment);
}
! /* We have a comparison or assignment operation on two types, T1 and T2, which
! are either both array types or both record types. T1 is assumed to be for
! the left hand side operand, and T2 for the right hand side. Return the
! type that both operands should be converted to for the operation, if any.
Otherwise return zero. */
static tree
find_common_type (tree t1, tree t2)
{
! /* ??? As of today, various constructs lead here with types of different
! sizes even when both constants (e.g. tagged types, packable vs regular
! component types, padded vs unpadded types, ...). While some of these
! would better be handled upstream (types should be made consistent before
! calling into build_binary_op), some others are really expected and we
! have to be careful. */
!
! /* We must prevent writing more than what the target may hold if this is for
! an assignment and the case of tagged types is handled in build_binary_op
! so use the lhs type if it is known to be smaller, or of constant size and
! the rhs type is not, whatever the modes. We also force t1 in case of
! contant size equality to minimize occurrences of view conversions on the
! lhs of assignments. */
! if (TREE_CONSTANT (TYPE_SIZE (t1))
! && (!TREE_CONSTANT (TYPE_SIZE (t2))
! || !tree_int_cst_lt (TYPE_SIZE (t2), TYPE_SIZE (t1))))
! return t1;
!
! /* Otherwise, if the lhs type is non-BLKmode, use it. Note that we know
! that we will not have any alignment problems since, if we did, the
! non-BLKmode type could not have been used. */
if (TYPE_MODE (t1) != BLKmode)
return t1;
! /* If the rhs type is of constant size, use it whatever the modes. At
! this point it is known to be smaller, or of constant size and the
! lhs type is not. */
! if (TREE_CONSTANT (TYPE_SIZE (t2)))
! return t2;
! /* Otherwise, if the rhs type is non-BLKmode, use it. */
! if (TYPE_MODE (t2) != BLKmode)
return t2;
! /* In this case, both types have variable size and BLKmode. It's
! probably best to leave the "type mismatch" because changing it
! could cause a bad self-referential reference. */
! return NULL_TREE;
}
/* See if EXP contains a SAVE_EXPR in a position where we would
More information about the Gcc-patches
mailing list