OSDN Git Service

* gcc-interface/ada-tree.h (DECL_ALIASED_P): New flag.
authorebotcazou <ebotcazou@138bc75d-0d04-0410-961f-82ee72b054a4>
Fri, 27 Jan 2012 09:35:03 +0000 (09:35 +0000)
committerebotcazou <ebotcazou@138bc75d-0d04-0410-961f-82ee72b054a4>
Fri, 27 Jan 2012 09:35:03 +0000 (09:35 +0000)
* 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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@183609 138bc75d-0d04-0410-961f-82ee72b054a4

gcc/ada/ChangeLog
gcc/ada/gcc-interface/ada-tree.h
gcc/ada/gcc-interface/decl.c
gcc/testsuite/ChangeLog
gcc/testsuite/gnat.dg/discr33.adb [new file with mode: 0644]

index 82ec65b..433fff4 100644 (file)
@@ -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
index c408de3..0c32f21 100644 (file)
@@ -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))
index b0bf586..bc0804a 100644 (file)
@@ -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;
 }
 \f
+/* 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.  */
index 7d4a199..66a5eed 100644 (file)
@@ -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 (file)
index 0000000..e667e7f
--- /dev/null
@@ -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;