implementation_defined_pragmas.rst (Machine_Attribute): Document additional optional...
authorEric Botcazou <ebotcazou@adacore.com>
Tue, 28 May 2019 08:47:33 +0000 (08:47 +0000)
committerEric Botcazou <ebotcazou@gcc.gnu.org>
Tue, 28 May 2019 08:47:33 +0000 (08:47 +0000)
* doc/gnat_rm/implementation_defined_pragmas.rst (Machine_Attribute):
Document additional optional parameters.
* sem_prag.adb (Analyze_Pragma) <Pragma_Machine_Attribute>: Accept
more than one optional parameter.
* gcc-interface/decl.c (prepend_one_attribute_pragma): Alphabetize
the list of supported pragmas.  Simplify the handling of parameters
and add support for more than one optional parameter.
* gcc-interface/utils.c (attr_cold_hot_exclusions): New constant.
(gnat_internal_attribute_table): Add entry for no_icf, noipa, flatten,
used, cold, hot, target and target_clones.
(begin_subprog_body): Do not create the RTL for the subprogram here.
(handle_noicf_attribute): New static function.
(handle_noipa_attribute): Likewise.
(handle_flatten_attribute): Likewise.
(handle_used_attribute): Likewise.
(handle_cold_attribute): Likewise.
(handle_hot_attribute): Likewise.
(handle_target_attribute): Likewise.
(handle_target_clones_attribute): Likewise.

From-SVN: r271693

gcc/ada/ChangeLog
gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst
gcc/ada/gcc-interface/decl.c
gcc/ada/gcc-interface/utils.c
gcc/ada/sem_prag.adb
gcc/testsuite/ChangeLog
gcc/testsuite/gnat.dg/machine_attr1.adb [new file with mode: 0644]
gcc/testsuite/gnat.dg/machine_attr1.ads [new file with mode: 0644]

index 3b4d5a332d6163d7f30a89ab982d11febfcac542..e0f3d0ab88300174fc0d4ae059ad01cfd4cc5818 100644 (file)
@@ -1,3 +1,25 @@
+2019-05-28  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * doc/gnat_rm/implementation_defined_pragmas.rst (Machine_Attribute):
+       Document additional optional parameters.
+       * sem_prag.adb (Analyze_Pragma) <Pragma_Machine_Attribute>: Accept
+       more than one optional parameter.
+       * gcc-interface/decl.c (prepend_one_attribute_pragma): Alphabetize
+       the list of supported pragmas.  Simplify the handling of parameters
+       and add support for more than one optional parameter.
+       * gcc-interface/utils.c (attr_cold_hot_exclusions): New constant.
+       (gnat_internal_attribute_table): Add entry for no_icf, noipa, flatten,
+       used, cold, hot, target and target_clones.
+       (begin_subprog_body): Do not create the RTL for the subprogram here.
+       (handle_noicf_attribute): New static function.
+       (handle_noipa_attribute): Likewise.
+       (handle_flatten_attribute): Likewise.
+       (handle_used_attribute): Likewise.
+       (handle_cold_attribute): Likewise.
+       (handle_hot_attribute): Likewise.
+       (handle_target_attribute): Likewise.
+       (handle_target_clones_attribute): Likewise.
+
 2019-05-28  Eric Botcazou  <ebotcazou@adacore.com>
 
        * gcc-interface/trans.c (lvalue_required_for_attribute_p): Return 0
index 6074cd428196a648ce8dfbbc0fa37a6fd3c496f5..955a1376cab2175f819d6627b6fcd73bb0e754f2 100644 (file)
@@ -3766,18 +3766,19 @@ Syntax:
   pragma Machine_Attribute (
        [Entity         =>] LOCAL_NAME,
        [Attribute_Name =>] static_string_EXPRESSION
-    [, [Info           =>] static_EXPRESSION] );
+    [, [Info           =>] static_EXPRESSION {, static_EXPRESSION}] );
 
 
 Machine-dependent attributes can be specified for types and/or
 declarations.  This pragma is semantically equivalent to
 :samp:`__attribute__(({attribute_name}))` (if ``info`` is not
 specified) or :samp:`__attribute__(({attribute_name(info})))`
