[2/2] Fortran: add attribute target_clones

Message ID 20221109190225.96037-3-aldot@gcc.gnu.org
State New
Headers
Series Fortran: add attribute target_clones |

Commit Message

Bernhard Reutner-Fischer Nov. 9, 2022, 7:02 p.m. UTC
  Hi!

Add support for attribute target_clones:
!GCC$ ATTRIBUTES target_clones("arch1", "arch3","default") :: mysubroutine

Bootstrapped and regtested on x86_64-unknown-linux with
--target_board=unix'{-m32,-m64}'.
OK for trunk?

gcc/fortran/ChangeLog:

	* decl.cc: Include fold-const.h for size_int.
	(gfc_match_gcc_attribute_args): New internal helper function.
	(gfc_match_gcc_attributes): Handle target_clones.
	* f95-lang.cc (struct attribute_spec): Add target and
	target_clones entries.
	* gfortran.h (ext_attr_id_t): Add EXT_ATTR_TARGET_CLONES.
	(struct symbol_attribute): Add field ext_attr_args.
	* trans-decl.cc (add_attributes_to_decl): Also add ext_attr_args
	to the decl's attributes.
	* gfortran.texi: Document attribute target_clones.

gcc/testsuite/ChangeLog:

	* gfortran.dg/attr_target_clones-1.F90: New test.

Cc: gfortran ML <fortran@gcc.gnu.org>
---
 gcc/fortran/decl.cc                           | 104 ++++++++++++++++++
 gcc/fortran/f95-lang.cc                       |   4 +
 gcc/fortran/gfortran.h                        |   2 +
 gcc/fortran/gfortran.texi                     |  31 ++++++
 gcc/fortran/trans-decl.cc                     |   3 +
 .../gfortran.dg/attr_target_clones-1.F90      |  30 +++++
 6 files changed, 174 insertions(+)
 create mode 100644 gcc/testsuite/gfortran.dg/attr_target_clones-1.F90
  

Comments

Mikael Morin Nov. 21, 2022, 7:13 p.m. UTC | #1
Hello,

