diff options
author | ebotcazou <ebotcazou@138bc75d-0d04-0410-961f-82ee72b054a4> | 2016-05-16 10:58:20 +0000 |
---|---|---|
committer | ebotcazou <ebotcazou@138bc75d-0d04-0410-961f-82ee72b054a4> | 2016-05-16 10:58:20 +0000 |
commit | 59f08ba6e23a827e9d07c7a14ec44492d650673e (patch) | |
tree | d89fdc4122610b2e7c5cc22b4506e40b694275d6 /gcc | |
parent | 624115b443e0adf7516bb948faaf3da0520a7f60 (diff) | |
download | gcc-59f08ba6e23a827e9d07c7a14ec44492d650673e.tar.gz |
* freeze.adb (Check_Component_Storage_Order): Also get full view of
enclosing type.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@236277 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc')
-rw-r--r-- | gcc/ada/ChangeLog | 5 | ||||
-rw-r--r-- | gcc/ada/freeze.adb | 41 |
2 files changed, 28 insertions, 18 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index fc8fe944bf6..b8b14d2a63c 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -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 diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index d7d9b360450..c040f07bafe 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -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; |