Commit 29e100b3 by Eric Botcazou

decl.c (components_need_strict_alignment): New.

	* gcc-interface/decl.c (components_need_strict_alignment): New.
	(components_to_record): Do not pack the variants if one of the fields
	needs strict alignment.  Likewise for the variant part as a whole.
	Specify the position of the variants even if the size isn't specified,
	but do not specify the size of the variant part in this case.

From-SVN: r193750
parent 1076781c
2012-11-23 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/decl.c (components_need_strict_alignment): New.
(components_to_record): Do not pack the variants if one of the fields
needs strict alignment. Likewise for the variant part as a whole.
Specify the position of the variants even if the size isn't specified,
but do not specify the size of the variant part in this case.
2012-11-20 Diego Novillo <dnovillo@google.com> 2012-11-20 Diego Novillo <dnovillo@google.com>
Jakub Jelinek <jakub@redhat.com> Jakub Jelinek <jakub@redhat.com>
* gcc-interface/decl.c: Replace all vec<T,A>() * gcc-interface/decl.c: Replace all vec<T,A>() initializers with vNULL.
initializers with vNULL.
2012-11-18 Eric Botcazou <ebotcazou@adacore.com> 2012-11-18 Eric Botcazou <ebotcazou@adacore.com>
......
...@@ -6650,6 +6650,30 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed, ...@@ -6650,6 +6650,30 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed,
return gnu_field; return gnu_field;
} }
/* Return true if at least one member of COMPONENT_LIST needs strict
alignment. */
static bool
components_need_strict_alignment (Node_Id component_list)
{
Node_Id component_decl;
for (component_decl = First_Non_Pragma (Component_Items (component_list));
Present (component_decl);
component_decl = Next_Non_Pragma (component_decl))
{
Entity_Id gnat_field = Defining_Entity (component_decl);
if (Is_Aliased (gnat_field))
return True;
if (Strict_Alignment (Etype (gnat_field)))
return True;
}
return False;
}
/* Return true if TYPE is a type with variable size or a padding type with a /* Return true if TYPE is a type with variable size or a padding type with a
field of variable size or a record that has a field with such a type. */ field of variable size or a record that has a field with such a type. */
...@@ -6880,6 +6904,7 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list, ...@@ -6880,6 +6904,7 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list,
"XVN"); "XVN");
tree gnu_union_type, gnu_union_name; tree gnu_union_type, gnu_union_name;
tree this_first_free_pos, gnu_variant_list = NULL_TREE; tree this_first_free_pos, gnu_variant_list = NULL_TREE;
bool union_field_needs_strict_alignment = false;
if (TREE_CODE (gnu_name) == TYPE_DECL) if (TREE_CODE (gnu_name) == TYPE_DECL)
gnu_name = DECL_NAME (gnu_name); gnu_name = DECL_NAME (gnu_name);
...@@ -6980,8 +7005,18 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list, ...@@ -6980,8 +7005,18 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list,
else else
{ {
/* Deal with packedness like in gnat_to_gnu_field. */ /* Deal with packedness like in gnat_to_gnu_field. */
int field_packed bool field_needs_strict_alignment
= adjust_packed (gnu_variant_type, gnu_record_type, packed); = components_need_strict_alignment (Component_List (variant));
int field_packed;
if (field_needs_strict_alignment)
{
field_packed = 0;
union_field_needs_strict_alignment = true;
}
else
field_packed
= adjust_packed (gnu_variant_type, gnu_record_type, packed);
/* Finalize the record type now. We used to throw away /* Finalize the record type now. We used to throw away
empty records but we no longer do that because we need empty records but we no longer do that because we need
...@@ -6997,8 +7032,7 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list, ...@@ -6997,8 +7032,7 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list,
gnu_union_type, gnu_union_type,
all_rep_and_size all_rep_and_size
? TYPE_SIZE (gnu_variant_type) : 0, ? TYPE_SIZE (gnu_variant_type) : 0,
all_rep_and_size all_rep ? bitsize_zero_node : 0,
? bitsize_zero_node : 0,
field_packed, 0); field_packed, 0);
DECL_INTERNAL_P (gnu_field) = 1; DECL_INTERNAL_P (gnu_field) = 1;
...@@ -7041,12 +7075,16 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list, ...@@ -7041,12 +7075,16 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list,
NULL, true, debug_info, gnat_component_list); NULL, true, debug_info, gnat_component_list);
/* Deal with packedness like in gnat_to_gnu_field. */ /* Deal with packedness like in gnat_to_gnu_field. */
union_field_packed if (union_field_needs_strict_alignment)
= adjust_packed (gnu_union_type, gnu_record_type, packed); union_field_packed = 0;
else
union_field_packed
= adjust_packed (gnu_union_type, gnu_record_type, packed);
gnu_variant_part gnu_variant_part
= create_field_decl (gnu_var_name, gnu_union_type, gnu_record_type, = create_field_decl (gnu_var_name, gnu_union_type, gnu_record_type,
all_rep ? TYPE_SIZE (gnu_union_type) : 0, all_rep_and_size
? TYPE_SIZE (gnu_union_type) : 0,
all_rep || this_first_free_pos all_rep || this_first_free_pos
? bitsize_zero_node : 0, ? bitsize_zero_node : 0,
union_field_packed, 0); union_field_packed, 0);
......
2012-11-23 Eric Botcazou <ebotcazou@adacore.com>
* gnat.dg/discr39.adb: New test.
2012-11-23 Georg-Johann Lay <avr@gjlay.de> 2012-11-23 Georg-Johann Lay <avr@gjlay.de>
PR testsuite/52641 PR testsuite/52641
......
-- { dg-do run }
with System.Storage_Elements; use System.Storage_Elements;
procedure Discr39 is
type Rec (Has_Src : Boolean) is record
case Has_Src is
when True => Src : aliased Integer;
when False => null;
end case;
end record;
pragma Pack(Rec);
for Rec'Alignment use Integer'Alignment;
R : Rec (Has_Src => True);
begin
if R.Src'Address mod Integer'Alignment /= 0 then
raise Program_Error;
end if;
end;
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