Le 09/11/2022 à 20:02, Bernhard Reutner-Fischer via Fortran a écrit :
> Hi!
> 
> Add support for attribute target_clones:
> !GCC$ ATTRIBUTES target_clones("arch1", "arch3","default") :: mysubroutine
> 
> Bootstrapped and regtested on x86_64-unknown-linux with
> --target_board=unix'{-m32,-m64}'.
> OK for trunk?
> 
> gcc/fortran/ChangeLog:
> 
> 	* decl.cc: Include fold-const.h for size_int.
> 	(gfc_match_gcc_attribute_args): New internal helper function.
> 	(gfc_match_gcc_attributes): Handle target_clones.
> 	* f95-lang.cc (struct attribute_spec): Add target and
> 	target_clones entries.
> 	* gfortran.h (ext_attr_id_t): Add EXT_ATTR_TARGET_CLONES.
> 	(struct symbol_attribute): Add field ext_attr_args.
> 	* trans-decl.cc (add_attributes_to_decl): Also add ext_attr_args
> 	to the decl's attributes.
> 	* gfortran.texi: Document attribute target_clones.
> 
> gcc/testsuite/ChangeLog:
> 
> 	* gfortran.dg/attr_target_clones-1.F90: New test.
> 
> Cc: gfortran ML <fortran@gcc.gnu.org>
> ---
>   gcc/fortran/decl.cc                           | 104 ++++++++++++++++++
>   gcc/fortran/f95-lang.cc                       |   4 +
>   gcc/fortran/gfortran.h                        |   2 +
>   gcc/fortran/gfortran.texi                     |  31 ++++++
>   gcc/fortran/trans-decl.cc                     |   3 +
>   .../gfortran.dg/attr_target_clones-1.F90      |  30 +++++
>   6 files changed, 174 insertions(+)
>   create mode 100644 gcc/testsuite/gfortran.dg/attr_target_clones-1.F90
> 
> diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc
> index 0f9b2ced4c2..3a619dbdd34 100644
> --- a/gcc/fortran/decl.cc
> +++ b/gcc/fortran/decl.cc
(...)
> @@ -11709,6 +11710,96 @@ gfc_match_final_decl (void)
>     return MATCH_YES;
>   }
>   
> +/* Internal helper to parse attribute argument list.
> +   If REQUIRE_STRING is true, then require a string.
> +   If ALLOW_MULTIPLE is true, allow more than one arg.
> +   If multiple arguments are passed, require braces around them.
> +   Returns a tree_list of arguments or NULL_TREE.  */
> +static tree
> +gfc_match_gcc_attribute_args (bool require_string, bool allow_multiple)
> +{
> +  tree attr_args = NULL_TREE, attr_arg;
> +  char name[GFC_MAX_SYMBOL_LEN + 1];
> +  unsigned pos = 0;
> +  gfc_char_t c;
> +
> +  /* When we get here, we already parsed
> +     !GCC$ ATTRIBUTES ATTRIBUTE_NAME
> +     Now parse the arguments. These could be one of
> +       "single_string_literal"
> +       ( "str_literal_1" , "str_literal_2" )
> +   */
> +
> +  gfc_gobble_whitespace ();
> +
> +  if (allow_multiple && gfc_match_char ('(') != MATCH_YES)
> +    {
> +      gfc_error ("expected '(' at %C");
> +      return NULL_TREE;
> +    }
> +
> +  if (require_string)
> +    {
> +      do {
> +	if (pos)
> +	  {
> +	    if (!allow_multiple)
> +	      {
> +		gfc_error ("surplus argument at %C");
> +		return NULL_TREE;
> +	      }
> +	    gfc_next_ascii_char (); /* Consume the comma.  */
> +	  }
> +	pos = 0;
> +	gfc_gobble_whitespace ();
> +	unsigned char num_quotes = 0;
> +	do {
> +	  c = gfc_next_char_literal (NONSTRING);
> +	  if (c == '"')
> +	    {
> +	      num_quotes++;
> +	      continue; /* Skip the quote */
> +	    }
> +	  name[pos++] = c;
> +	  if (pos >= GFC_MAX_SYMBOL_LEN)
> +	    {
> +	      gfc_error ("attribute argument truncated at %C");
> +	      return NULL_TREE;
> +	    }
> +	} while (num_quotes % 2 && gfc_match_eos () != MATCH_YES);
The do-while loops are wrongly indented.
It should be:
   do
     {
       ...
     }
   while (...)

> +	if (pos < 1)
> +	  {
> +	    gfc_error ("expected argument at %C");
> +	    return NULL_TREE;
> +	  }
> +	if (num_quotes != 2)
> +	  {
> +	    gfc_error ("invalid string literal at %C");
> +	    return NULL_TREE;
> +	  }
> +	name[pos] = '\0'; /* Redundant wrt build_string.  */
> +	tree str = build_string (pos, name);
> +	/* Compare with c-family/c-common.cc: fix_string_type.  */
> +	tree i_type = build_index_type (size_int (pos));
> +	tree a_type = build_array_type (char_type_node, i_type);
> +	TREE_TYPE (str) = a_type;
> +	TREE_READONLY (str) = 1;
> +	TREE_STATIC (str) = 1;
> +	attr_arg = build_tree_list (NULL_TREE, str);
> +	attr_args = chainon (attr_args, attr_arg);
Same comment as for the flatten attribute:
please no tree stuff out of the trans-*.cc files.
This includes gfortran.h, so the attribute arguments need to be carried 
around using the front-end structures (gfc_actual_arglist for example).

> +
> +	gfc_gobble_whitespace ();
> +      } while (gfc_peek_ascii_char () == ',');
> +    }
> +
> +  if (allow_multiple && gfc_match_char (')') != MATCH_YES)
> +    {
> +      gfc_error ("expected ')' at %C");
> +      return NULL_TREE;
> +    }
> +
> +  return attr_args;
> +}
I'm not sure this function need to do all the parsing manually.
I would rather use gfc_match_actual_arglist, or maybe implement the 
function as a wrapper around it.
What is allowed here?  Are non-literal constants allowed, for example 
parameter variables?  Is line continuation supported ?

