Tested on x86_64-suse-linux, applied on the mainline.
2017-05-15 Eric Botcazou <ebotca...@adacore.com>
* gcc-interface/trans.c (gnat_to_gnu) <N_Aggregate>: Fix formatting.
<N_Allocator>: Use properly typed constants.
(extract_values): Move around.
(pos_to_constructor): Minor tweaks.
(Sloc_to_locus): Fix formatting.
* gcc-interface/utils.c (process_deferred_decl_context): Minor tweaks.
* gcc-interface/gigi.h (MARK_VISITED): Remove blank line.
(Gigi_Equivalent_Type): Adjust head comment.
* gcc-interface/decl.c (Gigi_Equivalent_Type): Likewise.
--
Eric BotcazouIndex: gcc-interface/decl.c
===================================================================
--- gcc-interface/decl.c (revision 248049)
+++ gcc-interface/decl.c (working copy)
@@ -3270,12 +3270,12 @@ gnat_to_gnu_entity (Entity_Id gnat_entit
}
/* If we have a derived untagged type that renames discriminants in
- the root type, the (stored) discriminants are just a copy of the
- discriminants of the root type. This means that any constraints
- added by the renaming in the derivation are disregarded as far
- as the layout of the derived type is concerned. To rescue them,
- we change the type of the (stored) discriminants to a subtype
- with the bounds of the type of the visible discriminants. */
+ the parent type, the (stored) discriminants are just a copy of the
+ discriminants of the parent type. This means that any constraints
+ added by the renaming in the derivation are disregarded as far as
+ the layout of the derived type is concerned. To rescue them, we
+ change the type of the (stored) discriminants to a subtype with
+ the bounds of the type of the visible discriminants. */
if (has_discr
&& !is_extension
&& Stored_Constraint (gnat_entity) != No_Elist)
@@ -4967,12 +4967,10 @@ finalize_from_limited_with (void)
}
}
-/* Return the equivalent type to be used for GNAT_ENTITY, if it's a
- kind of type (such E_Task_Type) that has a different type which Gigi
- uses for its representation. If the type does not have a special type
- for its representation, return GNAT_ENTITY. If a type is supposed to
- exist, but does not, abort unless annotating types, in which case
- return Empty. If GNAT_ENTITY is Empty, return Empty. */
+/* Return the equivalent type to be used for GNAT_ENTITY, if it's a kind
+ of type (such E_Task_Type) that has a different type which Gigi uses
+ for its representation. If the type does not have a special type for
+ its representation, return GNAT_ENTITY. */
Entity_Id
Gigi_Equivalent_Type (Entity_Id gnat_entity)
Index: gcc-interface/gigi.h
===================================================================
--- gcc-interface/gigi.h (revision 247951)
+++ gcc-interface/gigi.h (working copy)
@@ -88,7 +88,6 @@ extern void mark_visited (tree t);
/* This macro calls the above function but short-circuits the common
case of a constant to save time and also checks for NULL. */
-
#define MARK_VISITED(EXP) \
do { \
if((EXP) && !CONSTANT_CLASS_P (EXP)) \
@@ -98,12 +97,10 @@ do { \
/* Finalize the processing of From_Limited_With incomplete types. */
extern void finalize_from_limited_with (void);
-/* Return the equivalent type to be used for GNAT_ENTITY, if it's a
- kind of type (such E_Task_Type) that has a different type which Gigi
- uses for its representation. If the type does not have a special type
- for its representation, return GNAT_ENTITY. If a type is supposed to
- exist, but does not, abort unless annotating types, in which case
- return Empty. If GNAT_ENTITY is Empty, return Empty. */
+/* Return the equivalent type to be used for GNAT_ENTITY, if it's a kind
+ of type (such E_Task_Type) that has a different type which Gigi uses
+ for its representation. If the type does not have a special type for
+ its representation, return GNAT_ENTITY. */
extern Entity_Id Gigi_Equivalent_Type (Entity_Id gnat_entity);
/* Given GNAT_ENTITY, elaborate all expressions that are required to
Index: gcc-interface/trans.c
===================================================================
--- gcc-interface/trans.c (revision 247951)
+++ gcc-interface/trans.c (working copy)
@@ -237,7 +237,6 @@ static tree build_binary_op_trapv (enum
static tree convert_with_check (Entity_Id, tree, bool, bool, bool, Node_Id);
static bool addressable_p (tree, tree);
static tree assoc_to_constructor (Entity_Id, Node_Id, tree);
-static tree extract_values (tree, tree);
static tree pos_to_constructor (Node_Id, tree, Entity_Id);
static void validate_unchecked_conversion (Node_Id);
static tree maybe_implicit_deref (tree);
@@ -6497,8 +6496,7 @@ gnat_to_gnu (Node_Id gnat_node)
gnu_aggr_type = TYPE_REPRESENTATIVE_ARRAY (gnu_result_type);
if (Null_Record_Present (gnat_node))
- gnu_result = gnat_build_constructor (gnu_aggr_type,
- NULL);
+ gnu_result = gnat_build_constructor (gnu_aggr_type, NULL);
else if (TREE_CODE (gnu_aggr_type) == RECORD_TYPE
|| TREE_CODE (gnu_aggr_type) == UNION_TYPE)
@@ -6858,7 +6856,7 @@ gnat_to_gnu (Node_Id gnat_node)
case N_Allocator:
{
- tree gnu_init = 0;
+ tree gnu_init = NULL_TREE;
tree gnu_type;
bool ignore_init_type = false;
@@ -9658,6 +9656,55 @@ process_type (Entity_Id gnat_entity)
}
}
+/* Subroutine of assoc_to_constructor: VALUES is a list of field associations,
+ some of which are from RECORD_TYPE. Return a CONSTRUCTOR consisting of the
+ associations that are from RECORD_TYPE. If we see an internal record, make
+ a recursive call to fill it in as well. */
+
+static tree
+extract_values (tree values, tree record_type)
+{
+ vec<constructor_elt, va_gc> *v = NULL;
+ tree field;
+
+ for (field = TYPE_FIELDS (record_type); field; field = DECL_CHAIN (field))
+ {
+ tree tem, value = NULL_TREE;
+
+ /* _Parent is an internal field, but may have values in the aggregate,
+ so check for values first. */
+ if ((tem = purpose_member (field, values)))
+ {
+ value = TREE_VALUE (tem);
+ TREE_ADDRESSABLE (tem) = 1;
+ }
+
+ else if (DECL_INTERNAL_P (field))
+ {
+ value = extract_values (values, TREE_TYPE (field));
+ if (TREE_CODE (value) == CONSTRUCTOR
+ && vec_safe_is_empty (CONSTRUCTOR_ELTS (value)))
+ value = NULL_TREE;
+ }
+ else
+ /* If we have a record subtype, the names will match, but not the
+ actual FIELD_DECLs. */
+ for (tem = values; tem; tem = TREE_CHAIN (tem))
+ if (DECL_NAME (TREE_PURPOSE (tem)) == DECL_NAME (field))
+ {
+ value = convert (TREE_TYPE (field), TREE_VALUE (tem));
+ TREE_ADDRESSABLE (tem) = 1;
+ }
+
+ if (!value)
+ continue;
+
+ CONSTRUCTOR_APPEND_ELT (v, field, value);
+ }
+
+ return gnat_build_constructor (record_type, v);
+}
+
/* GNAT_ENTITY is the type of the resulting constructor, GNAT_ASSOC is the
front of the Component_Associations of an N_Aggregate and GNU_TYPE is the
GCC type of the corresponding record type. Return the CONSTRUCTOR. */
@@ -9728,11 +9775,12 @@ pos_to_constructor (Node_Id gnat_expr, t
Entity_Id gnat_component_type)
{
tree gnu_index = TYPE_MIN_VALUE (TYPE_DOMAIN (gnu_array_type));
- tree gnu_expr;
vec<constructor_elt, va_gc> *gnu_expr_vec = NULL;
- for ( ; Present (gnat_expr); gnat_expr = Next (gnat_expr))
+ for (; Present (gnat_expr); gnat_expr = Next (gnat_expr))
{
+ tree gnu_expr;
+
/* If the expression is itself an array aggregate then first build the
innermost constructor if it is part of our array (multi-dimensional
case). */
@@ -9763,55 +9811,6 @@ pos_to_constructor (Node_Id gnat_expr, t
return gnat_build_constructor (gnu_array_type, gnu_expr_vec);
}
-/* Subroutine of assoc_to_constructor: VALUES is a list of field associations,
- some of which are from RECORD_TYPE. Return a CONSTRUCTOR consisting of the
- associations that are from RECORD_TYPE. If we see an internal record, make
- a recursive call to fill it in as well. */
-
-static tree
-extract_values (tree values, tree record_type)
-{
- tree field, tem;
- vec<constructor_elt, va_gc> *v = NULL;
-
- for (field = TYPE_FIELDS (record_type); field; field = DECL_CHAIN (field))
- {
- tree value = 0;
-
- /* _Parent is an internal field, but may have values in the aggregate,
- so check for values first. */
- if ((tem = purpose_member (field, values)))
- {
- value = TREE_VALUE (tem);
- TREE_ADDRESSABLE (tem) = 1;
- }
-
- else if (DECL_INTERNAL_P (field))
- {
- value = extract_values (values, TREE_TYPE (field));
- if (TREE_CODE (value) == CONSTRUCTOR
- && vec_safe_is_empty (CONSTRUCTOR_ELTS (value)))
- value = 0;
- }
- else
- /* If we have a record subtype, the names will match, but not the
- actual FIELD_DECLs. */
- for (tem = values; tem; tem = TREE_CHAIN (tem))
- if (DECL_NAME (TREE_PURPOSE (tem)) == DECL_NAME (field))
- {
- value = convert (TREE_TYPE (field), TREE_VALUE (tem));
- TREE_ADDRESSABLE (tem) = 1;
- }
-
- if (!value)
- continue;
-
- CONSTRUCTOR_APPEND_ELT (v, field, value);
- }
-
- return gnat_build_constructor (record_type, v);
-}
-
/* Process a N_Validate_Unchecked_Conversion node. */
static void
@@ -9915,8 +9914,8 @@ Sloc_to_locus (Source_Ptr Sloc, location
line = 1;
/* Translate the location. */
- *locus = linemap_position_for_line_and_column (line_table, map,
- line, column);
+ *locus
+ = linemap_position_for_line_and_column (line_table, map, line, column);
return true;
}
Index: gcc-interface/utils.c
===================================================================
--- gcc-interface/utils.c (revision 247951)
+++ gcc-interface/utils.c (working copy)
@@ -2992,7 +2992,7 @@ process_deferred_decl_context (bool forc
struct deferred_decl_context_node **it = &deferred_decl_context_queue;
struct deferred_decl_context_node *node;
- while (*it != NULL)
+ while (*it)
{
bool processed = false;
tree context = NULL_TREE;
@@ -3000,7 +3000,7 @@ process_deferred_decl_context (bool forc
node = *it;
- /* If FORCE, get the innermost elaborated scope. Otherwise, just try to
+ /* If FORCE, get the innermost elaborated scope. Otherwise, just try to
get the first scope. */
gnat_scope = node->gnat_scope;
while (Present (gnat_scope))
@@ -3058,7 +3058,6 @@ process_deferred_decl_context (bool forc
}
}
-
/* Return VALUE scaled by the biggest power-of-2 factor of EXPR. */
static unsigned int