-in GNU C, where *attribute_name* is recognized by the
-compiler middle-end or the ``TARGET_ATTRIBUTE_TABLE`` machine
-specific macro.  A string literal for the optional parameter ``info``
-is transformed into an identifier, which may make this pragma unusable
-for some attributes.
+or :samp:`__attribute__(({attribute_name(info,...})))` in GNU C,
+where *attribute_name* is recognized by the compiler middle-end
+or the ``TARGET_ATTRIBUTE_TABLE`` machine specific macro.  Note
+that a string literal for the optional parameter ``info`` or the
+following ones is transformed by default into an identifier,
+which may make this pragma unusable for some attributes.
 For further information see :title:`GNU Compiler Collection (GCC) Internals`.
 
 Pragma Main
index da8fbe69e23770d8362be1316039ac0220d70146..4dfd76bfbcf9b5931e31372fcd55fff331a90d06 100644 (file)
@@ -6458,25 +6458,18 @@ prepend_one_attribute (struct attrib **attr_list,
 static void
 prepend_one_attribute_pragma (struct attrib **attr_list, Node_Id gnat_pragma)
 {
-  const Node_Id gnat_arg = Pragma_Argument_Associations (gnat_pragma);
-  tree gnu_arg0 = NULL_TREE, gnu_arg1 = NULL_TREE;
+  const Node_Id gnat_arg = First (Pragma_Argument_Associations (gnat_pragma));
+  Node_Id gnat_next_arg = Next (gnat_arg);
+  tree gnu_arg1 = NULL_TREE, gnu_arg_list = NULL_TREE;
   enum attrib_type etype;
 
   /* Map the pragma at hand.  Skip if this isn't one we know how to handle.  */
   switch (Get_Pragma_Id (Chars (Pragma_Identifier (gnat_pragma))))
     {
-    case Pragma_Machine_Attribute:
-      etype = ATTR_MACHINE_ATTRIBUTE;
-      break;
-
     case Pragma_Linker_Alias:
       etype = ATTR_LINK_ALIAS;
       break;
 
-    case Pragma_Linker_Section:
-      etype = ATTR_LINK_SECTION;
-      break;
-
     case Pragma_Linker_Constructor:
       etype = ATTR_LINK_CONSTRUCTOR;
       break;
@@ -6485,58 +6478,58 @@ prepend_one_attribute_pragma (struct attrib **attr_list, Node_Id gnat_pragma)
       etype = ATTR_LINK_DESTRUCTOR;
       break;
 
-    case Pragma_Weak_External:
-      etype = ATTR_WEAK_EXTERNAL;
+    case Pragma_Linker_Section:
+      etype = ATTR_LINK_SECTION;
+      break;
+
+    case Pragma_Machine_Attribute:
+      etype = ATTR_MACHINE_ATTRIBUTE;
       break;
 
     case Pragma_Thread_Local_Storage:
       etype = ATTR_THREAD_LOCAL_STORAGE;
       break;
 
+    case Pragma_Weak_External:
+      etype = ATTR_WEAK_EXTERNAL;
+      break;
+
     default:
       return;
     }
 
   /* See what arguments we have and turn them into GCC trees for attribute
-     handlers.  These expect identifier for strings.  We handle at most two
-     arguments and static expressions only.  */
-  if (Present (gnat_arg) && Present (First (gnat_arg)))
+     handlers.  The first one is always expected to be a string meant to be
+     turned into an identifier.  The next ones are all static expressions,
+     among which strings meant to be turned into an identifier, except for
+     a couple of specific attributes that require raw strings.  */
+  if (Present (gnat_next_arg))
     {
-      Node_Id gnat_arg0 = Next (First (gnat_arg));
-      Node_Id gnat_arg1 = Empty;
-
-      if (Present (gnat_arg0)
-         && Is_OK_Static_Expression (Expression (gnat_arg0)))
-       {
-         gnu_arg0 = gnat_to_gnu (Expression (gnat_arg0));
-
-         if (TREE_CODE (gnu_arg0) == STRING_CST)
-           {
-             gnu_arg0 = get_identifier (TREE_STRING_POINTER (gnu_arg0));
-             if (IDENTIFIER_LENGTH (gnu_arg0) == 0)
-               return;
-           }
-
-         gnat_arg1 = Next (gnat_arg0);
-       }
-
-      if (Present (gnat_arg1)
-         && Is_OK_Static_Expression (Expression (gnat_arg1)))
+      gnu_arg1 = gnat_to_gnu (Expression (gnat_next_arg));
+      gcc_assert (TREE_CODE (gnu_arg1) == STRING_CST);
+
+      const char *const p = TREE_STRING_POINTER (gnu_arg1);
+      const bool string_args
+       = strcmp (p, "target") == 0 || strcmp (p, "target_clones") == 0;
+      gnu_arg1 = get_identifier (p);
+      if (IDENTIFIER_LENGTH (gnu_arg1) == 0)
+       return;
+      gnat_next_arg = Next (gnat_next_arg);
+
+      while (Present (gnat_next_arg))
        {
-         gnu_arg1 = gnat_to_gnu (Expression (gnat_arg1));
-
-         if (TREE_CODE (gnu_arg1) == STRING_CST)
-          gnu_arg1 = get_identifier (TREE_STRING_POINTER (gnu_arg1));
+         tree gnu_arg = gnat_to_gnu (Expression (gnat_next_arg));
+         if (TREE_CODE (gnu_arg) == STRING_CST && !string_args)
+           gnu_arg = get_identifier (TREE_STRING_POINTER (gnu_arg));
+         gnu_arg_list
+           = chainon (gnu_arg_list, build_tree_list (NULL_TREE, gnu_arg));
+         gnat_next_arg = Next (gnat_next_arg);
        }
     }
 
-  /* Prepend to the list.  Make a list of the argument we might have, as GCC
-     expects it.  */
-  prepend_one_attribute (attr_list, etype, gnu_arg0,
-                        gnu_arg1
-                        ? build_tree_list (NULL_TREE, gnu_arg1) : NULL_TREE,
-                        Present (Next (First (gnat_arg)))
-                        ? Expression (Next (First (gnat_arg))) : gnat_pragma);
+  prepend_one_attribute (attr_list, etype, gnu_arg1, gnu_arg_list,
+                        Present (Next (gnat_arg))
+                        ? Expression (Next (gnat_arg)) : gnat_pragma);
 }
 
 /* Prepend to ATTR_LIST the list of attributes for GNAT_ENTITY, if any.  */
index dbf7c1825060665af9cd0003f85ccba5e3457d21..a74a2e2dceba2fd508ecd0dc6ff0e5e42e448cc6 100644 (file)
@@ -93,13 +93,28 @@ static tree handle_noreturn_attribute (tree *, tree, tree, int, bool *);
 static tree handle_stack_protect_attribute (tree *, tree, tree, int, bool *);
 static tree handle_noinline_attribute (tree *, tree, tree, int, bool *);
 static tree handle_noclone_attribute (tree *, tree, tree, int, bool *);
+static tree handle_noicf_attribute (tree *, tree, tree, int, bool *);
+static tree handle_noipa_attribute (tree *, tree, tree, int, bool *);
 static tree handle_leaf_attribute (tree *, tree, tree, int, bool *);
 static tree handle_always_inline_attribute (tree *, tree, tree, int, bool *);
 static tree handle_malloc_attribute (tree *, tree, tree, int, bool *);
 static tree handle_type_generic_attribute (tree *, tree, tree, int, bool *);
+static tree handle_flatten_attribute (tree *, tree, tree, int, bool *);
+static tree handle_used_attribute (tree *, tree, tree, int, bool *);
+static tree handle_cold_attribute (tree *, tree, tree, int, bool *);
+static tree handle_hot_attribute (tree *, tree, tree, int, bool *);
+static tree handle_target_attribute (tree *, tree, tree, int, bool *);
+static tree handle_target_clones_attribute (tree *, tree, tree, int, bool *);
 static tree handle_vector_size_attribute (tree *, tree, tree, int, bool *);
 static tree handle_vector_type_attribute (tree *, tree, tree, int, bool *);
 
+static const struct attribute_spec::exclusions attr_cold_hot_exclusions[] =
+{
+  { "cold", true,  true,  true  },
+  { "hot" , true,  true,  true  },
+  { NULL  , false, false, false }
+};
+
 /* Fake handler for attributes we don't properly support, typically because
    they'd require dragging a lot of the common-c front-end circuitry.  */
 static tree fake_attribute_handler (tree *, tree, tree, int, bool *);
@@ -130,30 +145,49 @@ const struct attribute_spec gnat_internal_attribute_table[] =
     handle_noinline_attribute, NULL },
   { "noclone",      0, 0,  true,  false, false, false,
     handle_noclone_attribute, NULL },