Nothing (bad) to say about the rest, but there is enough to change with 
the above comments.

Mikael
  
Bernhard Reutner-Fischer Nov. 21, 2022, 10:26 p.m. UTC | #2
On Mon, 21 Nov 2022 20:13:40 +0100
Mikael Morin <morin-mikael@orange.fr> wrote:

> Hello,
> 
> Le 09/11/2022 à 20:02, Bernhard Reutner-Fischer via Fortran a écrit :
> > Hi!
> > 
> > Add support for attribute target_clones:
> > !GCC$ ATTRIBUTES target_clones("arch1", "arch3","default") :: mysubroutine

> > +/* Internal helper to parse attribute argument list.
> > +   If REQUIRE_STRING is true, then require a string.
> > +   If ALLOW_MULTIPLE is true, allow more than one arg.
> > +   If multiple arguments are passed, require braces around them.
> > +   Returns a tree_list of arguments or NULL_TREE.  */
> > +static tree
> > +gfc_match_gcc_attribute_args (bool require_string, bool allow_multiple)

> > +	do {

> > +	} while (num_quotes % 2 && gfc_match_eos () != MATCH_YES);  
> The do-while loops are wrongly indented.
> It should be:
>    do
>      {
>        ...
>      }
>    while (...)

oops, right.

> > +	tree str = build_string (pos, name);
> > +	/* Compare with c-family/c-common.cc: fix_string_type.  */
> > +	tree i_type = build_index_type (size_int (pos));
> > +	tree a_type = build_array_type (char_type_node, i_type);
> > +	TREE_TYPE (str) = a_type;
> > +	TREE_READONLY (str) = 1;
> > +	TREE_STATIC (str) = 1;
> > +	attr_arg = build_tree_list (NULL_TREE, str);
> > +	attr_args = chainon (attr_args, attr_arg);  
> Same comment as for the flatten attribute:
> please no tree stuff out of the trans-*.cc files.

yes ok, noted. It's a pity in this context, where we purely pass a blob
on to the ME but ok.

> This includes gfortran.h, so the attribute arguments need to be carried 
> around using the front-end structures (gfc_actual_arglist for example).

That's a sane rule of thumb, yes.
Usually, the parser deals with language grammar and not with pure
passthrough remarks, so that's fair. Not so much in the case of such
attribs but i see your point :)
 
> > +  if (allow_multiple && gfc_match_char (')') != MATCH_YES)
> > +    {
> > +      gfc_error ("expected ')' at %C");
> > +      return NULL_TREE;
> > +    }
> > +
> > +  return attr_args;
> > +}  
> I'm not sure this function need to do all the parsing manually.
> I would rather use gfc_match_actual_arglist, or maybe implement the 
> function as a wrapper around it.
> What is allowed here?  Are non-literal constants allowed, for example 
> parameter variables?  Is line continuation supported ?

Line continuation is supported i think.
Parameter variables supposedly are or should not be supported. Why would
you do that in the context of an attribute target decl?
Either way, if the ME does not find such an fndecl, it will complain
and ignore the attribute.
I don't understand non-literal constants in this context.
This very attribute applies to decls, so the existing code supposedly
matches a comma separated list of identifiers. The usual dollar-ok
caveats apply.

As to gfc_match_actual_arglist, probably.
target_clones has
+  { "target_clones",          1, -1, true, false, false, false,
+                             dummy, NULL },
with tree-core.h struct attribute_spec, so
name, min=1, max=unbounded, decl_required=yes, ...ignore...

