Commit 6232acb7 by Thomas Quinot Committed by Eric Botcazou

freeze.adb (Check_Component_Storage_Order): Also get full view of enclosing type.

	* freeze.adb (Check_Component_Storage_Order): Also get full view of
	enclosing type.

From-SVN: r236277
parent 8fad45f5
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> 2016-05-16 Eric Botcazou <ebotcazou@adacore.com>
* exp_util.adb (Remove_Side_Effects): Also make a constant if we need * exp_util.adb (Remove_Side_Effects): Also make a constant if we need
......
...@@ -1161,7 +1161,8 @@ package body Freeze is ...@@ -1161,7 +1161,8 @@ package body Freeze is
ADC : Node_Id; ADC : Node_Id;
Comp_ADC_Present : out Boolean) Comp_ADC_Present : out Boolean)
is is
Comp_Type : Entity_Id; Encl_Base : Entity_Id;
Comp_Base : Entity_Id;
Comp_ADC : Node_Id; Comp_ADC : Node_Id;
Err_Node : Node_Id; Err_Node : Node_Id;
...@@ -1180,7 +1181,7 @@ package body Freeze is ...@@ -1180,7 +1181,7 @@ package body Freeze is
if Present (Comp) then if Present (Comp) then
Err_Node := Comp; Err_Node := Comp;
Comp_Type := Etype (Comp); Comp_Base := Etype (Comp);
if Is_Tag (Comp) then if Is_Tag (Comp) then
Comp_Byte_Aligned := True; Comp_Byte_Aligned := True;
...@@ -1205,24 +1206,28 @@ package body Freeze is ...@@ -1205,24 +1206,28 @@ package body Freeze is
else else
Err_Node := Encl_Type; Err_Node := Encl_Type;
Comp_Type := Component_Type (Encl_Type); Comp_Base := Component_Type (Encl_Type);
Component_Aliased := Has_Aliased_Components (Encl_Type); Component_Aliased := Has_Aliased_Components (Encl_Type);
end if; end if;
-- Note: the Reverse_Storage_Order flag is set on the base type, but -- Note: the Reverse_Storage_Order flag is set on the base type, but
-- the attribute definition clause is attached to the first subtype. -- 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); Encl_Base := Base_Type (Encl_Type);
if Present (Underlying_Type (Encl_Base)) then
-- If the base type is incomplete or private, go to full view if known Encl_Base := Underlying_Type (Encl_Base);
end if;
if Present (Underlying_Type (Comp_Type)) then Comp_Base := Base_Type (Comp_Base);
Comp_Type := Underlying_Type (Comp_Type); if Present (Underlying_Type (Comp_Base)) then
Comp_Base := Underlying_Type (Comp_Base);
end if; end if;
Comp_ADC := Get_Attribute_Definition_Clause Comp_ADC := Get_Attribute_Definition_Clause
(First_Subtype (Comp_Type), (First_Subtype (Comp_Base),
Attribute_Scalar_Storage_Order); Attribute_Scalar_Storage_Order);
Comp_ADC_Present := Present (Comp_ADC); Comp_ADC_Present := Present (Comp_ADC);
...@@ -1230,14 +1235,14 @@ package body Freeze is ...@@ -1230,14 +1235,14 @@ package body Freeze is
-- But, if the record has Complex_Representation, then it is treated as -- But, if the record has Complex_Representation, then it is treated as
-- a scalar in the back end so the storage order is irrelevant. -- a scalar in the back end so the storage order is irrelevant.
if (Is_Record_Type (Comp_Type) if (Is_Record_Type (Comp_Base)
and then not Has_Complex_Representation (Comp_Type)) and then not Has_Complex_Representation (Comp_Base))
or else Is_Array_Type (Comp_Type) or else Is_Array_Type (Comp_Base)
then then
Comp_SSO_Differs := 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 -- Parent and extension must have same storage order
...@@ -1258,7 +1263,7 @@ package body Freeze is ...@@ -1258,7 +1263,7 @@ package body Freeze is
-- Reject if component is a packed array, as it may be represented -- Reject if component is a packed array, as it may be represented
-- as a scalar internally. -- as a scalar internally.
if Is_Packed_Array (Comp_Type) then if Is_Packed_Array (Comp_Base) then
Error_Msg_N Error_Msg_N
("type of packed component must have same scalar storage " ("type of packed component must have same scalar storage "
& "order as enclosing composite", Err_Node); & "order as enclosing composite", Err_Node);
...@@ -1266,14 +1271,14 @@ package body Freeze is ...@@ -1266,14 +1271,14 @@ package body Freeze is
-- Reject if composite is a packed array, as it may be rewritten -- Reject if composite is a packed array, as it may be rewritten
-- into an array of scalars. -- into an array of scalars.
elsif Is_Packed_Array (Encl_Type) then elsif Is_Packed_Array (Encl_Base) then
Error_Msg_N Error_Msg_N
("type of packed array must have same scalar storage order " ("type of packed array must have same scalar storage order "
& "as component", Err_Node); & "as component", Err_Node);
-- Reject if not byte aligned -- Reject if not byte aligned
elsif Is_Record_Type (Encl_Type) elsif Is_Record_Type (Encl_Base)
and then not Comp_Byte_Aligned and then not Comp_Byte_Aligned
then then
Error_Msg_N Error_Msg_N
...@@ -1285,7 +1290,7 @@ package body Freeze is ...@@ -1285,7 +1290,7 @@ package body Freeze is
elsif Present (ADC) and then No (Comp_ADC) then elsif Present (ADC) and then No (Comp_ADC) then
Error_Msg_NE Error_Msg_NE
("scalar storage order specified for & does not apply to " ("scalar storage order specified for & does not apply to "
& "component?", Err_Node, Encl_Type); & "component?", Err_Node, Encl_Base);
end if; end if;
end if; end if;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment