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 + + * gnat.dg/assign_from_packed_pixels.ads: Support for ... + * gnat.dg/assign_from_packed.adb: New testcase. + 2008-03-31 Zdenek Dvorak PR rtl-optimization/35729 Index: ada/ChangeLog =================================================================== *** ada/ChangeLog (revision 133423) --- ada/ChangeLog (working copy) *************** *** 1,3 **** --- 1,9 ---- + 2008-03-31 Olivier Hainque + Eric Botcazou + + * 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 * 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