hence applies to functions and subroutines and the like. It does take an
unbounded list of strings, isa1, isa2, isa4, default. We could add
"default" unless seen, but i'd rather want it spelled out by the user
for the user is supposed to know what she's doing, as in c or c++.
The ME has code to sanity-check the attributes, including conflicting
(ME) attributes.

The reason why i contemplated with a separate parser was that for stuff
like regparm or sseregparm, you would want to require a single number
for the equivalent of

__attribute__((regparm(3),stdcall)

which you would provide in 2 separate !GCC$ attributes i assume.

> 
> Nothing (bad) to say about the rest, but there is enough to change with 
> the above comments.

Yes, many thanks for your comments.
I think there is no other non-intrusive way to pass the data through the
frontend. So for an acceptable way this means touching quite some spots
for every single ME attribute anybody would like to add in the future.
But that's how it is.
  
Mikael Morin Nov. 22, 2022, 1:17 p.m. UTC | #3
Le 21/11/2022 à 23:26, Bernhard Reutner-Fischer a écrit :
> On Mon, 21 Nov 2022 20:13:40 +0100
> Mikael Morin <morin-mikael@orange.fr> wrote:
> 
>> Hello,
>>
>> Le 09/11/2022 à 20:02, Bernhard Reutner-Fischer via Fortran a écrit :
>>> Hi!
>>>
(...)
>>> +  if (allow_multiple && gfc_match_char (')') != MATCH_YES)
>>> +    {
>>> +      gfc_error ("expected ')' at %C");
>>> +      return NULL_TREE;
>>> +    }
>>> +
>>> +  return attr_args;
>>> +}
>> I'm not sure this function need to do all the parsing manually.
>> I would rather use gfc_match_actual_arglist, or maybe implement the
>> function as a wrapper around it.
>> What is allowed here?  Are non-literal constants allowed, for example
>> parameter variables?  Is line continuation supported ?
> 
> Line continuation is supported i think.
> Parameter variables supposedly are or should not be supported. Why would
> you do that in the context of an attribute target decl? > Either way, if the ME does not find such an fndecl, it will complain
> and ignore the attribute.
> I don't understand non-literal constants in this context.
> This very attribute applies to decls, so the existing code supposedly
> matches a comma separated list of identifiers. The usual dollar-ok
> caveats apply.
> 
No, my comment and my questions were about your function, which, as I 
understand it, matches the arguments to the attribute: it matches open 
and closing parenthesis, double quotes, etc.
Matching of decl names comes after that.
I asked the question about non-literal constant (and the other as well), 
because I saw it as a possible reason to not reuse the existing parsing 
functions.

> As to gfc_match_actual_arglist, probably.
> target_clones has
> +  { "target_clones",          1, -1, true, false, false, false,
> +                             dummy, NULL },
> with tree-core.h struct attribute_spec, so
> name, min=1, max=unbounded, decl_required=yes, ...ignore...
> 
> hence applies to functions and subroutines and the like. It does take an
> unbounded list of strings, isa1, isa2, isa4, default. We could add
> "default" unless seen, but i'd rather want it spelled out by the user
> for the user is supposed to know what she's doing, as in c or c++.
> The ME has code to sanity-check the attributes, including conflicting
> (ME) attributes.
> 
> The reason why i contemplated with a separate parser was that for stuff
> like regparm or sseregparm, you would want to require a single number
> for the equivalent of
> 
> __attribute__((regparm(3),stdcall)
> 
> which you would provide in 2 separate !GCC$ attributes i assume.
> 
Well, the check could as easily be enforced after parsing with the 
existing parsing functions.

>>
>> Nothing (bad) to say about the rest, but there is enough to change with
>> the above comments.
> 
> Yes, many thanks for your comments.
> I think there is no other non-intrusive way to pass the data through the
> frontend. So for an acceptable way this means touching quite some spots
> for every single ME attribute anybody would like to add in the future.

I'm not sure I understand.  Please let's just add what is necessary for 
this attribute, not more.
  

Patch

diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc
index 0f9b2ced4c2..3a619dbdd34 100644
--- a/gcc/fortran/decl.cc
+++ b/gcc/fortran/decl.cc
@@ -23,6 +23,7 @@  along with GCC; see the file COPYING3.  If not see
 #include "coretypes.h"
 #include "options.h"
 #include "tree.h"
+#include "fold-const.h"
 #include "gfortran.h"
 #include "stringpool.h"
 #include "match.h"
@@ -11709,6 +11710,96 @@  gfc_match_final_decl (void)
   return MATCH_YES;
 }
 
