[multiple changes]

2012-04-26  Robert Dewar  <dewar@adacore.com>

	* sem_util.adb: Minor reformatting.

2012-04-26  Thomas Quinot  <quinot@adacore.com>

	* exp_aggr.adb, exp_pakd.adb (Setup_Inline_Packed_Array_Reference,
	Packed_Array_Aggregate_Handled.Get_Component_Val):
	Reverse bit numbering within PAT when Reverse_Storage_Order
	applies to the enclosing record.

2012-04-26  Thomas Quinot  <quinot@adacore.com>

	* freeze.adb (Freeze_Record_Type): Improve error message for
	Scalar_Storage_Order inconsistent with Bit_Order.

From-SVN: r186865

gcc/ada/ChangeLog

+2012-04-26  Robert Dewar  <dewar@adacore.com>
+
+	* sem_util.adb: Minor reformatting.
+
+2012-04-26  Thomas Quinot  <quinot@adacore.com>
+
+	* exp_aggr.adb, exp_pakd.adb (Setup_Inline_Packed_Array_Reference,
+	Packed_Array_Aggregate_Handled.Get_Component_Val):
+	Reverse bit numbering within PAT when Reverse_Storage_Order
+	applies to the enclosing record.
+
+2012-04-26  Thomas Quinot  <quinot@adacore.com>
+
+	* freeze.adb (Freeze_Record_Type): Improve error message for
+	Scalar_Storage_Order inconsistent with Bit_Order.
+
 2012-04-25  Gary Dismukes  <dismukes@adacore.com>
 
 	* exp_ch9.adb: Add comments on the usage of the

gcc/ada/exp_aggr.adb

@@ -6077,12 +6077,43 @@ package body Exp_Aggr is
             Expr : Node_Id;
             --  Next expression from positional parameters of aggregate
 
+            Enclosing_Aggregate : Node_Id;
+
+            In_Reverse_Storage_Order_Record : Boolean;
+            --  True if we are within an aggregate of a record type with
+            --  reversed storage order.
+
          begin
+            --  Determine whether we are in a reversed storage order record
+            --  aggregate.
+
+            In_Reverse_Storage_Order_Record := False;
+            Enclosing_Aggregate := Parent (N);
+            while Present (Enclosing_Aggregate) loop
+               if Nkind (Enclosing_Aggregate) = N_Component_Association then
+                  null;
+
+               elsif Nkind (Enclosing_Aggregate) /= N_Aggregate then
+                  exit;
+
+               elsif Is_Record_Type (Etype (Enclosing_Aggregate))
+                    and then Reverse_Storage_Order
+                               (Etype (Enclosing_Aggregate))
+               then
+                  In_Reverse_Storage_Order_Record := True;
+                  exit;
+               end if;
+               Enclosing_Aggregate := Parent (Enclosing_Aggregate);
+            end loop;
+
             --  For little endian, we fill up the low order bits of the target
             --  value. For big endian we fill up the high order bits of the
             --  target value (which is a left justified modular value).
 
-            if Bytes_Big_Endian xor Debug_Flag_8 then
+            if Bytes_Big_Endian
+                 xor Debug_Flag_8
+                 xor In_Reverse_Storage_Order_Record
+            then
                Shift := Csiz * (Len - 1);
                Incr  := -Csiz;
             else

gcc/ada/exp_pakd.adb

@@ -1280,12 +1280,12 @@ package body Exp_Pakd is
       --  Initially Rhs is the right hand side value, it will be replaced
       --  later by an appropriate unchecked conversion for the assignment.
 
-      Obj    : Node_Id;
-      Atyp   : Entity_Id;
-      PAT    : Entity_Id;
-      Ctyp   : Entity_Id;
-      Csiz   : Int;
-      Cmask  : Uint;
+      Obj   : Node_Id;
+      Atyp  : Entity_Id;
+      PAT   : Entity_Id;
+      Ctyp  : Entity_Id;
+      Csiz  : Int;
+      Cmask : Uint;
 
       Shift : Node_Id;
       --  The expression for the shift value that is required
@@ -1433,9 +1433,9 @@ package body Exp_Pakd is
             Rhs_Val       := Expr_Rep_Value (Rhs);
             Rhs_Val_Known := True;
 
-         --  The following test catches the case of an unchecked conversion
-         --  of an integer literal. This results from optimizing aggregates
-         --  of packed types.
+         --  The following test catches the case of an unchecked conversion of
+         --  an integer literal. This results from optimizing aggregates of
+         --  packed types.
 
          elsif Nkind (Rhs) = N_Unchecked_Type_Conversion
            and then Compile_Time_Known_Value (Expression (Rhs))
@@ -2619,11 +2619,16 @@ package body Exp_Pakd is
       Cmask  : out Uint;
       Shift  : out Node_Id)
    is
-      Loc    : constant Source_Ptr := Sloc (N);
-      PAT    : Entity_Id;
-      Otyp   : Entity_Id;
-      Csiz   : Uint;
-      Osiz   : Uint;
+      Loc  : constant Source_Ptr := Sloc (N);
+      PAT  : Entity_Id;
+      Otyp : Entity_Id;
+      Pref : Node_Id;
+      Csiz : Uint;
+      Osiz : Uint;
+
+      In_Reverse_Storage_Order_Record : Boolean;
+      --  Set True if Obj is a [sub]component of a record that has reversed
+      --  scalar storage order.
 
    begin
       Csiz := Component_Size (Atyp);
