From a3b35344fdbeff504110ca9a62a8aad75061de45 Mon Sep 17 00:00:00 2001 From: ebotcazou Date: Mon, 27 Feb 2012 10:41:10 +0000 Subject: [PATCH 1/1] * gcc-interface/ada-tree.h (TYPE_PACKED_ARRAY_TYPE_P): Add checking. (TYPE_BY_REFERENCE_P): New flag. (TYPE_IS_BY_REFERENCE_P): New macro. (TYPE_DUMMY_P): Add checking and remove VOID_TYPE. (TYPE_IS_DUMMY_P): Adjust for above change. * gcc-interface/decl.c (gnat_to_gnu_entity): Use TYPE_BY_REFERENCE_P and TYPE_IS_BY_REFERENCE_P instead of TREE_ADDRESSABLE. (gnat_to_gnu_param): Likewise. (maybe_pad_type): Likewise. (make_type_from_size): Use TYPE_IS_PACKED_ARRAY_TYPE_P. * gcc-interface/misc.c (must_pass_by_ref): Use TYPE_IS_BY_REFERENCE_P instead of TREE_ADDRESSABLE. * gcc-interface/trans.c (finalize_nrv): Likewise. (call_to_gnu): Likewise. Do not create a temporary for return values with by-reference type here. (gnat_to_gnu): Test TYPE_IS_DUMMY_P instead of TYPE_DUMMY_P. (gnat_gimplify_expr) : Don't do anything for non-constant CONSTRUCTORs and calls. * gcc-interface/utils.c (make_dummy_type): Get the equivalent type of the underlying type and use it throughout. Use TYPE_IS_BY_REFERENCE_P instead of TREE_ADDRESSABLE. * gcc-interface/utils2.c (build_cond_expr): Deal with by-reference types explicitly. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@184594 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/ChangeLog | 26 ++++++++++++++++++++ gcc/ada/gcc-interface/ada-tree.h | 34 +++++++++++++++++++------- gcc/ada/gcc-interface/decl.c | 15 ++++++------ gcc/ada/gcc-interface/misc.c | 4 ++-- gcc/ada/gcc-interface/trans.c | 46 +++++++++++------------------------- gcc/ada/gcc-interface/utils.c | 6 ++--- gcc/ada/gcc-interface/utils2.c | 3 ++- gcc/testsuite/ChangeLog | 5 ++++ gcc/testsuite/gnat.dg/aggr19.adb | 14 +++++++++++ gcc/testsuite/gnat.dg/aggr19_pkg.adb | 8 +++++++ gcc/testsuite/gnat.dg/aggr19_pkg.ads | 32 +++++++++++++++++++++++++ 11 files changed, 139 insertions(+), 54 deletions(-) create mode 100644 gcc/testsuite/gnat.dg/aggr19.adb create mode 100644 gcc/testsuite/gnat.dg/aggr19_pkg.adb create mode 100644 gcc/testsuite/gnat.dg/aggr19_pkg.ads diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index ab89b0b8c64..38d58f30d5d 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,31 @@ 2012-02-27 Eric Botcazou + * gcc-interface/ada-tree.h (TYPE_PACKED_ARRAY_TYPE_P): Add checking. + (TYPE_BY_REFERENCE_P): New flag. + (TYPE_IS_BY_REFERENCE_P): New macro. + (TYPE_DUMMY_P): Add checking and remove VOID_TYPE. + (TYPE_IS_DUMMY_P): Adjust for above change. + * gcc-interface/decl.c (gnat_to_gnu_entity): Use TYPE_BY_REFERENCE_P + and TYPE_IS_BY_REFERENCE_P instead of TREE_ADDRESSABLE. + (gnat_to_gnu_param): Likewise. + (maybe_pad_type): Likewise. + (make_type_from_size): Use TYPE_IS_PACKED_ARRAY_TYPE_P. + * gcc-interface/misc.c (must_pass_by_ref): Use TYPE_IS_BY_REFERENCE_P + instead of TREE_ADDRESSABLE. + * gcc-interface/trans.c (finalize_nrv): Likewise. + (call_to_gnu): Likewise. Do not create a temporary for return values + with by-reference type here. + (gnat_to_gnu): Test TYPE_IS_DUMMY_P instead of TYPE_DUMMY_P. + (gnat_gimplify_expr) : Don't do anything for non-constant + CONSTRUCTORs and calls. + * gcc-interface/utils.c (make_dummy_type): Get the equivalent type of + the underlying type and use it throughout. Use TYPE_IS_BY_REFERENCE_P + instead of TREE_ADDRESSABLE. + * gcc-interface/utils2.c (build_cond_expr): Deal with by-reference + types explicitly. + +2012-02-27 Eric Botcazou + * gcc-interface/decl.c (gnat_to_gnu_entity) : Revert previous change that creates a special VAR_DECL for debugging purposes. For an aliased object with an unconstrained nominal subtype, make its type a diff --git a/gcc/ada/gcc-interface/ada-tree.h b/gcc/ada/gcc-interface/ada-tree.h index 0c32f210dea..9a48ed75b45 100644 --- a/gcc/ada/gcc-interface/ada-tree.h +++ b/gcc/ada/gcc-interface/ada-tree.h @@ -80,7 +80,8 @@ do { \ /* For integral types and array types, nonzero if this is a packed array type used for bit-packed types. Such types should not be extended to a larger size or validated against a specified size. */ -#define TYPE_PACKED_ARRAY_TYPE_P(NODE) TYPE_LANG_FLAG_0 (NODE) +#define TYPE_PACKED_ARRAY_TYPE_P(NODE) \ + TYPE_LANG_FLAG_0 (TREE_CHECK2 (NODE, INTEGER_TYPE, ARRAY_TYPE)) #define TYPE_IS_PACKED_ARRAY_TYPE_P(NODE) \ ((TREE_CODE (NODE) == INTEGER_TYPE || TREE_CODE (NODE) == ARRAY_TYPE) \ @@ -108,6 +109,21 @@ do { \ front-end. */ #define TYPE_EXTRA_SUBTYPE_P(NODE) TYPE_LANG_FLAG_2 (INTEGER_TYPE_CHECK (NODE)) +/* Nonzero for an aggregate type if this is a by-reference type. We also + set this on an ENUMERAL_TYPE that is dummy. */ +#define TYPE_BY_REFERENCE_P(NODE) \ + TYPE_LANG_FLAG_2 (TREE_CHECK5 (NODE, RECORD_TYPE, UNION_TYPE, \ + ARRAY_TYPE, UNCONSTRAINED_ARRAY_TYPE, \ + ENUMERAL_TYPE)) + +#define TYPE_IS_BY_REFERENCE_P(NODE) \ + ((TREE_CODE (NODE) == RECORD_TYPE \ + || TREE_CODE (NODE) == UNION_TYPE \ + || TREE_CODE (NODE) == ARRAY_TYPE \ + || TREE_CODE (NODE) == UNCONSTRAINED_ARRAY_TYPE \ + || TREE_CODE (NODE) == ENUMERAL_TYPE) \ + && TYPE_BY_REFERENCE_P (NODE)) + /* For RECORD_TYPE, UNION_TYPE, and QUAL_UNION_TYPE, nonzero if this is the type for an object whose type includes its template in addition to its value (only true for RECORD_TYPE). */ @@ -144,13 +160,15 @@ do { \ #define TYPE_RETURN_BY_DIRECT_REF_P(NODE) \ TYPE_LANG_FLAG_4 (FUNCTION_TYPE_CHECK (NODE)) -/* For VOID_TYPE, ENUMERAL_TYPE, UNION_TYPE, and RECORD_TYPE, nonzero if this - is a dummy type, made to correspond to a private or incomplete type. */ -#define TYPE_DUMMY_P(NODE) TYPE_LANG_FLAG_4 (NODE) +/* For RECORD_TYPE, UNION_TYPE and ENUMERAL_TYPE, nonzero if this is a dummy + type, made to correspond to a private or incomplete type. */ +#define TYPE_DUMMY_P(NODE) \ + TYPE_LANG_FLAG_4 (TREE_CHECK3 (NODE, RECORD_TYPE, UNION_TYPE, ENUMERAL_TYPE)) -#define TYPE_IS_DUMMY_P(NODE) \ - ((TREE_CODE (NODE) == VOID_TYPE || TREE_CODE (NODE) == RECORD_TYPE \ - || TREE_CODE (NODE) == UNION_TYPE || TREE_CODE (NODE) == ENUMERAL_TYPE) \ +#define TYPE_IS_DUMMY_P(NODE) \ + ((TREE_CODE (NODE) == RECORD_TYPE \ + || TREE_CODE (NODE) == UNION_TYPE \ + || TREE_CODE (NODE) == ENUMERAL_TYPE) \ && TYPE_DUMMY_P (NODE)) /* For an INTEGER_TYPE, nonzero if TYPE_ACTUAL_BOUNDS is present. */ @@ -167,7 +185,7 @@ do { \ /* True if TYPE can alias any other types. */ #define TYPE_UNIVERSAL_ALIASING_P(NODE) TYPE_LANG_FLAG_6 (NODE) -/* In an UNCONSTRAINED_ARRAY_TYPE, this is the record containing both the +/* For an UNCONSTRAINED_ARRAY_TYPE, this is the record containing both the template and the object. ??? We also put this on an ENUMERAL_TYPE that is dummy. Technically, diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 55f86812140..e47aca4a53e 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -4144,7 +4144,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) return_by_invisi_ref_p = true; /* Likewise, if the return type is itself By_Reference. */ - else if (TREE_ADDRESSABLE (gnu_return_type)) + else if (TYPE_IS_BY_REFERENCE_P (gnu_return_type)) return_by_invisi_ref_p = true; /* If the type is a padded type and the underlying type would not @@ -4673,10 +4673,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) || Is_Class_Wide_Equivalent_Type (gnat_entity)) TYPE_ALIGN_OK (gnu_type) = 1; - /* If the type is passed by reference, objects of this type must be - fully addressable and cannot be copied. */ - if (Is_By_Reference_Type (gnat_entity)) - TREE_ADDRESSABLE (gnu_type) = 1; + /* Record whether the type is passed by reference. */ + if (!VOID_TYPE_P (gnu_type) && Is_By_Reference_Type (gnat_entity)) + TYPE_BY_REFERENCE_P (gnu_type) = 1; /* ??? Don't set the size for a String_Literal since it is either confirming or we don't handle it properly (if the low bound is @@ -5621,7 +5620,7 @@ gnat_to_gnu_param (Entity_Id gnat_param, Mechanism_Type mech, parameters whose type isn't by-ref and for which the mechanism hasn't been forced to by-ref are restrict-qualified in the C sense. */ bool restrict_p - = !TREE_ADDRESSABLE (gnu_param_type) && mech != By_Reference; + = !TYPE_IS_BY_REFERENCE_P (gnu_param_type) && mech != By_Reference; gnu_param_type = build_reference_type (gnu_param_type); if (restrict_p) gnu_param_type @@ -6653,7 +6652,7 @@ maybe_pad_type (tree type, tree size, unsigned int align, if (align != 0 && RECORD_OR_UNION_TYPE_P (type) && TYPE_MODE (type) == BLKmode - && !TREE_ADDRESSABLE (type) + && !TYPE_BY_REFERENCE_P (type) && TREE_CODE (orig_size) == INTEGER_CST && !TREE_OVERFLOW (orig_size) && compare_tree_int (orig_size, MAX_FIXED_MODE_SIZE) <= 0 @@ -8353,7 +8352,7 @@ make_type_from_size (tree type, tree size_tree, bool for_biased) /* Only do something if the type is not a packed array type and doesn't already have the proper size. */ - if (TYPE_PACKED_ARRAY_TYPE_P (type) + if (TYPE_IS_PACKED_ARRAY_TYPE_P (type) || (TYPE_PRECISION (type) == size && biased_p == for_biased)) break; diff --git a/gcc/ada/gcc-interface/misc.c b/gcc/ada/gcc-interface/misc.c index 4b2fba0c191..08ca5bb92b3 100644 --- a/gcc/ada/gcc-interface/misc.c +++ b/gcc/ada/gcc-interface/misc.c @@ -6,7 +6,7 @@ * * * C Implementation File * * * - * Copyright (C) 1992-2011, Free Software Foundation, Inc. * + * Copyright (C) 1992-2012, Free Software Foundation, Inc. * * * * GNAT is free software; you can redistribute it and/or modify it under * * terms of the GNU General Public License as published by the Free Soft- * @@ -624,7 +624,7 @@ must_pass_by_ref (tree gnu_type) and does not produce compatibility problems with C, since C does not have such objects. */ return (TREE_CODE (gnu_type) == UNCONSTRAINED_ARRAY_TYPE - || TREE_ADDRESSABLE (gnu_type) + || TYPE_IS_BY_REFERENCE_P (gnu_type) || (TYPE_SIZE (gnu_type) && TREE_CODE (TYPE_SIZE (gnu_type)) != INTEGER_CST)); } diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c index 52a5ea99173..eebe2a9a901 100644 --- a/gcc/ada/gcc-interface/trans.c +++ b/gcc/ada/gcc-interface/trans.c @@ -2654,7 +2654,7 @@ establish_gnat_vms_condition_handler (void) on the C++ optimization of the same name. The main difference is that we disregard any semantical considerations when applying it here, the counterpart being that we don't try to apply it to semantically loaded - return types, i.e. types with the TREE_ADDRESSABLE flag set. + return types, i.e. types with the TYPE_BY_REFERENCE_P flag set. We consider a function body of the following GENERIC form: @@ -3012,7 +3012,7 @@ finalize_nrv (tree fndecl, bitmap nrv, VEC(tree,gc) *other, Node_Id gnat_ret) /* We shouldn't be applying the optimization to return types that we aren't allowed to manipulate freely. */ - gcc_assert (!TREE_ADDRESSABLE (TREE_TYPE (TREE_TYPE (fndecl)))); + gcc_assert (!TYPE_IS_BY_REFERENCE_P (TREE_TYPE (TREE_TYPE (fndecl)))); /* Prune the candidates that are referenced by other return values. */ data.nrv = nrv; @@ -3656,8 +3656,8 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target, parameters. 2. There is no target and this is not an object declaration, and the - return type is by-reference or has variable size, because in these - cases the gimplifier cannot create the temporary. + return type has variable size, because in these cases the gimplifier + cannot create the temporary. 3. There is a target and it is a slice or an array with fixed size, and the return type has variable size, because the gimplifier @@ -3669,8 +3669,7 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target, && ((!gnu_target && TYPE_CI_CO_LIST (gnu_subprog_type)) || (!gnu_target && Nkind (Parent (gnat_node)) != N_Object_Declaration - && (TREE_ADDRESSABLE (gnu_result_type) - || TREE_CODE (TYPE_SIZE (gnu_result_type)) != INTEGER_CST)) + && TREE_CODE (TYPE_SIZE (gnu_result_type)) != INTEGER_CST) || (gnu_target && (TREE_CODE (gnu_target) == ARRAY_RANGE_REF || (TREE_CODE (TREE_TYPE (gnu_target)) == ARRAY_TYPE @@ -3740,7 +3739,7 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target, ; /* If the type is passed by reference, a copy is not allowed. */ - else if (TREE_ADDRESSABLE (gnu_formal_type)) + else if (TYPE_IS_BY_REFERENCE_P (gnu_formal_type)) post_error ("misaligned actual cannot be passed by reference", gnat_actual); @@ -6786,12 +6785,12 @@ gnat_to_gnu (Node_Id gnat_node) : NULL_TREE; tree gnu_target_desig_type = TREE_TYPE (gnu_target_type); - if ((TYPE_DUMMY_P (gnu_target_desig_type) + if ((TYPE_IS_DUMMY_P (gnu_target_desig_type) || get_alias_set (gnu_target_desig_type) != 0) && (!POINTER_TYPE_P (gnu_source_type) - || (TYPE_DUMMY_P (gnu_source_desig_type) - != TYPE_DUMMY_P (gnu_target_desig_type)) - || (TYPE_DUMMY_P (gnu_source_desig_type) + || (TYPE_IS_DUMMY_P (gnu_source_desig_type) + != TYPE_IS_DUMMY_P (gnu_target_desig_type)) + || (TYPE_IS_DUMMY_P (gnu_source_desig_type) && gnu_source_desig_type != gnu_target_desig_type) || !alias_sets_conflict_p (get_alias_set (gnu_source_desig_type), @@ -6820,12 +6819,12 @@ gnat_to_gnu (Node_Id gnat_node) tree gnu_target_array_type = TREE_TYPE (TREE_TYPE (TYPE_FIELDS (gnu_target_type))); - if ((TYPE_DUMMY_P (gnu_target_array_type) + if ((TYPE_IS_DUMMY_P (gnu_target_array_type) || get_alias_set (gnu_target_array_type) != 0) && (!TYPE_IS_FAT_POINTER_P (gnu_source_type) - || (TYPE_DUMMY_P (gnu_source_array_type) - != TYPE_DUMMY_P (gnu_target_array_type)) - || (TYPE_DUMMY_P (gnu_source_array_type) + || (TYPE_IS_DUMMY_P (gnu_source_array_type) + != TYPE_IS_DUMMY_P (gnu_target_array_type)) + || (TYPE_IS_DUMMY_P (gnu_source_array_type) && gnu_source_array_type != gnu_target_array_type) || !alias_sets_conflict_p (get_alias_set (gnu_source_array_type), @@ -7334,23 +7333,6 @@ gnat_gimplify_expr (tree *expr_p, gimple_seq *pre_p, return GS_ALL_DONE; } - /* Otherwise, if we are taking the address of a non-constant CONSTRUCTOR - or of a call, explicitly create the local temporary. That's required - if the type is passed by reference. */ - if (TREE_CODE (op) == CONSTRUCTOR || TREE_CODE (op) == CALL_EXPR) - { - tree mod, new_var = create_tmp_var_raw (TREE_TYPE (op), "C"); - TREE_ADDRESSABLE (new_var) = 1; - gimple_add_tmp_var (new_var); - - mod = build2 (INIT_EXPR, TREE_TYPE (new_var), new_var, op); - gimplify_and_add (mod, pre_p); - - TREE_OPERAND (expr, 0) = new_var; - recompute_tree_invariant_for_addr_expr (expr); - return GS_ALL_DONE; - } - return GS_UNHANDLED; case VIEW_CONVERT_EXPR: diff --git a/gcc/ada/gcc-interface/utils.c b/gcc/ada/gcc-interface/utils.c index ab8ca9d5561..33d11ef3fe2 100644 --- a/gcc/ada/gcc-interface/utils.c +++ b/gcc/ada/gcc-interface/utils.c @@ -291,7 +291,7 @@ make_dummy_type (Entity_Id gnat_type) /* If there is an equivalent type, get its underlying type. */ if (Present (gnat_underlying)) - gnat_underlying = Underlying_Type (gnat_underlying); + gnat_underlying = Gigi_Equivalent_Type (Underlying_Type (gnat_underlying)); /* If there was no equivalent type (can only happen when just annotating types) or underlying type, go back to the original type. */ @@ -311,8 +311,8 @@ make_dummy_type (Entity_Id gnat_type) TYPE_DUMMY_P (gnu_type) = 1; TYPE_STUB_DECL (gnu_type) = create_type_stub_decl (TYPE_NAME (gnu_type), gnu_type); - if (Is_By_Reference_Type (gnat_type)) - TREE_ADDRESSABLE (gnu_type) = 1; + if (Is_By_Reference_Type (gnat_underlying)) + TYPE_BY_REFERENCE_P (gnu_type) = 1; SET_DUMMY_NODE (gnat_underlying, gnu_type); diff --git a/gcc/ada/gcc-interface/utils2.c b/gcc/ada/gcc-interface/utils2.c index 3322341c27c..332d73062ee 100644 --- a/gcc/ada/gcc-interface/utils2.c +++ b/gcc/ada/gcc-interface/utils2.c @@ -1554,8 +1554,9 @@ build_cond_expr (tree result_type, tree condition_operand, /* If the result type is unconstrained, take the address of the operands and then dereference the result. Likewise if the result type is passed by - reference, but this is natively handled in the gimplifier. */ + reference, because creating a temporary of this type is not allowed. */ if (TREE_CODE (result_type) == UNCONSTRAINED_ARRAY_TYPE + || TYPE_IS_BY_REFERENCE_P (result_type) || CONTAINS_PLACEHOLDER_P (TYPE_SIZE (result_type))) { result_type = build_pointer_type (result_type); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index b79b023d9af..f008afc59e7 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2012-02-27 Eric Botcazou + + * gnat.dg/aggr19.adb: New test. + * gnat.dg/aggr19_pkg.ad[sb]: New helper. + 2012-02-26 Oleg Endo PR target/49263 diff --git a/gcc/testsuite/gnat.dg/aggr19.adb b/gcc/testsuite/gnat.dg/aggr19.adb new file mode 100644 index 00000000000..a88cc1fb51e --- /dev/null +++ b/gcc/testsuite/gnat.dg/aggr19.adb @@ -0,0 +1,14 @@ +-- { dg-do run } + +with Aggr19_Pkg; use Aggr19_Pkg; + +procedure Aggr19 is + C : Rec5 + := (Ent => (Kind => Two, Node => (L => (D => True, Pos => 1 )), I => 0)); + A : Rec5 := C; +begin + Proc (A); + if A /= C then + raise Program_Error; + end if; +end; diff --git a/gcc/testsuite/gnat.dg/aggr19_pkg.adb b/gcc/testsuite/gnat.dg/aggr19_pkg.adb new file mode 100644 index 00000000000..d59da8945e2 --- /dev/null +++ b/gcc/testsuite/gnat.dg/aggr19_pkg.adb @@ -0,0 +1,8 @@ +package body Aggr19_Pkg is + + procedure Proc (Pool : in out Rec5) is + begin + Pool.Ent := (Kind => Two, Node => Pool.Ent.Node, I => 0); + end; + +end ; diff --git a/gcc/testsuite/gnat.dg/aggr19_pkg.ads b/gcc/testsuite/gnat.dg/aggr19_pkg.ads new file mode 100644 index 00000000000..4f98a4d30d8 --- /dev/null +++ b/gcc/testsuite/gnat.dg/aggr19_pkg.ads @@ -0,0 +1,32 @@ +package Aggr19_Pkg is + + type Rec1 (D : Boolean := False) is record + case D is + when False => null; + when True => Pos : Integer; + end case; + end record; + + type Rec2 is record + L : Rec1; + end record; + + type Rec3 is tagged null record; + + type Enum is (One, Two, Three); + + type Rec4 (Kind : Enum := One) is record + Node : Rec2; + case Kind is + when One => R : Rec3; + when Others => I : Integer; + end case; + end record; + + type Rec5 is record + Ent : Rec4; + end record; + + procedure Proc (Pool : in out Rec5); + +end Aggr19_Pkg; -- 2.11.0