+/* Internal helper to parse attribute argument list.
+   If REQUIRE_STRING is true, then require a string.
+   If ALLOW_MULTIPLE is true, allow more than one arg.
+   If multiple arguments are passed, require braces around them.
+   Returns a tree_list of arguments or NULL_TREE.  */
+static tree
+gfc_match_gcc_attribute_args (bool require_string, bool allow_multiple)
+{
+  tree attr_args = NULL_TREE, attr_arg;
+  char name[GFC_MAX_SYMBOL_LEN + 1];
+  unsigned pos = 0;
+  gfc_char_t c;
+
+  /* When we get here, we already parsed
+     !GCC$ ATTRIBUTES ATTRIBUTE_NAME
+     Now parse the arguments. These could be one of
+       "single_string_literal"
+       ( "str_literal_1" , "str_literal_2" )
+   */
+
+  gfc_gobble_whitespace ();
+
+  if (allow_multiple && gfc_match_char ('(') != MATCH_YES)
+    {
+      gfc_error ("expected '(' at %C");
+      return NULL_TREE;
+    }
+
+  if (require_string)
+    {
+      do {
+	if (pos)
+	  {
+	    if (!allow_multiple)
+	      {
+		gfc_error ("surplus argument at %C");
+		return NULL_TREE;
+	      }
+	    gfc_next_ascii_char (); /* Consume the comma.  */
+	  }
+	pos = 0;
+	gfc_gobble_whitespace ();
+	unsigned char num_quotes = 0;
+	do {
+	  c = gfc_next_char_literal (NONSTRING);
+	  if (c == '"')
+	    {
+	      num_quotes++;
+	      continue; /* Skip the quote */
+	    }
+	  name[pos++] = c;
+	  if (pos >= GFC_MAX_SYMBOL_LEN)
+	    {
+	      gfc_error ("attribute argument truncated at %C");
+	      return NULL_TREE;
+	    }
+	} while (num_quotes % 2 && gfc_match_eos () != MATCH_YES);
+	if (pos < 1)
+	  {
+	    gfc_error ("expected argument at %C");
+	    return NULL_TREE;
+	  }
+	if (num_quotes != 2)
+	  {
+	    gfc_error ("invalid string literal at %C");
+	    return NULL_TREE;
+	  }
+	name[pos] = '\0'; /* Redundant wrt build_string.  */
+	tree str = build_string (pos, name);
+	/* Compare with c-family/c-common.cc: fix_string_type.  */
+	tree i_type = build_index_type (size_int (pos));
+	tree a_type = build_array_type (char_type_node, i_type);
+	TREE_TYPE (str) = a_type;
+	TREE_READONLY (str) = 1;
+	TREE_STATIC (str) = 1;
+	attr_arg = build_tree_list (NULL_TREE, str);
+	attr_args = chainon (attr_args, attr_arg);
+
+	gfc_gobble_whitespace ();
+      } while (gfc_peek_ascii_char () == ',');
+    }
+
+  if (allow_multiple && gfc_match_char (')') != MATCH_YES)
+    {
+      gfc_error ("expected ')' at %C");
+      return NULL_TREE;
+    }
+
+  return attr_args;
+}
 
 const ext_attr_t ext_attr_list[] = {
   { "dllimport",    EXT_ATTR_DLLIMPORT,    "dllimport" },
@@ -11718,6 +11809,7 @@  const ext_attr_t ext_attr_list[] = {
   { "fastcall",     EXT_ATTR_FASTCALL,     "fastcall"  },
   { "no_arg_check", EXT_ATTR_NO_ARG_CHECK, NULL        },
   { "deprecated",   EXT_ATTR_DEPRECATED,   NULL	       },
+  { "target_clones",EXT_ATTR_TARGET_CLONES,NULL	       },
   { NULL,           EXT_ATTR_LAST,         NULL        }
 };
 
@@ -11743,6 +11835,7 @@  gfc_match_gcc_attributes (void)
   unsigned id;
   gfc_symbol *sym;
   match m;
+  tree attr_args = NULL_TREE;
 
   gfc_clear_attr (&attr);
   for(;;)
@@ -11761,6 +11854,15 @@  gfc_match_gcc_attributes (void)
 	  gfc_error ("Unknown attribute in !GCC$ ATTRIBUTES statement at %C");
 	  return MATCH_ERROR;
 	}
