diff options
Diffstat (limited to 'gcc/ada/decl.c')
| -rw-r--r-- | gcc/ada/decl.c | 424 |
1 files changed, 198 insertions, 226 deletions
diff --git a/gcc/ada/decl.c b/gcc/ada/decl.c index 870d5cc..c18f08d 100644 --- a/gcc/ada/decl.c +++ b/gcc/ada/decl.c @@ -176,8 +176,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) : LONG_LONG_TYPE_SIZE); tree gnu_size = 0; bool imported_p - = ((Is_Imported (gnat_entity) && No (Address_Clause (gnat_entity))) - || From_With_Type (gnat_entity)); + = (Is_Imported (gnat_entity) && No (Address_Clause (gnat_entity))); unsigned int align = 0; /* Since a use of an Itype is a definition, process it as such if it @@ -424,6 +423,15 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) break; } + else if (Present (CR_Discriminant (gnat_entity)) + && type_annotate_only) + { + gnu_decl = gnat_to_gnu_entity (CR_Discriminant (gnat_entity), + gnu_expr, definition); + saved = 1; + break; + } + /* If the enclosing record has explicit stored discriminants, then it is an untagged record. If the Corresponding_Discriminant is not empty then this must be a renamed discriminant and its @@ -815,21 +823,22 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) object, we just make a "bare" pointer, and the renamed entity is always accessed indirectly through it. */ { - bool expr_has_side_effects = TREE_SIDE_EFFECTS (gnu_expr); - inner_const_flag = TREE_READONLY (gnu_expr); const_flag = true; gnu_type = build_reference_type (gnu_type); /* If a previous attempt at unrestricted stabilization failed, there is no point trying again and we can reuse - the result without attaching it to the pointer. */ + the result without attaching it to the pointer. In this + case it will only be used as the initializing expression + of the pointer and thus needs no special treatment with + regard to multiple evaluations. */ if (maybe_stable_expr) ; - /* Otherwise, try to stabilize now, restricting to - lvalues only, and attach the expression to the pointer - if the stabilization succeeds. + /* Otherwise, try to stabilize now, restricting to lvalues + only, and attach the expression to the pointer if the + stabilization succeeds. Note that this might introduce SAVE_EXPRs and we don't check whether we're at the global level or not. This is @@ -852,21 +861,14 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) if (stabilized) renamed_obj = maybe_stable_expr; + /* Attaching is actually performed downstream, as soon - as we have a DECL for the pointer we make. */ + as we have a VAR_DECL for the pointer we make. */ } gnu_expr = build_unary_op (ADDR_EXPR, gnu_type, maybe_stable_expr); - /* If the initial expression has side effects, we might - still have an unstabilized version at this point (for - instance if it involves a function call). Wrap the - result into a SAVE_EXPR now, in case it happens to be - referenced several times. */ - if (expr_has_side_effects && ! stabilized) - gnu_expr = save_expr (gnu_expr); - gnu_size = NULL_TREE; used_by_ref = true; } @@ -930,7 +932,18 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) /* Ignore the size. It's either meaningless or was handled above. */ gnu_size = NULL_TREE; - gnu_type = build_reference_type (gnu_type); + /* The address expression contains a conversion from pointer type + to the system__address integer type, which means the address + of the underlying object escapes. We therefore have no other + choice than forcing the type of the object being defined to + alias everything in order to make type-based alias analysis + aware that it will dereference the escaped address. + ??? This uncovers problems in ACATS at -O2 with the volatility + of the original type: it may not be correctly propagated, thus + causing PRE to enter an infinite loop creating value numbers + out of volatile expressions. Disable it for now. */ + gnu_type + = build_reference_type_for_mode (gnu_type, ptr_mode, false); gnu_address = convert (gnu_type, gnu_address); used_by_ref = true; const_flag = !Is_Public (gnat_entity); @@ -959,7 +972,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) || (Is_Imported (gnat_entity) && Has_Stdcall_Convention (gnat_entity))) { - gnu_type = build_reference_type (gnu_type); + /* See the definition case above for the rationale. */ + gnu_type + = build_reference_type_for_mode (gnu_type, ptr_mode, false); gnu_size = NULL_TREE; gnu_expr = NULL_TREE; @@ -1134,17 +1149,13 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) if (TREE_CODE (gnu_decl) == VAR_DECL && renamed_obj) { SET_DECL_RENAMED_OBJECT (gnu_decl, renamed_obj); - DECL_RENAMING_GLOBAL_P (gnu_decl) = global_bindings_p (); + if (global_bindings_p ()) + { + DECL_RENAMING_GLOBAL_P (gnu_decl) = 1; + record_global_renaming_pointer (gnu_decl); + } } - /* If we have an address clause and we've made this indirect, it's - not enough to merely mark the type as volatile since volatile - references only conflict with other volatile references while this - reference must conflict with all other references. So ensure that - the dereferenced value has alias set 0. */ - if (Present (Address_Clause (gnat_entity)) && used_by_ref) - DECL_POINTER_ALIAS_SET (gnu_decl) = 0; - if (definition && DECL_SIZE (gnu_decl) && get_block_jmpbuf_decl () && (TREE_CODE (DECL_SIZE (gnu_decl)) != INTEGER_CST @@ -1169,9 +1180,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) || Is_Aliased (Etype (gnat_entity)))) { tree gnu_corr_var - = create_var_decl (gnu_entity_id, gnu_ext_name, gnu_type, - gnu_expr, false, Is_Public (gnat_entity), - false, static_p, NULL, gnat_entity); + = create_true_var_decl (gnu_entity_id, gnu_ext_name, gnu_type, + gnu_expr, true, Is_Public (gnat_entity), + false, static_p, NULL, gnat_entity); SET_DECL_CONST_CORRESPONDING_VAR (gnu_decl, gnu_corr_var); } @@ -1220,6 +1231,12 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) if (No (First_Literal (gnat_entity))) { gnu_type = make_unsigned_type (esize); + TYPE_NAME (gnu_type) = gnu_entity_id; + + /* Set the TYPE_STRING_FLAG for Ada Character and + Wide_Character types. This is needed by the dwarf-2 debug writer to + distinguish between unsigned integer types and character types. */ + TYPE_STRING_FLAG (gnu_type) = 1; break; } @@ -1734,18 +1751,16 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) tem = build_array_type (tem, gnu_index_types[index]); TYPE_MULTI_ARRAY_P (tem) = (index > 0); - /* If the type below this an multi-array type, then this - does not not have aliased components. - - ??? Otherwise, for now, we say that any component of aggregate - type is addressable because the front end may take 'Reference - of it. But we have to make it addressable if it must be passed - by reference or it that is the default. */ - TYPE_NONALIASED_COMPONENT (tem) - = ((TREE_CODE (TREE_TYPE (tem)) == ARRAY_TYPE - && TYPE_MULTI_ARRAY_P (TREE_TYPE (tem))) ? 1 - : (!Has_Aliased_Components (gnat_entity) - && !AGGREGATE_TYPE_P (TREE_TYPE (tem)))); + /* If the type below this is a multi-array type, then this + does not have aliased components. But we have to make + them addressable if it must be passed by reference or + if that is the default. */ + if ((TREE_CODE (TREE_TYPE (tem)) == ARRAY_TYPE + && TYPE_MULTI_ARRAY_P (TREE_TYPE (tem))) + || (!Has_Aliased_Components (gnat_entity) + && !must_pass_by_ref (TREE_TYPE (tem)) + && !default_pass_by_ref (TREE_TYPE (tem)))) + TYPE_NONALIASED_COMPONENT (tem) = 1; } /* If an alignment is specified, use it if valid. But ignore it for @@ -1957,13 +1972,17 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) if ((TREE_CODE (gnu_min) == INTEGER_CST && !TREE_OVERFLOW (gnu_min) && !operand_equal_p (gnu_min, gnu_base_base_min, 0)) - || !CONTAINS_PLACEHOLDER_P (gnu_min)) + || !CONTAINS_PLACEHOLDER_P (gnu_min) + || !(TREE_CODE (gnu_base_min) == INTEGER_CST + && !TREE_OVERFLOW (gnu_base_min))) gnu_base_min = gnu_min; if ((TREE_CODE (gnu_max) == INTEGER_CST && !TREE_OVERFLOW (gnu_max) && !operand_equal_p (gnu_max, gnu_base_base_max, 0)) - || !CONTAINS_PLACEHOLDER_P (gnu_max)) + || !CONTAINS_PLACEHOLDER_P (gnu_max) + || !(TREE_CODE (gnu_base_max) == INTEGER_CST + && !TREE_OVERFLOW (gnu_base_max))) gnu_base_max = gnu_max; if ((TREE_CODE (gnu_base_min) == INTEGER_CST @@ -2054,18 +2073,17 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) { gnu_type = build_array_type (gnu_type, gnu_index_type[index]); TYPE_MULTI_ARRAY_P (gnu_type) = (index > 0); - /* If the type below this an multi-array type, then this - does not not have aliased components. - - ??? Otherwise, for now, we say that any component of aggregate - type is addressable because the front end may take 'Reference - of it. But we have to make it addressable if it must be passed - by reference or it that is the default. */ - TYPE_NONALIASED_COMPONENT (gnu_type) - = ((TREE_CODE (TREE_TYPE (gnu_type)) == ARRAY_TYPE - && TYPE_MULTI_ARRAY_P (TREE_TYPE (gnu_type))) ? 1 - : (!Has_Aliased_Components (gnat_entity) - && !AGGREGATE_TYPE_P (TREE_TYPE (gnu_type)))); + + /* If the type below this is a multi-array type, then this + does not have aliased components. But we have to make + them addressable if it must be passed by reference or + if that is the default. */ + if ((TREE_CODE (TREE_TYPE (gnu_type)) == ARRAY_TYPE + && TYPE_MULTI_ARRAY_P (TREE_TYPE (gnu_type))) + || (!Has_Aliased_Components (gnat_entity) + && !must_pass_by_ref (TREE_TYPE (gnu_type)) + && !default_pass_by_ref (TREE_TYPE (gnu_type)))) + TYPE_NONALIASED_COMPONENT (gnu_type) = 1; } /* If we are at file level and this is a multi-dimensional array, we @@ -2381,27 +2399,17 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) } /* Make a node for the record. If we are not defining the record, - suppress expanding incomplete types. We use the same RECORD_TYPE - as for a dummy type and reset TYPE_DUMMY_P to show it's no longer - a dummy. - - It is very tempting to delay resetting this bit until we are done - with completing the type, e.g. to let possible intermediate - elaboration of access types designating the record know it is not - complete and arrange for update_pointer_to to fix things up later. - - It would be wrong, however, because dummy types are expected only - to be created for Ada incomplete or private types, which is not - what we have here. Doing so would make other parts of gigi think - we are dealing with a really incomplete or private type, and have - nasty side effects, typically on the generation of the associated - debugging information. */ - gnu_type = make_dummy_type (gnat_entity); - TYPE_DUMMY_P (gnu_type) = 0; - - if (TREE_CODE (TYPE_NAME (gnu_type)) == TYPE_DECL && debug_info_p) - DECL_IGNORED_P (TYPE_NAME (gnu_type)) = 0; - + suppress expanding incomplete types. */ + gnu_type = make_node (tree_code_for_record_type (gnat_entity)); + TYPE_NAME (gnu_type) = gnu_entity_id; + /* ??? We should have create_type_decl like in the E_Record_Subtype + case below. Unfortunately this would cause GNU_TYPE to be marked + as visited, thus precluding the subtrees of the type that will be + built below from being marked as visited when the real TYPE_DECL + is eventually created. A solution could be to devise a special + version of the function under the name create_type_stub_decl. */ + TYPE_STUB_DECL (gnu_type) + = build_decl (TYPE_DECL, NULL_TREE, gnu_type); TYPE_ALIGN (gnu_type) = 0; TYPE_PACKED (gnu_type) = packed || has_rep; @@ -2926,10 +2934,17 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) case E_General_Access_Type: { Entity_Id gnat_desig_type = Directly_Designated_Type (gnat_entity); + /* Get the "full view" of this entity. If this is an incomplete + entity from a limited with, treat its non-limited view as the + full view. Otherwise, if this is an incomplete or private + type, use the full view. */ Entity_Id gnat_desig_full - = ((IN (Ekind (Etype (gnat_desig_type)), - Incomplete_Or_Private_Kind)) - ? Full_View (gnat_desig_type) : 0); + = (IN (Ekind (gnat_desig_type), Incomplete_Kind) + && From_With_Type (gnat_desig_type)) + ? Non_Limited_View (gnat_desig_type) + : IN (Ekind (gnat_desig_type), Incomplete_Or_Private_Kind) + ? Full_View (gnat_desig_type) + : Empty; /* We want to know if we'll be seeing the freeze node for any incomplete type we may be pointing to. */ bool in_main_unit @@ -3008,6 +3023,12 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) && defer_incomplete_level && !present_gnu_tree (gnat_desig_type) && Is_Array_Type (gnat_desig_type) + && ! Is_Constrained (gnat_desig_type)) + || (in_main_unit && From_With_Type (gnat_entity) + && (Present (gnat_desig_full) + ? Present (Freeze_Node (gnat_desig_full)) + : Present (Freeze_Node (gnat_desig_type))) + && Is_Array_Type (gnat_desig_type) && !Is_Constrained (gnat_desig_type))) { tree gnu_old @@ -3089,6 +3110,25 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) gnu_desig_type = make_dummy_type (gnat_desig_type); made_dummy = true; } + + /* If this is a reference from a limited_with type back to our + main unit and there's a Freeze_Node for it, either we have + already processed the declaration and made the dummy type, + in which case we just reuse the latter, or we have not yet, + in which case we make the dummy type and it will be reused + when the declaration is processed. In both cases, the pointer + eventually created below will be automatically adjusted when + the Freeze_Node is processed. Note that the unconstrained + array case is handled above. */ + else if (in_main_unit && From_With_Type (gnat_entity) + && (Present (gnat_desig_full) + ? Present (Freeze_Node (gnat_desig_full)) + : Present (Freeze_Node (gnat_desig_type)))) + { + gnu_desig_type = make_dummy_type (gnat_desig_type); + made_dummy = true; + } + else if (gnat_desig_type == gnat_entity) { gnu_type @@ -3097,6 +3137,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) No_Strict_Aliasing (gnat_entity)); TREE_TYPE (gnu_type) = TYPE_POINTER_TO (gnu_type) = gnu_type; } + else gnu_desig_type = gnat_to_gnu_type (gnat_desig_type); @@ -3210,8 +3251,11 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) if (type_annotate_only && No (Equivalent_Type (gnat_entity))) gnu_type = build_pointer_type (void_type_node); else - /* The runtime representation is the equivalent type. */ - gnu_type = gnat_to_gnu_type (Equivalent_Type (gnat_entity)); + { + /* The runtime representation is the equivalent type. */ + gnu_type = gnat_to_gnu_type (Equivalent_Type (gnat_entity)); + maybe_present = 1; + } if (Is_Itype (Directly_Designated_Type (gnat_entity)) && !present_gnu_tree (Directly_Designated_Type (gnat_entity)) @@ -3373,7 +3417,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) gnu_expr, 0); /* Elaborate any Itypes in the parameters of this entity. */ - for (gnat_temp = First_Formal (gnat_entity); + for (gnat_temp = First_Formal_With_Extras (gnat_entity); Present (gnat_temp); gnat_temp = Next_Formal_With_Extras (gnat_temp)) if (Is_Itype (Etype (gnat_temp))) @@ -3413,8 +3457,14 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) else if (kind == E_Function && Mechanism (gnat_entity) == By_Reference) { - gnu_return_type = copy_type (gnu_return_type); TREE_ADDRESSABLE (gnu_return_type) = 1; + + /* We expect this bit to be reset by gigi shortly, so can avoid a + type node copy here. This actually also prevents troubles with + the generation of debug information for the function, because + we might have issued such info for this type already, and would + be attaching a distinct type node to the function if we made a + copy here. */ } /* If we are supposed to return an unconstrained array, @@ -3479,7 +3529,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) each. While doing this, build a copy-out structure if we need one. */ - for (gnat_param = First_Formal (gnat_entity), parmnum = 0; + for (gnat_param = First_Formal_With_Extras (gnat_entity), parmnum = 0; Present (gnat_param); gnat_param = Next_Formal_With_Extras (gnat_param), parmnum++) { @@ -3858,71 +3908,76 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) break; case E_Incomplete_Type: + case E_Incomplete_Subtype: case E_Private_Type: - case E_Limited_Private_Type: - case E_Record_Type_With_Private: case E_Private_Subtype: + case E_Limited_Private_Type: case E_Limited_Private_Subtype: + case E_Record_Type_With_Private: case E_Record_Subtype_With_Private: - - /* If this type does not have a full view in the unit we are - compiling, then just get the type from its Etype. */ - if (No (Full_View (gnat_entity))) - { - /* If this is an incomplete type with no full view, it must be - either a limited view brought in by a limited_with clause, in - which case we use the non-limited view, or a Taft Amendement - type, in which case we just return a dummy type. */ - if (kind == E_Incomplete_Type) - { - if (From_With_Type (gnat_entity) - && Present (Non_Limited_View (gnat_entity))) - gnu_decl = gnat_to_gnu_entity (Non_Limited_View (gnat_entity), + { + /* Get the "full view" of this entity. If this is an incomplete + entity from a limited with, treat its non-limited view as the + full view. Otherwise, use either the full view or the underlying + full view, whichever is present. This is used in all the tests + below. */ + Entity_Id full_view + = (IN (Ekind (gnat_entity), Incomplete_Kind) + && From_With_Type (gnat_entity)) + ? Non_Limited_View (gnat_entity) + : Present (Full_View (gnat_entity)) + ? Full_View (gnat_entity) + : Underlying_Full_View (gnat_entity); + + /* If this is an incomplete type with no full view, it must be a Taft + Amendment type, in which case we return a dummy type. Otherwise, + just get the type from its Etype. */ + if (No (full_view)) + { + if (kind == E_Incomplete_Type) + gnu_type = make_dummy_type (gnat_entity); + else + { + gnu_decl = gnat_to_gnu_entity (Etype (gnat_entity), NULL_TREE, 0); - else - gnu_type = make_dummy_type (gnat_entity); - } - - else if (Present (Underlying_Full_View (gnat_entity))) - gnu_decl = gnat_to_gnu_entity (Underlying_Full_View (gnat_entity), - NULL_TREE, 0); - else - { - gnu_decl = gnat_to_gnu_entity (Etype (gnat_entity), - NULL_TREE, 0); - maybe_present = true; - } - - break; - } + maybe_present = true; + } + break; + } - /* Otherwise, if we are not defining the type now, get the - type from the full view. But always get the type from the full - view for define on use types, since otherwise we won't see them! */ + /* If we already made a type for the full view, reuse it. */ + else if (present_gnu_tree (full_view)) + { + gnu_decl = get_gnu_tree (full_view); + break; + } - else if (!definition - || (Is_Itype (Full_View (gnat_entity)) + /* Otherwise, if we are not defining the type now, get the type + from the full view. But always get the type from the full view + for define on use types, since otherwise we won't see them! */ + else if (!definition + || (Is_Itype (full_view) && No (Freeze_Node (gnat_entity))) - || (Is_Itype (gnat_entity) - && No (Freeze_Node (Full_View (gnat_entity))))) - { - gnu_decl = gnat_to_gnu_entity (Full_View (gnat_entity), - NULL_TREE, 0); - maybe_present = true; - break; - } + || (Is_Itype (gnat_entity) + && No (Freeze_Node (full_view)))) + { + gnu_decl = gnat_to_gnu_entity (full_view, NULL_TREE, 0); + maybe_present = true; + break; + } - /* For incomplete types, make a dummy type entry which will be - replaced later. */ - gnu_type = make_dummy_type (gnat_entity); + /* For incomplete types, make a dummy type entry which will be + replaced later. */ + gnu_type = make_dummy_type (gnat_entity); - /* Save this type as the full declaration's type so we can do any needed - updates when we see it. */ - gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list, - !Comes_From_Source (gnat_entity), - debug_info_p, gnat_entity); - save_gnu_tree (Full_View (gnat_entity), gnu_decl, false); - break; + /* Save this type as the full declaration's type so we can do any + needed updates when we see it. */ + gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list, + !Comes_From_Source (gnat_entity), + debug_info_p, gnat_entity); + save_gnu_tree (full_view, gnu_decl, 0); + break; + } /* Simple class_wide types are always viewed as their root_type by Gigi unless an Equivalent_Type is specified. */ @@ -4521,88 +4576,6 @@ substitution_list (Entity_Id gnat_subtype, Entity_Id gnat_type, return gnu_list; } -/* For the following two functions: for each GNAT entity, the GCC - tree node used as a dummy for that entity, if any. */ - -static GTY((length ("max_gnat_nodes"))) tree * dummy_node_table; - -/* Initialize the above table. */ - -void -init_dummy_type (void) -{ - Node_Id gnat_node; - - dummy_node_table = (tree *) ggc_alloc (max_gnat_nodes * sizeof (tree)); - - for (gnat_node = 0; gnat_node < max_gnat_nodes; gnat_node++) - dummy_node_table[gnat_node] = NULL_TREE; - - dummy_node_table -= First_Node_Id; -} - -/* Make a dummy type corresponding to GNAT_TYPE. */ - -tree -make_dummy_type (Entity_Id gnat_type) -{ - Entity_Id gnat_underlying; - tree gnu_type; - enum tree_code code; - - /* Find a full type for GNAT_TYPE, taking into account any class wide - types. */ - if (Is_Class_Wide_Type (gnat_type) && Present (Equivalent_Type (gnat_type))) - gnat_type = Equivalent_Type (gnat_type); - else if (Ekind (gnat_type) == E_Class_Wide_Type) - gnat_type = Root_Type (gnat_type); - - for (gnat_underlying = gnat_type; - (IN (Ekind (gnat_underlying), Incomplete_Or_Private_Kind) - && Present (Full_View (gnat_underlying))); - gnat_underlying = Full_View (gnat_underlying)) - ; - - /* If it there already a dummy type, use that one. Else make one. */ - if (dummy_node_table[gnat_underlying]) - return dummy_node_table[gnat_underlying]; - - /* If this is a record, make this a RECORD_TYPE or UNION_TYPE; else make - it an ENUMERAL_TYPE. */ - if (Is_Record_Type (gnat_underlying)) - { - Node_Id component_list - = Component_List (Type_Definition - (Declaration_Node - (Implementation_Base_Type (gnat_underlying)))); - Node_Id component; - - /* Make this a UNION_TYPE unless it's either not an Unchecked_Union or - we have a non-discriminant field outside a variant. In either case, - it's a RECORD_TYPE. */ - code = UNION_TYPE; - if (!Is_Unchecked_Union (gnat_underlying)) - code = RECORD_TYPE; - else - for (component = First_Non_Pragma (Component_Items (component_list)); - Present (component); component = Next_Non_Pragma (component)) - if (Ekind (Defining_Entity (component)) == E_Component) - code = RECORD_TYPE; - } - else - code = ENUMERAL_TYPE; - - gnu_type = make_node (code); - TYPE_NAME (gnu_type) = get_entity_name (gnat_type); - TYPE_DUMMY_P (gnu_type) = 1; - if (AGGREGATE_TYPE_P (gnu_type)) - TYPE_STUB_DECL (gnu_type) = build_decl (TYPE_DECL, NULL_TREE, gnu_type); - - dummy_node_table[gnat_underlying] = gnu_type; - - return gnu_type; -} - /* Return true if the size represented by GNU_SIZE can be handled by an allocation. If STATIC_P is true, consider only what can be done with a static allocation. */ @@ -4830,7 +4803,8 @@ elaborate_expression_1 (Node_Id gnat_expr, Entity_Id gnat_entity, expr_variable = (!CONSTANT_CLASS_P (gnu_expr) && !(TREE_CODE (gnu_inner_expr) == VAR_DECL - && TREE_READONLY (gnu_inner_expr)) + && (TREE_READONLY (gnu_inner_expr) + || DECL_READONLY_ONCE_ELAB (gnu_inner_expr))) && !CONTAINS_PLACEHOLDER_P (gnu_expr)); /* If this is a static expression or contains a discriminant, we don't @@ -6875,5 +6849,3 @@ concat_id_with_name (tree gnu_id, const char *suffix) strcpy (Name_Buffer + len, suffix); return get_identifier (Name_Buffer); } - -#include "gt-ada-decl.h" |