[Ada] Assignment to a packed component with a change of representation

[Arnaud Charlet]

If the left-hand side is a packed component, The expansion of an assignment
statement uses a single bit-field operation. If the component is a record and
the right hand side of the assignment has a different representation, the
assignment must be expanded into individual component assignments, each of which
will be a bit-field assignment of its own.

The following must compile and execute quietly:

procedure Q is
  type U4 is mod 2**4;
  for U4'Size use 4;

  type R is record
     V : Integer;
     X, Y : U4;
  end record;

  type Index is new Integer range 1 .. 10;
  type A is array (Index) of R;

  type PR is new R;
  for PR use record
     V at 0 range 0 .. 31;
     X at 4 range 0 .. 3;
     Y at 4 range 4 .. 7;
  end record;
  for PR'Size use 40;

  type PA is array (Index) of PR;
  pragma Pack (PA);

  My_R : R := (V => 123, X => 5, Y => 3);
  My_PR : PR;
  My_Pa : PA;
begin
  My_PR := PR(My_R);
  My_Pa (8) := PR (My_R);

  if My_Pa (8).V /= 123
    or else My_Pa (8).Y /= 3
    or else My_Pa (8).X /= 5 
  then
     raise Program_Error;
  end if;
end;

Tested on x86_64-pc-linux-gnu, committed on trunk

2011-08-29  Ed Schonberg  <schonb...@adacore.com>

        * exp_ch5.adb (Expand_N_Assignment_Statement): For an assignment to a
        packed entity, use a bit-field assignment only if there is no change of
        representation.


Index: exp_ch5.adb
===================================================================
--- exp_ch5.adb (revision 178155)
+++ exp_ch5.adb (working copy)
@@ -1511,6 +1511,7 @@
 
    procedure Expand_N_Assignment_Statement (N : Node_Id) is
       Loc  : constant Source_Ptr := Sloc (N);
+      Crep : constant Boolean    := Change_Of_Representation (N);
       Lhs  : constant Node_Id    := Name (N);
       Rhs  : constant Node_Id    := Expression (N);
       Typ  : constant Entity_Id  := Underlying_Type (Etype (Lhs));
@@ -1780,7 +1781,7 @@
          --  Skip discriminant check if change of representation. Will be
          --  done when the change of representation is expanded out.
 
-         if not Change_Of_Representation (N) then
+         if not Crep then
             Apply_Discriminant_Check (Rhs, Etype (Lhs), Lhs);
          end if;
 
@@ -1830,7 +1831,7 @@
             --  Skip discriminant check if change of representation. Will be
             --  done when the change of representation is expanded out.
 
-            if not Change_Of_Representation (N) then
+            if not Crep then
                Apply_Discriminant_Check (Rhs, Etype (Lhs));
             end if;
 
@@ -1883,10 +1884,13 @@
          Apply_Constraint_Check (Rhs, Etype (Lhs));
       end if;
 
-      --  Case of assignment to a bit packed array element
+      --  Case of assignment to a bit packed array element. If there is a
+      --  change of representation this must be expanded into components,
+      --  otherwise this is a bit-field assignment.
 
       if Nkind (Lhs) = N_Indexed_Component
         and then Is_Bit_Packed_Array (Etype (Prefix (Lhs)))
+        and then not Crep
       then
          Expand_Bit_Packed_Element_Set (N);
          return;