diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/ada/ChangeLog | 16 | ||||
| -rw-r--r-- | gcc/ada/gcc-interface/ada-tree.h | 5 | ||||
| -rw-r--r-- | gcc/ada/gcc-interface/decl.c | 107 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 4 | ||||
| -rw-r--r-- | gcc/testsuite/gnat.dg/discr33.adb | 31 |
5 files changed, 140 insertions, 23 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 82ec65b..433fff4 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,21 @@ 2012-01-27 Eric Botcazou <ebotcazou@adacore.com> + * gcc-interface/ada-tree.h (DECL_ALIASED_P): New flag. + * gcc-interface/decl.c (is_variable_size): Rename to... + (type_has_variable_size): ...this. + (adjust_packed): Adjust to above renaming. + (gnat_to_gnu_field): Set DECL_ALIASED_P on the field. + (field_is_artificial): New predicate. + (field_is_aliased): Likewise. + (field_has_self_size): Likewise. + (field_has_variable_size): Likewise. + (components_to_record): Record information for the final layout during + the first pass on fields. + If there is an aliased field placed after a field whose length depends + on discriminants, put all the fields of the latter sort, last. + +2012-01-27 Eric Botcazou <ebotcazou@adacore.com> + * gcc-interface/gigi.h (get_minimal_subprog_decl): Declare. * gcc-interface/decl.c (get_minimal_subprog_decl): New function. * gcc-interface/trans.c (Attribute_to_gnu): Use it for the prefix of an diff --git a/gcc/ada/gcc-interface/ada-tree.h b/gcc/ada/gcc-interface/ada-tree.h index c408de3..0c32f21 100644 --- a/gcc/ada/gcc-interface/ada-tree.h +++ b/gcc/ada/gcc-interface/ada-tree.h @@ -6,7 +6,7 @@ * * * C Header 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- * @@ -344,6 +344,9 @@ do { \ pair of INDIRECT_REFs is needed to access the object. */ #define DECL_BY_DOUBLE_REF_P(NODE) DECL_LANG_FLAG_0 (PARM_DECL_CHECK (NODE)) +/* Nonzero in a FIELD_DECL if it is declared as aliased. */ +#define DECL_ALIASED_P(NODE) DECL_LANG_FLAG_0 (FIELD_DECL_CHECK (NODE)) + /* Nonzero in a TYPE_DECL if this is the declaration of a Taft amendment type in the main unit, i.e. the full declaration is available. */ #define DECL_TAFT_TYPE_P(NODE) DECL_LANG_FLAG_0 (TYPE_DECL_CHECK (NODE)) diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index b0bf586..bc0804a 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -145,7 +145,7 @@ static void prepend_one_attribute_to (struct attrib **, enum attr_type, tree, tree, Node_Id); static void prepend_attributes (Entity_Id, struct attrib **); static tree elaborate_expression (Node_Id, Entity_Id, tree, bool, bool, bool); -static bool is_variable_size (tree); +static bool type_has_variable_size (tree); static tree elaborate_expression_1 (tree, Entity_Id, tree, bool, bool); static tree elaborate_expression_2 (tree, Entity_Id, tree, bool, bool, unsigned int); @@ -6848,7 +6848,7 @@ adjust_packed (tree field_type, tree record_type, int packed) because we cannot create temporaries of non-fixed size in case we need to take the address of the field. See addressable_p and the notes on the addressability issues for further details. */ - if (is_variable_size (field_type)) + if (type_has_variable_size (field_type)) return 0; /* If the alignment of the record is specified and the field type @@ -7123,6 +7123,7 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed, = create_field_decl (gnu_field_id, gnu_field_type, gnu_record_type, gnu_size, gnu_pos, packed, Is_Aliased (gnat_field)); Sloc_to_locus (Sloc (gnat_field), &DECL_SOURCE_LOCATION (gnu_field)); + DECL_ALIASED_P (gnu_field) = Is_Aliased (gnat_field); TREE_THIS_VOLATILE (gnu_field) = TREE_SIDE_EFFECTS (gnu_field) = is_volatile; if (Ekind (gnat_field) == E_Discriminant) @@ -7136,7 +7137,7 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed, field of variable size or is a record that has a field such a field. */ static bool -is_variable_size (tree type) +type_has_variable_size (tree type) { tree field; @@ -7151,12 +7152,68 @@ is_variable_size (tree type) return false; for (field = TYPE_FIELDS (type); field; field = DECL_CHAIN (field)) - if (is_variable_size (TREE_TYPE (field))) + if (type_has_variable_size (TREE_TYPE (field))) return true; return false; } +/* Return true if FIELD is an artificial field. */ + +static bool +field_is_artificial (tree field) +{ + /* These fields are generated by the front-end proper. */ + if (IDENTIFIER_POINTER (DECL_NAME (field)) [0] == '_') + return true; + + /* These fields are generated by gigi. */ + if (DECL_INTERNAL_P (field)) + return true; + + return false; +} + +/* Return true if FIELD is a non-artificial aliased field. */ + +static bool +field_is_aliased (tree field) +{ + if (field_is_artificial (field)) + return false; + + return DECL_ALIASED_P (field); +} + +/* Return true if FIELD is a non-artificial field with self-referential + size. */ + +static bool +field_has_self_size (tree field) +{ + if (field_is_artificial (field)) + return false; + + if (DECL_SIZE (field) && TREE_CODE (DECL_SIZE (field)) == INTEGER_CST) + return false; + + return CONTAINS_PLACEHOLDER_P (TYPE_SIZE (TREE_TYPE (field))); +} + +/* Return true if FIELD is a non-artificial field with variable size. */ + +static bool +field_has_variable_size (tree field) +{ + if (field_is_artificial (field)) + return false; + + if (DECL_SIZE (field) && TREE_CODE (DECL_SIZE (field)) == INTEGER_CST) + return false; + + return TREE_CODE (TYPE_SIZE (TREE_TYPE (field))) != INTEGER_CST; +} + /* qsort comparer for the bit positions of two record components. */ static int @@ -7219,6 +7276,8 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list, { bool all_rep_and_size = all_rep && TYPE_SIZE (gnu_record_type); bool layout_with_rep = false; + bool has_self_field = false; + bool has_aliased_after_self_field = false; Node_Id component_decl, variant_part; tree gnu_field, gnu_next, gnu_last; tree gnu_rep_part = NULL_TREE; @@ -7270,6 +7329,12 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list, gnu_field_list = gnu_field; if (!gnu_last) gnu_last = gnu_field; + + /* And record information for the final layout. */ + if (field_has_self_size (gnu_field)) + has_self_field = true; + else if (has_self_field && field_is_aliased (gnu_field)) + has_aliased_after_self_field = true; } } @@ -7505,25 +7570,17 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list, continue; } - /* Reorder non-internal fields with non-fixed size. */ - if (reorder - && !DECL_INTERNAL_P (gnu_field) - && !(DECL_SIZE (gnu_field) - && TREE_CODE (DECL_SIZE (gnu_field)) == INTEGER_CST)) + if ((reorder || has_aliased_after_self_field) + && field_has_self_size (gnu_field)) { - tree type_size = TYPE_SIZE (TREE_TYPE (gnu_field)); - - if (CONTAINS_PLACEHOLDER_P (type_size)) - { - MOVE_FROM_FIELD_LIST_TO (gnu_self_list); - continue; - } + MOVE_FROM_FIELD_LIST_TO (gnu_self_list); + continue; + } - if (TREE_CODE (type_size) != INTEGER_CST) - { - MOVE_FROM_FIELD_LIST_TO (gnu_var_list); - continue; - } + if (reorder && field_has_variable_size (gnu_field)) + { + MOVE_FROM_FIELD_LIST_TO (gnu_var_list); + continue; } gnu_last = gnu_field; @@ -7531,7 +7588,7 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list, #undef MOVE_FROM_FIELD_LIST_TO - /* If permitted, we reorder the components as follows: + /* If permitted, we reorder the fields as follows: 1) all fixed length fields, 2) all fields whose length doesn't depend on discriminants, @@ -7544,6 +7601,12 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list, = chainon (nreverse (gnu_self_list), chainon (nreverse (gnu_var_list), gnu_field_list)); + /* Otherwise, if there is an aliased field placed after a field whose length + depends on discriminants, we put all the fields of the latter sort, last. + We need to do this in case an object of this record type is mutable. */ + else if (has_aliased_after_self_field) + gnu_field_list = chainon (nreverse (gnu_self_list), gnu_field_list); + /* If P_REP_LIST is nonzero, this means that we are asked to move the fields in our REP list to the previous level because this level needs them in order to do a correct layout, i.e. avoid having overlapping fields. */ diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 7d4a199..66a5eed 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,5 +1,9 @@ 2012-01-27 Eric Botcazou <ebotcazou@adacore.com> + * gnat.dg/discr33.adb: New test. + +2012-01-27 Eric Botcazou <ebotcazou@adacore.com> + * gnat.dg/limited_with3.ad[sb): New test. * gnat.dg/limited_with3_pkg1.ad[sb]: New helper. * gnat.dg/limited_with3_pkg2.ads: Likewise. diff --git a/gcc/testsuite/gnat.dg/discr33.adb b/gcc/testsuite/gnat.dg/discr33.adb new file mode 100644 index 0000000..e667e7f --- /dev/null +++ b/gcc/testsuite/gnat.dg/discr33.adb @@ -0,0 +1,31 @@ +-- { dg-do run } + +procedure Discr33 is + + subtype Int is Integer range 1..100; + + type T (D : Int := 1) is + record + A : Integer; + B : String (1..D); + C : aliased Integer; + end record; + + Var : T := (D => 1, A => 1234, B => "x", C => 4567); + + type Int_Ref is access all Integer; + Pointer_To_C : Int_Ref := Var.C'Access; + +begin + + if Pointer_To_C.all /= 4567 then + raise Program_Error; + end if; + + Var := (D => 26, A => 1234, B => "abcdefghijklmnopqrstuvwxyz", C => 2345); + + if Pointer_To_C.all /= 2345 then + raise Program_Error; + end if; + +end Discr33; |