[Ada] fix wrong code for assignment from packed component

[Olivier Hainque <hainque at adacore dot com>]

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.

Attachment: assign_from_packed.dif
Description: Text document