+      else if (id == EXT_ATTR_TARGET_CLONES)
+	{
+	  attr_args
+	    = gfc_match_gcc_attribute_args(true, true);
+	  if (attr_args != NULL_TREE)
+	    attr.ext_attr_args
+	      = chainon (attr.ext_attr_args,
+			 build_tree_list (get_identifier (name), attr_args));
+	}
 
       if (!gfc_add_ext_attribute (&attr, (ext_attr_id_t)id, &gfc_current_locus))
 	return MATCH_ERROR;
@@ -11793,6 +11895,8 @@  gfc_match_gcc_attributes (void)
 	return MATCH_ERROR;
 
       sym->attr.ext_attr |= attr.ext_attr;
+      sym->attr.ext_attr_args
+	= chainon (sym->attr.ext_attr_args, attr.ext_attr_args);
 
       if (gfc_match_eos () == MATCH_YES)
 	break;
diff --git a/gcc/fortran/f95-lang.cc b/gcc/fortran/f95-lang.cc
index a6750bea787..7154568aec5 100644
--- a/gcc/fortran/f95-lang.cc
+++ b/gcc/fortran/f95-lang.cc
@@ -97,6 +97,10 @@  static const struct attribute_spec gfc_attribute_table[] =
     gfc_handle_omp_declare_target_attribute, NULL },
   { "oacc function", 0, -1, true,  false, false, false,
     gfc_handle_omp_declare_target_attribute, NULL },
+  { "target",                 1, -1, true, false, false, false,
+			      gfc_handle_omp_declare_target_attribute, NULL },
+  { "target_clones",          1, -1, true, false, false, false,
+			      gfc_handle_omp_declare_target_attribute, NULL },
   { NULL,		  0, 0, false, false, false, false, NULL, NULL }
 };
 
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 6bd8800ecf8..ce0cb61e647 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -838,6 +838,7 @@  typedef enum
   EXT_ATTR_FASTCALL,
   EXT_ATTR_NO_ARG_CHECK,
   EXT_ATTR_DEPRECATED,
+  EXT_ATTR_TARGET_CLONES,
   EXT_ATTR_LAST, EXT_ATTR_NUM = EXT_ATTR_LAST
 }
 ext_attr_id_t;
@@ -1009,6 +1010,7 @@  typedef struct
 
   /* Attributes set by compiler extensions (!GCC$ ATTRIBUTES).  */
   unsigned ext_attr:EXT_ATTR_NUM;
+  tree ext_attr_args;
 
   /* The namespace where the attribute has been set.  */
   struct gfc_namespace *volatile_ns, *asynchronous_ns;
