* gcc-interface/decl.c (check_ok_for_atomic): Rename into...

	(check_ok_for_atomic_type): ...this.  When checking the mode, also
	check that the type is sufficient aligned.  Remove useless code and
	tidy up implementation.
	(gnat_to_gnu_entity): Adjust to above renaming.
	(gnat_to_gnu_component_type): Likewise.
	(gnat_to_gnu_field): Likewise.

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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 890d4361e0c56ef67deac36bffa75b7de5013ada..d3ffcfd002fe852f8cf8899d2e798f17db9e469c 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,13 @@
+2014-12-22  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * gcc-interface/decl.c (check_ok_for_atomic): Rename into...
+       (check_ok_for_atomic_type): ...this.  When checking the mode, also
+       check that the type is sufficient aligned.  Remove useless code and
+       tidy up implementation.
+       (gnat_to_gnu_entity): Adjust to above renaming.
+       (gnat_to_gnu_component_type): Likewise.
+       (gnat_to_gnu_field): Likewise.
+
 2014-12-17  Pierre-Marie de Rodat  <derodat@adacore.com>
 
        * gcc-interface/misc.c (gnat_get_array_descr_info): New.  Use it for

diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c
index c133a22c777f4006cab47f1c5b4994c540fd9b8f..a50f1d30e9e949e0a6e124e4761a471e1d0b2067 100644 (file)
--- a/gcc/ada/gcc-interface/decl.c
+++ b/gcc/ada/gcc-interface/decl.c
@@ -191,7 +191,7 @@ static vec<variant_desc> build_variant_list (tree,
 static tree validate_size (Uint, tree, Entity_Id, enum tree_code, bool, bool);
 static void set_rm_size (Uint, tree, Entity_Id);
 static unsigned int validate_alignment (Uint, Entity_Id, unsigned int);
-static void check_ok_for_atomic (tree, Entity_Id, bool);
+static void check_ok_for_atomic_type (tree, Entity_Id, bool);
 static tree create_field_decl_from (tree, tree, tree, tree, tree,
                                    vec<subst_pair> );
 static tree create_rep_part (tree, tree, tree);
@@ -870,7 +870,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
                   && TYPE_MULTI_ARRAY_P (gnu_inner))
              gnu_inner = TREE_TYPE (gnu_inner);
 
-           check_ok_for_atomic (gnu_inner, gnat_entity, true);
+           check_ok_for_atomic_type (gnu_inner, gnat_entity, true);
          }
 
        /* Now check if the type of the object allows atomic access.  Note
@@ -880,7 +880,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
           always copying via an intermediate value, but it's not clear it's
           worth the effort.  */
        if (Is_Atomic (gnat_entity))
-         check_ok_for_atomic (gnu_type, gnat_entity, false);
+         check_ok_for_atomic_type (gnu_type, gnat_entity, false);
 
        /* If this is an aliased object with an unconstrained nominal subtype,
           make a type that includes the template.  */
@@ -5035,7 +5035,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
            }
 
       if (Is_Atomic (gnat_entity))
-       check_ok_for_atomic (gnu_type, gnat_entity, false);
+       check_ok_for_atomic_type (gnu_type, gnat_entity, false);
 
       /* If this is not an unconstrained array type, set some flags.  */
       if (TREE_CODE (gnu_type) != UNCONSTRAINED_ARRAY_TYPE)
@@ -5548,7 +5548,7 @@ gnat_to_gnu_component_type (Entity_Id gnat_array, bool definition,
     gnu_type = make_packable_type (gnu_type, false);
 
   if (Has_Atomic_Components (gnat_array))
-    check_ok_for_atomic (gnu_type, gnat_array, true);
+    check_ok_for_atomic_type (gnu_type, gnat_array, true);
 
   /* Get and validate any specified Component_Size.  */
   gnu_comp_size
@@ -6484,7 +6484,7 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed,
     }
 
   if (Is_Atomic (gnat_field))
