Commit 839f2864 by Eric Botcazou Committed by Eric Botcazou

decl.c (gnat_to_gnu_field): Add DEBUG_INFO_P parameter.

	* gcc-interface/decl.c (gnat_to_gnu_field): Add DEBUG_INFO_P parameter.
	If a padding type was made for the field, declare it.
	(components_to_record): Add DEBUG_INFO_P parameter.  Adjust call
	to gnat_to_gnu_field and call to self.
	(gnat_to_gnu_entity) <E_Array_Type>: Do not redeclare padding types.
	<E_Array_Subtype>: Likewise.
	Adjust calls to gnat_to_gnu_field and components_to_record.

From-SVN: r151755
parent 54384f7f
2009-09-16 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/decl.c (gnat_to_gnu_field): Add DEBUG_INFO_P parameter.
If a padding type was made for the field, declare it.
(components_to_record): Add DEBUG_INFO_P parameter. Adjust call
to gnat_to_gnu_field and call to self.
(gnat_to_gnu_entity) <E_Array_Type>: Do not redeclare padding types.
<E_Array_Subtype>: Likewise.
Adjust calls to gnat_to_gnu_field and components_to_record.
2009-09-16 Robert Dewar <dewar@adacore.com> 2009-09-16 Robert Dewar <dewar@adacore.com>
* prj-nmsc.adb: Minor reformatting * prj-nmsc.adb: Minor reformatting
......
...@@ -131,7 +131,7 @@ static tree elaborate_expression (Node_Id, Entity_Id, tree, bool, bool, bool); ...@@ -131,7 +131,7 @@ static tree elaborate_expression (Node_Id, Entity_Id, tree, bool, bool, bool);
static bool is_variable_size (tree); static bool is_variable_size (tree);
static tree elaborate_expression_1 (tree, Entity_Id, tree, bool, bool); static tree elaborate_expression_1 (tree, Entity_Id, tree, bool, bool);
static tree make_packable_type (tree, bool); static tree make_packable_type (tree, bool);
static tree gnat_to_gnu_field (Entity_Id, tree, int, bool); static tree gnat_to_gnu_field (Entity_Id, tree, int, bool, bool);
static tree gnat_to_gnu_param (Entity_Id, Mechanism_Type, Entity_Id, bool, static tree gnat_to_gnu_param (Entity_Id, Mechanism_Type, Entity_Id, bool,
bool *); bool *);
static bool same_discriminant_p (Entity_Id, Entity_Id); static bool same_discriminant_p (Entity_Id, Entity_Id);
...@@ -139,7 +139,7 @@ static bool array_type_has_nonaliased_component (Entity_Id, tree); ...@@ -139,7 +139,7 @@ static bool array_type_has_nonaliased_component (Entity_Id, tree);
static bool compile_time_known_address_p (Node_Id); static bool compile_time_known_address_p (Node_Id);
static bool cannot_be_superflat_p (Node_Id); static bool cannot_be_superflat_p (Node_Id);
static void components_to_record (tree, Node_Id, tree, int, bool, tree *, static void components_to_record (tree, Node_Id, tree, int, bool, tree *,
bool, bool, bool, bool); bool, bool, bool, bool, bool);
static Uint annotate_value (tree); static Uint annotate_value (tree);
static void annotate_rep (Entity_Id, tree); static void annotate_rep (Entity_Id, tree);
static tree compute_field_positions (tree, tree, tree, tree, unsigned int); static tree compute_field_positions (tree, tree, tree, tree, unsigned int);
...@@ -1990,7 +1990,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -1990,7 +1990,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
/* If a padding record was made, declare it now since it will /* If a padding record was made, declare it now since it will
never be declared otherwise. This is necessary to ensure never be declared otherwise. This is necessary to ensure
that its subtrees are properly marked. */ that its subtrees are properly marked. */
if (tem != orig_tem) if (tem != orig_tem && !DECL_P (TYPE_NAME (tem)))
create_type_decl (TYPE_NAME (tem), tem, NULL, true, create_type_decl (TYPE_NAME (tem), tem, NULL, true,
debug_info_p, gnat_entity); debug_info_p, gnat_entity);
} }
...@@ -2364,7 +2364,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -2364,7 +2364,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
if (gnu_comp_size && !Is_Bit_Packed_Array (gnat_entity)) if (gnu_comp_size && !Is_Bit_Packed_Array (gnat_entity))
{ {
tree orig_gnu_type = gnu_type; tree orig_type = gnu_type;
unsigned int max_align; unsigned int max_align;
/* If an alignment is specified, use it as a cap on the /* If an alignment is specified, use it as a cap on the
...@@ -2381,9 +2381,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -2381,9 +2381,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
gnu_type gnu_type
= make_type_from_size (gnu_type, gnu_comp_size, false); = make_type_from_size (gnu_type, gnu_comp_size, false);
if (max_align > 0 && TYPE_ALIGN (gnu_type) > max_align) if (max_align > 0 && TYPE_ALIGN (gnu_type) > max_align)
gnu_type = orig_gnu_type; gnu_type = orig_type;
else else
orig_gnu_type = gnu_type; orig_type = gnu_type;
gnu_type = maybe_pad_type (gnu_type, gnu_comp_size, 0, gnu_type = maybe_pad_type (gnu_type, gnu_comp_size, 0,
gnat_entity, "C_PAD", false, gnat_entity, "C_PAD", false,
...@@ -2392,7 +2392,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -2392,7 +2392,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
/* If a padding record was made, declare it now since it /* If a padding record was made, declare it now since it
will never be declared otherwise. This is necessary will never be declared otherwise. This is necessary
to ensure that its subtrees are properly marked. */ to ensure that its subtrees are properly marked. */
if (gnu_type != orig_gnu_type) if (gnu_type != orig_type && !DECL_P (TYPE_NAME (gnu_type)))
create_type_decl (TYPE_NAME (gnu_type), gnu_type, NULL, create_type_decl (TYPE_NAME (gnu_type), gnu_type, NULL,
true, debug_info_p, gnat_entity); true, debug_info_p, gnat_entity);
} }
...@@ -2952,7 +2952,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -2952,7 +2952,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
continue; continue;
gnu_field gnu_field
= gnat_to_gnu_field (gnat_field, gnu_type, packed, definition); = gnat_to_gnu_field (gnat_field, gnu_type, packed, definition,
debug_info_p);
/* Make an expression using a PLACEHOLDER_EXPR from the /* Make an expression using a PLACEHOLDER_EXPR from the
FIELD_DECL node just created and link that with the FIELD_DECL node just created and link that with the
...@@ -2973,7 +2974,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -2973,7 +2974,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
/* Add the fields into the record type and finish it up. */ /* Add the fields into the record type and finish it up. */
components_to_record (gnu_type, Component_List (record_definition), components_to_record (gnu_type, Component_List (record_definition),
gnu_field_list, packed, definition, NULL, gnu_field_list, packed, definition, NULL,
false, all_rep, false, is_unchecked_union); false, all_rep, false, is_unchecked_union,
debug_info_p);
/* If it is a tagged record force the type to BLKmode to insure that /* If it is a tagged record force the type to BLKmode to insure that
these objects will always be put in memory. Likewise for limited these objects will always be put in memory. Likewise for limited
...@@ -6412,11 +6414,14 @@ adjust_packed (tree field_type, tree record_type, int packed) ...@@ -6412,11 +6414,14 @@ adjust_packed (tree field_type, tree record_type, int packed)
record has Component_Alignment of Storage_Unit, -2 if the enclosing record has Component_Alignment of Storage_Unit, -2 if the enclosing
record has a specified alignment. record has a specified alignment.
DEFINITION is true if this field is for a record being defined. */ DEFINITION is true if this field is for a record being defined.
DEBUG_INFO_P is true if we need to write debug information for types
that we may create in the process. */
static tree static tree
gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed, gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed,
bool definition) bool definition, bool debug_info_p)
{ {
tree gnu_field_id = get_entity_name (gnat_field); tree gnu_field_id = get_entity_name (gnat_field);
tree gnu_field_type = gnat_to_gnu_type (Etype (gnat_field)); tree gnu_field_type = gnat_to_gnu_type (Etype (gnat_field));
...@@ -6635,6 +6640,8 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed, ...@@ -6635,6 +6640,8 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed,
/* If a size is specified, adjust the field's type to it. */ /* If a size is specified, adjust the field's type to it. */
if (gnu_size) if (gnu_size)
{ {
tree orig_field_type;
/* If the field's type is justified modular, we would need to remove /* If the field's type is justified modular, we would need to remove
the wrapper to (better) meet the layout requirements. However we the wrapper to (better) meet the layout requirements. However we
can do so only if the field is not aliased to preserve the unique can do so only if the field is not aliased to preserve the unique
...@@ -6650,8 +6657,18 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed, ...@@ -6650,8 +6657,18 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed,
gnu_field_type gnu_field_type
= make_type_from_size (gnu_field_type, gnu_size, = make_type_from_size (gnu_field_type, gnu_size,
Has_Biased_Representation (gnat_field)); Has_Biased_Representation (gnat_field));
orig_field_type = gnu_field_type;
gnu_field_type = maybe_pad_type (gnu_field_type, gnu_size, 0, gnat_field, gnu_field_type = maybe_pad_type (gnu_field_type, gnu_size, 0, gnat_field,
"PAD", false, definition, true); "PAD", false, definition, true);
/* If a padding record was made, declare it now since it will never be
declared otherwise. This is necessary to ensure that its subtrees
are properly marked. */
if (gnu_field_type != orig_field_type
&& !DECL_P (TYPE_NAME (gnu_field_type)))
create_type_decl (TYPE_NAME (gnu_field_type), gnu_field_type, NULL,
true, debug_info_p, gnat_field);
} }
/* Otherwise (or if there was an error), don't specify a position. */ /* Otherwise (or if there was an error), don't specify a position. */
...@@ -6746,13 +6763,17 @@ compare_field_bitpos (const PTR rt1, const PTR rt2) ...@@ -6746,13 +6763,17 @@ compare_field_bitpos (const PTR rt1, const PTR rt2)
modified afterwards so it will not be finalized here. modified afterwards so it will not be finalized here.
UNCHECKED_UNION, if true, means that we are building a type for a record UNCHECKED_UNION, if true, means that we are building a type for a record
with a Pragma Unchecked_Union. */ with a Pragma Unchecked_Union.
DEBUG_INFO_P, if true, means that we need to write debug information for
types that we may create in the process. */
static void static void
components_to_record (tree gnu_record_type, Node_Id gnat_component_list, components_to_record (tree gnu_record_type, Node_Id gnat_component_list,
tree gnu_field_list, int packed, bool definition, tree gnu_field_list, int packed, bool definition,
tree *p_gnu_rep_list, bool cancel_alignment, tree *p_gnu_rep_list, bool cancel_alignment,
bool all_rep, bool do_not_finalize, bool unchecked_union) bool all_rep, bool do_not_finalize,
bool unchecked_union, bool debug_info_p)
{ {
bool all_rep_and_size = all_rep && TYPE_SIZE (gnu_record_type); bool all_rep_and_size = all_rep && TYPE_SIZE (gnu_record_type);
bool layout_with_rep = false; bool layout_with_rep = false;
...@@ -6780,8 +6801,8 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list, ...@@ -6780,8 +6801,8 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list,
} }
else else
{ {
gnu_field = gnat_to_gnu_field (gnat_field, gnu_record_type, gnu_field = gnat_to_gnu_field (gnat_field, gnu_record_type, packed,
packed, definition); definition, debug_info_p);
/* If this is the _Tag field, put it before any other fields. */ /* If this is the _Tag field, put it before any other fields. */
if (gnat_name == Name_uTag) if (gnat_name == Name_uTag)
...@@ -6887,7 +6908,7 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list, ...@@ -6887,7 +6908,7 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list,
components_to_record (gnu_variant_type, Component_List (variant), components_to_record (gnu_variant_type, Component_List (variant),
NULL_TREE, packed, definition, NULL_TREE, packed, definition,
&gnu_our_rep_list, !all_rep_and_size, all_rep, &gnu_our_rep_list, !all_rep_and_size, all_rep,
true, unchecked_union); true, unchecked_union, debug_info_p);
gnu_qual = choices_to_gnu (gnu_discr, Discrete_Choices (variant)); gnu_qual = choices_to_gnu (gnu_discr, Discrete_Choices (variant));
......
2009-09-16 Eric Botcazou <ebotcazou@adacore.com>
* gnat.dg/discr20.ad[sb]: New test.
2009-09-16 Richard Guenther <rguenther@suse.de> 2009-09-16 Richard Guenther <rguenther@suse.de>
PR middle-end/34011 PR middle-end/34011
......
-- { dg-do compile }
package body Discr20 is
function Get (X : Wrapper) return Def is
begin
return X.It;
end Get;
end Discr20;
package Discr20 is
Size : Integer;
type Name is new String (1..Size);
type Rec is record
It : Name;
end record;
type Danger is (This, That);
type def (X : Danger := This) is record
case X is
when This => It : Rec;
when That => null;
end case;
end record;
type Switch is (On, Off);
type Wrapper (Disc : Switch := On) is private;
function Get (X : Wrapper) return Def;
private
type Wrapper (Disc : Switch := On) is record
Case Disc is
when On => It : Def;
when Off => null;
end case;
end record;
end Discr20;
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