diff --git a/gcc/fortran/gfortran.texi b/gcc/fortran/gfortran.texi
index 4b4ecd528a7..06e4c8c00a1 100644
--- a/gcc/fortran/gfortran.texi
+++ b/gcc/fortran/gfortran.texi
@@ -3248,6 +3248,37 @@  deprecated procedure, variable or parameter; the warning can be suppressed
 with @option{-Wno-deprecated-declarations}.
 @end itemize
 
+@node target_clones (@var{options})
+
+Procedures can be annotated with a @code{target_clones} attribute to
+instruct the compiler to emit multiple versions of the procedure, each
+compiled with different target options in addition to those specified on
+the command line. The calling code remains exactly the same.
+Please refer to
+@ref{Top,,Common Function Attributes,gcc,Using the GNU Compiler Collection (GCC)}
+for details about the respective attribute.
+
+For example,
+
+@smallexample
+module mymod
+contains
+  subroutine sub1
+!GCC$ ATTRIBUTES target_clones("avx", "sse", "default") :: sub1
+  ! your code here
+  end
+end module mymod
+@end smallexample
+or,
+@smallexample
+module mymod
+contains
+  subroutine sub1
+!GCC$ ATTRIBUTES target_clones("power10","power9","power8","power7","default") :: sub1
+  ! your code here will be optimized for several PPC target architectures
+  end
+end module mymod
+@end smallexample
 
 The attributes are specified using the syntax
 
diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index 63515b9072a..24cbd4cda28 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -1447,6 +1447,9 @@  add_attributes_to_decl (symbol_attribute sym_attr, tree list)
 				 NULL_TREE);
 	list = chainon (list, attr);
       }
+  /* Add attribute args.  */
+  if (sym_attr.ext_attr_args != NULL_TREE)
+    list = chainon (list, sym_attr.ext_attr_args);
 
   tree clauses = NULL_TREE;
 
diff --git a/gcc/testsuite/gfortran.dg/attr_target_clones-1.F90 b/gcc/testsuite/gfortran.dg/attr_target_clones-1.F90
new file mode 100644
index 00000000000..724e58021fa
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/attr_target_clones-1.F90
@@ -0,0 +1,30 @@ 
+! { dg-require-ifunc "" }
+! { dg-options "-O1" }
+! { dg-additional-options "-fdump-tree-optimized" }
+! It seems arch defines are not defined?!
+! See fortran.cpp  FIXME: Pandora's Box
+! Ok, so enterprise-level bugfix:
+! { dg-additional-options "-D__i686__=1" { target { i?86-*-* } } }
+! { dg-additional-options "-D__x86_64__=1" { target { x86_64-*-* } } }
+! { dg-additional-options "-D__powerpc__=1" { target { powerpc*-*-* } } }
+! { dg-skip-if "test not yet implemented for target" { ! {i?86-*-* x86_64-*-* powerpc*-*-*} } }
+! Test __attribute__ ((target_clones ("foo", "bar")))
+!
+module m
+  implicit none
+contains
+  subroutine sub1()
+#if defined __i686__ || defined __x86_64__
+!GCC$ ATTRIBUTES target_clones("avx", "sse","default") :: sub1
+#elif defined __powerpc__
+!GCC$ ATTRIBUTES target_clones("power10", "power9","default") :: sub1
+#endif
+    print *, 4321
+  end
+end module m
+! { dg-final { scan-tree-dump-times {(?n)void \* __m_MOD_sub1\.resolver \(\)} 1 "optimized" } }
+! { dg-final { scan-tree-dump-times {(?n)void __m_MOD_sub1\.(?:avx|power10) \(\)} 1 "optimized" } }
+! { dg-final { scan-tree-dump-times {(?n)void __m_MOD_sub1\.(?:sse|power9) \(\)} 1 "optimized" } }
+! { dg-final { scan-tree-dump-times {(?n)void sub1 \(\)} 1 "optimized" } }
+!! and a non-assembly hint on the ifunc
+! { dg-final { scan-tree-dump-times {Function sub1 \(__m_MOD_sub1\.default,} 1 "optimized" } }