[Ada] Propagate bit order and SSO from root to classwide equivalent type

2018-09-26  Thomas Quinot  <quinot@adacore.com>

gcc/ada/

	* exp_util.adb (Make_CW_Equivalent_Type): Propagate bit order
	and scalar storage order from root type to classwide equivalent
	type, to prevent rejection of the equivalent type by the
	freezing circuitry.

gcc/testsuite/

	* gnat.dg/sso12.adb: New testcase.

From-SVN: r264613

gcc/ada/ChangeLog

+2018-09-26  Thomas Quinot  <quinot@adacore.com>
+
+	* exp_util.adb (Make_CW_Equivalent_Type): Propagate bit order
+	and scalar storage order from root type to classwide equivalent
+	type, to prevent rejection of the equivalent type by the
+	freezing circuitry.
+
 2018-09-26  Justin Squirek  <squirek@adacore.com>
 
 	* sem_ch5.adb (Analyze_Iterator_Specification): Add conditional

gcc/ada/exp_util.adb

@@ -9010,6 +9010,11 @@ package body Exp_Util is
    --
    --  ??? Note that this type does not guarantee same alignment as all
    --  derived types
+   --
+   --  Note: for the freezing circuitry, this looks like a record extension,
+   --  and so we need to make sure that the scalar storage order is the same
+   --  as that of the parent type. (This does not change anything for the
+   --  representation of the extension part.)
 
    function Make_CW_Equivalent_Type
      (T : Entity_Id;
@@ -9017,6 +9022,7 @@ package body Exp_Util is
    is
       Loc         : constant Source_Ptr := Sloc (E);
       Root_Typ    : constant Entity_Id  := Root_Type (T);
+      Root_Utyp   : constant Entity_Id  := Underlying_Type (Root_Typ);
       List_Def    : constant List_Id    := Empty_List;
       Comp_List   : constant List_Id    := New_List;
       Equiv_Type  : Entity_Id;
@@ -9147,6 +9153,11 @@ package body Exp_Util is
                Make_Component_Definition (Loc,
                  Aliased_Present    => False,
                  Subtype_Indication => New_Occurrence_Of (Constr_Root, Loc))));
+
+         Set_Reverse_Storage_Order (Equiv_Type,
+           Reverse_Storage_Order (Base_Type (Root_Utyp)));
+         Set_Reverse_Bit_Order (Equiv_Type,
+           Reverse_Bit_Order (Base_Type (Root_Utyp)));
       end if;
 
       Append_To (Comp_List,

gcc/testsuite/ChangeLog

+2018-09-26  Thomas Quinot  <quinot@adacore.com>
+
+	* gnat.dg/sso12.adb: New testcase.
+
 2018-09-26  Justin Squirek  <squirek@adacore.com>
 
 	* gnat.dg/expr_func8.adb: New testcase.

gcc/testsuite/gnat.dg/sso12.adb

+-- { dg-do compile }
+
+with Ada.Unchecked_Deallocation;
+with System;
+
+procedure SSO12 is
+   type Rec is abstract tagged null record;
+   for Rec'Scalar_Storage_Order use System.High_Order_First;  --  { dg-warning "scalar storage order specified but no component clause" }
+   for Rec'Bit_Order use System.High_Order_First;
+
+   type Rec_Acc is access all Rec'Class;
+
+   procedure Free is new Ada.Unchecked_Deallocation (Rec'Class, Rec_Acc);
+   X : Rec_Acc;
+begin
+   Free (X);
+end SSO12;