-    check_ok_for_atomic (gnu_field_type, gnat_field, false);
+    check_ok_for_atomic_type (gnu_field_type, gnat_field, false);
 
   if (Present (Component_Clause (gnat_field)))
     {
@@ -8088,78 +8088,63 @@ validate_alignment (Uint alignment, Entity_Id gnat_entity, unsigned int align)
   return align;
 }
 \f
-/* Verify that OBJECT, a type or decl, is something we can implement
-   atomically.  If not, give an error for GNAT_ENTITY.  COMP_P is true
-   if we require atomic components.  */
+/* Verify that TYPE is something we can implement atomically.  If not, issue
+   an error for GNAT_ENTITY.  COMPONENT_P is true if we are being called to
+   process a component type.  */
 
 static void
-check_ok_for_atomic (tree object, Entity_Id gnat_entity, bool comp_p)
+check_ok_for_atomic_type (tree type, Entity_Id gnat_entity, bool component_p)
 {
   Node_Id gnat_error_point = gnat_entity;
   Node_Id gnat_node;
   machine_mode mode;
+  enum mode_class mclass;
   unsigned int align;
   tree size;
 
-  /* There are three case of what OBJECT can be.  It can be a type, in which
-     case we take the size, alignment and mode from the type.  It can be a
-     declaration that was indirect, in which case the relevant values are
-     that of the type being pointed to, or it can be a normal declaration,
-     in which case the values are of the decl.  The code below assumes that
-     OBJECT is either a type or a decl.  */
-  if (TYPE_P (object))
-    {
-      /* If this is an anonymous base type, nothing to check.  Error will be
-        reported on the source type.  */
-      if (!Comes_From_Source (gnat_entity))
-       return;
-
-      mode = TYPE_MODE (object);
-      align = TYPE_ALIGN (object);
-      size = TYPE_SIZE (object);
-    }
-  else if (DECL_BY_REF_P (object))
-    {
-      mode = TYPE_MODE (TREE_TYPE (TREE_TYPE (object)));
-      align = TYPE_ALIGN (TREE_TYPE (TREE_TYPE (object)));
-      size = TYPE_SIZE (TREE_TYPE (TREE_TYPE (object)));
-    }
-  else
-    {
-      mode = DECL_MODE (object);
-      align = DECL_ALIGN (object);
-      size = DECL_SIZE (object);
-    }
+  /* If this is an anonymous base type, nothing to check, the error will be
+     reported on the source type if need be.  */
+  if (!Comes_From_Source (gnat_entity))
+    return;
 
-  /* Consider all floating-point types atomic and any types that that are
-     represented by integers no wider than a machine word.  */
-  if (GET_MODE_CLASS (mode) == MODE_FLOAT
-      || ((GET_MODE_CLASS (mode) == MODE_INT
-          || GET_MODE_CLASS (mode) == MODE_PARTIAL_INT)
-         && GET_MODE_BITSIZE (mode) <= BITS_PER_WORD))
+  mode = TYPE_MODE (type);
+  mclass = GET_MODE_CLASS (mode);
+  align = TYPE_ALIGN (type);
+  size = TYPE_SIZE (type);
+
+  /* Consider all aligned floating-point types atomic and any aligned types
+     that are represented by integers no wider than a machine word.  */
+  if ((mclass == MODE_FLOAT
+       || ((mclass == MODE_INT || mclass == MODE_PARTIAL_INT)
+          && GET_MODE_BITSIZE (mode) <= BITS_PER_WORD))
+      && align >= GET_MODE_ALIGNMENT (mode))
     return;
 
-  /* For the moment, also allow anything that has an alignment equal
-     to its size and which is smaller than a word.  */
-  if (size && TREE_CODE (size) == INTEGER_CST
+  /* For the moment, also allow anything that has an alignment equal to its
+     size and which is smaller than a word.  */
+  if (size
+      && TREE_CODE (size) == INTEGER_CST
       && compare_tree_int (size, align) == 0
       && align <= BITS_PER_WORD)
     return;
 
-  for (gnat_node = First_Rep_Item (gnat_entity); Present (gnat_node);
+  for (gnat_node = First_Rep_Item (gnat_entity);
+       Present (gnat_node);
        gnat_node = Next_Rep_Item (gnat_node))
-    {
-      if (!comp_p && Nkind (gnat_node) == N_Pragma
-         && (Get_Pragma_Id (Chars (Pragma_Identifier (gnat_node)))
-              == Pragma_Atomic))
-       gnat_error_point = First (Pragma_Argument_Associations (gnat_node));
-      else if (comp_p && Nkind (gnat_node) == N_Pragma
-              && (Get_Pragma_Id (Chars (Pragma_Identifier (gnat_node)))
-                  == Pragma_Atomic_Components))
-       gnat_error_point = First (Pragma_Argument_Associations (gnat_node));
-    }
+    if (Nkind (gnat_node) == N_Pragma)
+      {
+       unsigned char pragma_id
+         = Get_Pragma_Id (Chars (Pragma_Identifier (gnat_node)));
+
+       if ((pragma_id == Pragma_Atomic && !component_p)
+           || (pragma_id == Pragma_Atomic_Components && component_p))
+         {
+           gnat_error_point = First (Pragma_Argument_Associations (gnat_node));
+           break;
+         }
+      }
 
-  if (comp_p)
+  if (component_p)
     post_error_ne ("atomic access to component of & cannot be guaranteed",
                   gnat_error_point, gnat_entity);
   else

diff --git a/gcc/ada/gcc-interface/misc.c b/gcc/ada/gcc-interface/misc.c
index 2ab3f9201c7912190bc51f9ef9e3d415a96927be..14c58da4c0299c37488984cca7b1a05030282f35 100644 (file)
--- a/gcc/ada/gcc-interface/misc.c
+++ b/gcc/ada/gcc-interface/misc.c
@@ -662,7 +662,7 @@ gnat_get_array_descr_info (const_tree type, struct array_descr_info *info)
   info->ndimensions = i;
   convention_fortran_p = TYPE_CONVENTION_FORTRAN_P (type);
 
-  /* TODO??? For row major ordering, we probably want to emit nothing and
+  /* TODO: For row major ordering, we probably want to emit nothing and
      instead specify it as the default in Dw_TAG_compile_unit.  */
   info->ordering = (convention_fortran_p
                    ? array_descr_ordering_column_major

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index dd103bb8fac858e9a20d679c4c62f31c2319bf1e..f69fb33368dedc2bd1064f9193bcb40b4573a174 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2014-12-22  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * gnat.dg/specs/atomic2.ads: New test.
+
 2014-12-21  Oleg Endo  <olegendo@gcc.gnu.org>
 
        PR target/17280

diff --git a/gcc/testsuite/gnat.dg/specs/atomic2.ads b/gcc/testsuite/gnat.dg/specs/atomic2.ads
new file mode 100644 (file)
index 0000000..b332884
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/specs/atomic2.ads
@@ -0,0 +1,26 @@
+-- { dg-do compile }
+
+package Atomic2 is
+
+  type Rec1 is record
+    C : Character;
+    I : Integer;
+    pragma Atomic (I);
+  end record;
+  for Rec1 use record
+    C at 0 range 0 .. 7;
+    I at 1 range 0 .. 31; -- { dg-error "position of atomic field" }
+  end record;
+
+  type Rec2 is record
+    C : Character;
+    I : Integer;
+    pragma Atomic (I);
+  end record;
+  pragma Pack (Rec2);
+
+  type My_Int is new Integer;
+  for My_Int'Alignment use 1;
+  pragma Atomic (My_Int); -- { dg-error "atomic access" }
+
+end Atomic2;