@@ -2658,7 +2663,7 @@ package body Exp_Pakd is
       if Csiz /= 1 then
          Shift :=
            Make_Op_Multiply (Loc,
-             Left_Opnd => Make_Integer_Literal (Loc, Csiz),
+             Left_Opnd  => Make_Integer_Literal (Loc, Csiz),
              Right_Opnd => Shift);
       end if;
 
@@ -2693,7 +2698,7 @@ package body Exp_Pakd is
                 Prefix => Obj,
                 Expressions => New_List (
                   Make_Op_Divide (Loc,
-                    Left_Opnd => Duplicate_Subexpr (Shift),
+                    Left_Opnd  => Duplicate_Subexpr (Shift),
                     Right_Opnd => Make_Integer_Literal (Loc, Osiz))));
 
             Shift := New_Shift;
@@ -2725,7 +2730,30 @@ package body Exp_Pakd is
       --  the array used to implement the packed array, F is the number of bits
       --  in a source array element, and Shift is the count so far computed.
 
-      if Bytes_Big_Endian then
+      --  We also have to adjust if the storage order is reversed
+
+      Pref := Obj;
+      loop
+         case Nkind (Pref) is
+            when N_Selected_Component =>
+               Pref := Prefix (Pref);
+               exit;
+
+            when N_Indexed_Component =>
+               Pref := Prefix (Pref);
+
+            when others =>
+               Pref := Empty;
+               exit;
+         end case;
+      end loop;
+
+      In_Reverse_Storage_Order_Record :=
+        Present (Pref)
+          and then Is_Record_Type (Etype (Pref))
+          and then Reverse_Storage_Order (Etype (Pref));
+
+      if Bytes_Big_Endian xor In_Reverse_Storage_Order_Record then
          Shift :=
            Make_Op_Subtract (Loc,
              Left_Opnd  => Make_Integer_Literal (Loc, Osiz - Csiz),

gcc/ada/freeze.adb

@@ -2138,15 +2138,13 @@ package body Freeze is
          if Present (ADC)
            and then Reverse_Bit_Order (Rec) /= Reverse_Storage_Order (Rec)
          then
-            if Bytes_Big_Endian = not Reverse_Storage_Order (Rec) then
-               Error_Msg_N
-                 ("Scalar_Storage_Order High_Order_First is inconsistent with"
-                  & " Bit_Order", ADC);
-            else
-               Error_Msg_N
-                 ("Scalar_Storage_Order Low_Order_First is inconsistent with"
-                  & " Bit_Order", ADC);
-            end if;
+            --  Note: report error on Rec, not on ADC, as ADC may apply to
+            --  an ancestor type.
+
+            Error_Msg_Sloc := Sloc (ADC);
+            Error_Msg_N
+              ("scalar storage order for& specified# inconsistent with "
+               & "its bit order", Rec);
          end if;
 
          --  Deal with Bit_Order aspect specifying a non-default bit order

gcc/ada/sem_util.adb

@@ -1236,9 +1236,7 @@ package body Sem_Util is
       --  Loop through sequence of basic declarative items
 
       Outer : while Present (Decl) loop
-         if Nkind (Decl) /= N_Subprogram_Body
-           and then Nkind (Decl) /= N_Package_Body
-           and then Nkind (Decl) /= N_Task_Body
+         if not Nkind_In (Decl, N_Subprogram_Body, N_Package_Body, N_Task_Body)
            and then Nkind (Decl) not in N_Body_Stub
          then
             Next (Decl);
@@ -3577,15 +3575,15 @@ package body Sem_Util is
             Enclosing_Subp : constant Node_Id := Enclosing_Subprogram (Def_Id);
             Enclosing_Pack : constant Node_Id := Enclosing_Package (Def_Id);
             Other_Scope    : constant Node_Id := Enclosing_Dynamic_Scope (C);
-         begin
 
+         begin
             --  ... unless the new declaration is in a subprogram, and the
             --  visible declaration is a variable declaration or a parameter
             --  specification outside that subprogram.
 
             if Present (Enclosing_Subp)
               and then Nkind_In (Parent (C), N_Object_Declaration,
-                                 N_Parameter_Specification)
+                                             N_Parameter_Specification)
               and then not Scope_Within_Or_Same (Other_Scope, Enclosing_Subp)
             then
                null;
@@ -7595,13 +7593,13 @@ package body Sem_Util is
       --------------------------------------
 
       function Is_Internally_Generated_Renaming (N : Node_Id) return Boolean is
-         P : Node_Id := N;
+         P : Node_Id;
 
       begin
+         P := N;
          while Present (P) loop
             if Nkind (P) = N_Object_Renaming_Declaration then
                return not Comes_From_Source (P);
-
             elsif Is_List_Member (P) then
                return False;
             end if;
@@ -11659,9 +11657,11 @@ package body Sem_Util is
    ------------------------
 
    function Proper_First_Index (Array_Typ : Entity_Id) return Entity_Id is
-      Typ : Entity_Id := Array_Typ;
+      Typ : Entity_Id;
 
    begin
+      Typ := Array_Typ;
+
       if Ekind (Typ) = E_String_Literal_Subtype then
          Typ := Base_Type (Typ);
       end if;