From b1b2b511e525b098204c590b0eafa7d36092b7e1 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Mon, 15 May 2017 08:14:32 +0000 Subject: [PATCH] trans.c (gnat_to_gnu): Fix formatting. * gcc-interface/trans.c (gnat_to_gnu) : Fix formatting. : 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. From-SVN: r248050 --- gcc/ada/ChangeLog | 12 ++++ gcc/ada/gcc-interface/decl.c | 22 +++---- gcc/ada/gcc-interface/gigi.h | 11 ++-- gcc/ada/gcc-interface/trans.c | 113 +++++++++++++++++----------------- gcc/ada/gcc-interface/utils.c | 5 +- 5 files changed, 84 insertions(+), 79 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index dc2916e5278..29d49d96164 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,15 @@ +2017-05-15 Eric Botcazou + + * gcc-interface/trans.c (gnat_to_gnu) : Fix formatting. + : 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. + 2017-05-15 Eric Botcazou * gcc-interface/decl.c (gnat_to_gnu_entity) : When there diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index b39b75a852b..dee59c0324c 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -3270,12 +3270,12 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) } /* 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) diff --git a/gcc/ada/gcc-interface/gigi.h b/gcc/ada/gcc-interface/gigi.h index 1d87b5be44e..1fc3448a083 100644 --- a/gcc/ada/gcc-interface/gigi.h +++ b/gcc/ada/gcc-interface/gigi.h @@ -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 diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c index 9b7155282f7..ef0db27c8ca 100644 --- a/gcc/ada/gcc-interface/trans.c +++ b/gcc/ada/gcc-interface/trans.c @@ -237,7 +237,6 @@ static tree build_binary_op_trapv (enum tree_code, tree, tree, tree, Node_Id); 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 *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, tree gnu_array_type, Entity_Id gnat_component_type) { tree gnu_index = TYPE_MIN_VALUE (TYPE_DOMAIN (gnu_array_type)); - tree gnu_expr; vec *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, tree gnu_array_type, 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 *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_t *locus, bool clear_column) 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; } diff --git a/gcc/ada/gcc-interface/utils.c b/gcc/ada/gcc-interface/utils.c index 4549a1b64fe..4fabddfe5e1 100644 --- a/gcc/ada/gcc-interface/utils.c +++ b/gcc/ada/gcc-interface/utils.c @@ -2992,7 +2992,7 @@ process_deferred_decl_context (bool force) 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 force) 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 force) } } - /* Return VALUE scaled by the biggest power-of-2 factor of EXPR. */ static unsigned int -- 2.30.2