freeze.adb (Check_Component_Storage_Order): Also get full view of enclosing type.
authorThomas Quinot <quinot@adacore.com>
Mon, 16 May 2016 10:58:20 +0000 (10:58 +0000)
committerEric Botcazou <ebotcazou@gcc.gnu.org>
Mon, 16 May 2016 10:58:20 +0000 (10:58 +0000)
* freeze.adb (Check_Component_Storage_Order): Also get full view of
enclosing type.

From-SVN: r236277

gcc/ada/ChangeLog
gcc/ada/freeze.adb

index fc8fe944bf6526dbef4525771bb8ece74d7d8e1a..b8b14d2a63c96020095dc11e316016995556306e 100644 (file)
@@ -1,3 +1,8 @@
+2016-05-16  Thomas Quinot  <quinot@adacore.com>
+
+       * freeze.adb (Check_Component_Storage_Order): Also get full view of
+       enclosing type.
+
 2016-05-16  Eric Botcazou  <ebotcazou@adacore.com>
 
        * exp_util.adb (Remove_Side_Effects): Also make a constant if we need
index d7d9b36045085809aed9385b1f3942012ee54669..c040f07bafe66b7ca40652fa93286ef8e20be42f 100644 (file)
@@ -1161,7 +1161,8 @@ package body Freeze is
       ADC              : Node_Id;
       Comp_ADC_Present : out Boolean)
    is
-      Comp_Type : Entity_Id;
+      Encl_Base : Entity_Id;
+      Comp_Base : Entity_Id;
       Comp_ADC  : Node_Id;
       Err_Node  : Node_Id;
 
@@ -1180,7 +1181,7 @@ package body Freeze is
 
       if Present (Comp) then
          Err_Node  := Comp;
-         Comp_Type := Etype (Comp);
+         Comp_Base := Etype (Comp);
 
          if Is_Tag (Comp) then
             Comp_Byte_Aligned := True;
@@ -1205,24 +1206,28 @@ package body Freeze is
 
       else
          Err_Node  := Encl_Type;
-         Comp_Type := Component_Type (Encl_Type);
+         Comp_Base := Component_Type (Encl_Type);
 
          Component_Aliased := Has_Aliased_Components (Encl_Type);
       end if;
 
       --  Note: the Reverse_Storage_Order flag is set on the base type, but
       --  the attribute definition clause is attached to the first subtype.
+      --  Also, if the base type is incomplete or private, go to full view
+      --  if known
 
-      Comp_Type := Base_Type (Comp_Type);
-
-      --  If the base type is incomplete or private, go to full view if known
+      Encl_Base := Base_Type (Encl_Type);
+      if Present (Underlying_Type (Encl_Base)) then
+         Encl_Base := Underlying_Type (Encl_Base);
+      end if;
 
-      if Present (Underlying_Type (Comp_Type)) then
-         Comp_Type := Underlying_Type (Comp_Type);
+      Comp_Base := Base_Type (Comp_Base);
+      if Present (Underlying_Type (Comp_Base)) then
+         Comp_Base := Underlying_Type (Comp_Base);
       end if;
 
       Comp_ADC := Get_Attribute_Definition_Clause
-                    (First_Subtype (Comp_Type),
+                    (First_Subtype (Comp_Base),
                      Attribute_Scalar_Storage_Order);
       Comp_ADC_Present := Present (Comp_ADC);
 
@@ -1230,14 +1235,14 @@ package body Freeze is
       --  But, if the record has Complex_Representation, then it is treated as
       --  a scalar in the back end so the storage order is irrelevant.
 
-      if (Is_Record_Type (Comp_Type)
-            and then not Has_Complex_Representation (Comp_Type))
-        or else Is_Array_Type (Comp_Type)
+      if (Is_Record_Type (Comp_Base)
+            and then not Has_Complex_Representation (Comp_Base))
+        or else Is_Array_Type (Comp_Base)
       then
          Comp_SSO_Differs :=
-           Reverse_Storage_Order (Encl_Type)
+           Reverse_Storage_Order (Encl_Base)
              /=
-           Reverse_Storage_Order (Comp_Type);
+           Reverse_Storage_Order (Comp_Base);
 
          --  Parent and extension must have same storage order
 
@@ -1258,7 +1263,7 @@ package body Freeze is
             --  Reject if component is a packed array, as it may be represented
             --  as a scalar internally.
 
-            if Is_Packed_Array (Comp_Type) then
+            if Is_Packed_Array (Comp_Base) then
                Error_Msg_N
                  ("type of packed component must have same scalar storage "
                   & "order as enclosing composite", Err_Node);
@@ -1266,14 +1271,14 @@ package body Freeze is
             --  Reject if composite is a packed array, as it may be rewritten
             --  into an array of scalars.
 
-            elsif Is_Packed_Array (Encl_Type) then
+            elsif Is_Packed_Array (Encl_Base) then
                Error_Msg_N
                  ("type of packed array must have same scalar storage order "
                   & "as component", Err_Node);
 
             --  Reject if not byte aligned
 
-            elsif Is_Record_Type (Encl_Type)
+            elsif Is_Record_Type (Encl_Base)
               and then not Comp_Byte_Aligned
             then
                Error_Msg_N
@@ -1285,7 +1290,7 @@ package body Freeze is
             elsif Present (ADC) and then No (Comp_ADC) then
                Error_Msg_NE
                  ("scalar storage order specified for & does not apply to "
-                  & "component?", Err_Node, Encl_Type);
+                  & "component?", Err_Node, Encl_Base);
             end if;
          end if;