+  { "no_icf",       0, 0,  true,  false, false, false,
+    handle_noicf_attribute, NULL },
+  { "noipa",        0, 0,  true,  false, false, false,
+    handle_noipa_attribute, NULL },
   { "leaf",         0, 0,  true,  false, false, false,
     handle_leaf_attribute, NULL },
   { "always_inline",0, 0,  true,  false, false, false,
     handle_always_inline_attribute, NULL },
   { "malloc",       0, 0,  true,  false, false, false,
     handle_malloc_attribute, NULL },
-  { "type generic", 0, 0,  false, true, true, false,
+  { "type generic", 0, 0,  false, true,  true,  false,
     handle_type_generic_attribute, NULL },
 
-  { "vector_size",  1, 1,  false, true, false,  false,
+  { "flatten",      0, 0,  true,  false, false, false,
+    handle_flatten_attribute, NULL },
+  { "used",         0, 0,  true,  false, false, false,
+    handle_used_attribute, NULL },
+  { "cold",         0, 0,  true,  false, false, false,
+    handle_cold_attribute, attr_cold_hot_exclusions },
+  { "hot",          0, 0,  true,  false, false, false,
+    handle_hot_attribute, attr_cold_hot_exclusions },
+  { "target",       1, -1, true,  false, false, false,
+    handle_target_attribute, NULL },
+  { "target_clones",1, -1, true,  false, false, false,
+    handle_target_clones_attribute, NULL },
+
+  { "vector_size",  1, 1,  false, true,  false, false,
     handle_vector_size_attribute, NULL },
-  { "vector_type",  0, 0,  false, true, false,  false,
+  { "vector_type",  0, 0,  false, true,  false, false,
     handle_vector_type_attribute, NULL },
-  { "may_alias",    0, 0, false, true, false, false, NULL, NULL },
+  { "may_alias",    0, 0,  false, true,  false, false,
+    NULL, NULL },
 
   /* ??? format and format_arg are heavy and not supported, which actually
      prevents support for stdio builtins, which we however declare as part
      of the common builtins.def contents.  */
-  { "format",     3, 3,  false, true,  true,  false, fake_attribute_handler,
-    NULL },
-  { "format_arg", 1, 1,  false, true,  true,  false, fake_attribute_handler,
-    NULL },
+  { "format",       3, 3,  false, true,  true,  false,
+    fake_attribute_handler, NULL },
+  { "format_arg",   1, 1,  false, true,  true,  false,
+    fake_attribute_handler, NULL },
 
-  { NULL,         0, 0, false, false, false, false, NULL, NULL }
+  { NULL,           0, 0,  false, false, false, false,
+    NULL, NULL }
 };
 
 /* Associates a GNAT tree node to a GCC tree node. It is used in
@@ -3397,8 +3431,6 @@ begin_subprog_body (tree subprog_decl)
   for (param_decl = DECL_ARGUMENTS (subprog_decl); param_decl;
        param_decl = DECL_CHAIN (param_decl))
     DECL_CONTEXT (param_decl) = subprog_decl;
-
-  make_decl_rtl (subprog_decl);
 }
 
 /* Finish translating the current subprogram and set its BODY.  */
@@ -6393,6 +6425,38 @@ handle_noclone_attribute (tree *node, tree name,
   return NULL_TREE;
 }
 
+/* Handle a "no_icf" attribute; arguments as in
+   struct attribute_spec.handler.  */
+
+static tree
+handle_noicf_attribute (tree *node, tree name,
+                       tree ARG_UNUSED (args),
+                       int ARG_UNUSED (flags), bool *no_add_attrs)
+{
+  if (TREE_CODE (*node) != FUNCTION_DECL)
+    {
+      warning (OPT_Wattributes, "%qE attribute ignored", name);
+      *no_add_attrs = true;
+    }
+
+  return NULL_TREE;
+}
+
+/* Handle a "noipa" attribute; arguments as in
+   struct attribute_spec.handler.  */
+
+static tree
+handle_noipa_attribute (tree *node, tree name, tree, int, bool *no_add_attrs)
+{
+  if (TREE_CODE (*node) != FUNCTION_DECL)
+    {
+      warning (OPT_Wattributes, "%qE attribute ignored", name);
+      *no_add_attrs = true;
+    }
+
+  return NULL_TREE;
+}
+
 /* Handle a "leaf" attribute; arguments as in
    struct attribute_spec.handler.  */
 
@@ -6483,6 +6547,166 @@ handle_type_generic_attribute (tree *node, tree ARG_UNUSED (name),
   return NULL_TREE;
 }
 
+/* Handle a "flatten" attribute; arguments as in
+   struct attribute_spec.handler.  */
+
+static tree
+handle_flatten_attribute (tree *node, tree name,
+                         tree args ATTRIBUTE_UNUSED,
+                         int flags ATTRIBUTE_UNUSED, bool *no_add_attrs)
+{
+  if (TREE_CODE (*node) == FUNCTION_DECL)
+    /* Do nothing else, just set the attribute.  We'll get at
+       it later with lookup_attribute.  */
+    ;
+  else
+    {
+      warning (OPT_Wattributes, "%qE attribute ignored", name);
+      *no_add_attrs = true;
+    }
+
+  return NULL_TREE;
+}
+
+/* Handle a "used" attribute; arguments as in
+   struct attribute_spec.handler.  */
+
+static tree
+handle_used_attribute (tree *pnode, tree name, tree ARG_UNUSED (args),
+                      int ARG_UNUSED (flags), bool *no_add_attrs)
+{
+  tree node = *pnode;
+
+  if (TREE_CODE (node) == FUNCTION_DECL
+      || (VAR_P (node) && TREE_STATIC (node))
+      || (TREE_CODE (node) == TYPE_DECL))
+    {
+      TREE_USED (node) = 1;
+      DECL_PRESERVE_P (node) = 1;
+      if (VAR_P (node))
+       DECL_READ_P (node) = 1;
+    }
+  else
+    {
+      warning (OPT_Wattributes, "%qE attribute ignored", name);
+      *no_add_attrs = true;
+    }
+
+  return NULL_TREE;
+}
+
+/* Handle a "cold" and attribute; arguments as in
+   struct attribute_spec.handler.  */
+
+static tree
+handle_cold_attribute (tree *node, tree name, tree ARG_UNUSED (args),
+                      int ARG_UNUSED (flags), bool *no_add_attrs)
+{
+  if (TREE_CODE (*node) == FUNCTION_DECL
+      || TREE_CODE (*node) == LABEL_DECL)
+    {
+      /* Attribute cold processing is done later with lookup_attribute.  */
+    }
+  else
+    {
+      warning (OPT_Wattributes, "%qE attribute ignored", name);
+      *no_add_attrs = true;
+    }
+
+  return NULL_TREE;
+}
+
+/* Handle a "hot" and attribute; arguments as in
+   struct attribute_spec.handler.  */
+
+static tree
+handle_hot_attribute (tree *node, tree name, tree ARG_UNUSED (args),
+                     int ARG_UNUSED (flags), bool *no_add_attrs)
+{
+  if (TREE_CODE (*node) == FUNCTION_DECL
+      || TREE_CODE (*node) == LABEL_DECL)
+    {
+      /* Attribute hot processing is done later with lookup_attribute.  */
+    }
+  else
+    {
+      warning (OPT_Wattributes, "%qE attribute ignored", name);
+      *no_add_attrs = true;
+    }
+
+  return NULL_TREE;
+}
+
+/* Handle a "target" attribute.  */
+
+static tree
+handle_target_attribute (tree *node, tree name, tree args, int flags,
+                        bool *no_add_attrs)
+{
+  /* Ensure we have a function type.  */
+  if (TREE_CODE (*node) != FUNCTION_DECL)
+    {
+      warning (OPT_Wattributes, "%qE attribute ignored", name);
+      *no_add_attrs = true;
+    }
+  else if (lookup_attribute ("target_clones", DECL_ATTRIBUTES (*node)))
+    {
+      warning (OPT_Wattributes, "%qE attribute ignored due to conflict "
+                  "with %qs attribute", name, "target_clones");
+      *no_add_attrs = true;
+    }
+  else if (!targetm.target_option.valid_attribute_p (*node, name, args, flags))
+    *no_add_attrs = true;
+
+  /* Check that there's no empty string in values of the attribute.  */
+  for (tree t = args; t != NULL_TREE; t = TREE_CHAIN (t))
+    {
+      tree value = TREE_VALUE (t);
+      if (TREE_CODE (value) == STRING_CST
+         && TREE_STRING_LENGTH (value) == 1
+         && TREE_STRING_POINTER (value)[0] == '\0')
+       {
+         warning (OPT_Wattributes, "empty string in attribute %<target%>");
+         *no_add_attrs = true;
+       }
+    }
+
+  return NULL_TREE;
+}
+
+/* Handle a "target_clones" attribute.  */
+
+static tree
+handle_target_clones_attribute (tree *node, tree name, tree ARG_UNUSED (args),
+                         int ARG_UNUSED (flags), bool *no_add_attrs)
+{
+  /* Ensure we have a function type.  */
+  if (TREE_CODE (*node) == FUNCTION_DECL)
+    {
+      if (lookup_attribute ("always_inline", DECL_ATTRIBUTES (*node)))
+       {
+         warning (OPT_Wattributes, "%qE attribute ignored due to conflict "
+                  "with %qs attribute", name, "always_inline");
+         *no_add_attrs = true;
+       }
+      else if (lookup_attribute ("target", DECL_ATTRIBUTES (*node)))
+       {
+         warning (OPT_Wattributes, "%qE attribute ignored due to conflict "
+                  "with %qs attribute", name, "target");
+         *no_add_attrs = true;
+       }
+      else
+       /* Do not inline functions with multiple clone targets.  */
+       DECL_UNINLINABLE (*node) = 1;
+    }
+  else
+    {
+      warning (OPT_Wattributes, "%qE attribute ignored", name);
+      *no_add_attrs = true;
+    }
+  return NULL_TREE;
+}
+
 /* Handle a "vector_size" attribute; arguments as in
    struct attribute_spec.handler.  */
 
index 520650b90250e7707fa1fc12148ef1335091c78b..200e5dbf84719a38d0add697d869cc919ca84bf2 100644 (file)
@@ -19349,20 +19349,25 @@ package body Sem_Prag is
          -----------------------
 
          --  pragma Machine_Attribute (
-         --       [Entity         =>] LOCAL_NAME,
-         --       [Attribute_Name =>] static_string_EXPRESSION
-         --    [, [Info           =>] static_EXPRESSION] );
+         --     [Entity         =>] LOCAL_NAME,
+         --     [Attribute_Name =>] static_string_EXPRESSION
+         --  [, [Info           =>] static_EXPRESSION {, static_EXPRESSION}] );
 
          when Pragma_Machine_Attribute => Machine_Attribute : declare
+            Arg : Node_Id;
             Def_Id : Entity_Id;
 
          begin
             GNAT_Pragma;
             Check_Arg_Order ((Name_Entity, Name_Attribute_Name, Name_Info));
 
-            if Arg_Count = 3 then
+            if Arg_Count >= 3 then
                Check_Optional_Identifier (Arg3, Name_Info);
-               Check_Arg_Is_OK_Static_Expression (Arg3);
+               Arg := Arg3;
+               while Present (Arg) loop
+                  Check_Arg_Is_OK_Static_Expression (Arg);
+                  Arg := Next (Arg);
+               end loop;
             else
                Check_Arg_Count (2);
             end if;
index 7cc476d4be95189d4ca2698d0e946ba15387f951..caeb40691f33386b67e5fe12bcbf6f252b2581f2 100644 (file)
@@ -1,3 +1,7 @@
+2019-05-28  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * gnat.dg/machine_attr1.ad[sb]: New test.
+
 2019-05-28  Eric Botcazou  <ebotcazou@adacore.com>
 
        * gnat.dg/opt79.ad[sb]: New test.
diff --git a/gcc/testsuite/gnat.dg/machine_attr1.adb b/gcc/testsuite/gnat.dg/machine_attr1.adb
new file mode 100644 (file)
index 0000000..f4e4ff7
--- /dev/null
@@ -0,0 +1,41 @@
+-- { dg-do compile { target i?86-*-linux* x86_64-*-linux* } }
+-- { dg-options "-O3 -gnatp" }
+
+package body Machine_Attr1 is
+
+  procedure Proc1 is
+  begin
+    Proc3;
+    Proc4;
+  end;
+
+  procedure Proc2 is
+  begin
+    Proc1;
+  end;
+
+  procedure Proc3 is
+  begin
+    A (1) := 0;
+  end;
+
+  procedure Proc4 is
+  begin
+    A (2) := 0;
+  end;
+
+  procedure Proc5 is
+  begin
+    for I in A'Range loop
+      A(I) := B(I) + C(I);
+    end loop;
+  end;
+
+  procedure Proc6 is
+  begin
+    for I in A'Range loop
+      A(I) := B(I) + C(I);
+    end loop;
+  end;
+
+end Machine_Attr1;
diff --git a/gcc/testsuite/gnat.dg/machine_attr1.ads b/gcc/testsuite/gnat.dg/machine_attr1.ads
new file mode 100644 (file)
index 0000000..d1f2aec
--- /dev/null
@@ -0,0 +1,25 @@
+package Machine_Attr1 is
+
+  type Arr is array (1 .. 256) of Integer;
+
+  A, B, C : Arr;
+
+  procedure Proc1;
+  pragma Machine_Attribute (Proc1, "flatten");
+
+  procedure Proc2;
+  pragma Machine_Attribute (Proc2, "used");
+
+  procedure Proc3;
+  pragma Machine_Attribute (Proc3, "cold");
+
+  procedure Proc4;
+  pragma Machine_Attribute (Proc4, "hot");
+
+  procedure Proc5;
+  pragma Machine_Attribute (Proc5, "target", "avx");
+
+  procedure Proc6;
+  pragma Machine_Attribute (Proc6, "target_clones", "avx", "avx2", "default");
+
+end Machine_Attr1;