Fortran: Store OpenMP's 'declare variant' in module file [PR115271]

Write the 'omp declare variant' data into the .mod file: Base function,
variant function(s), supporting the clauses match, append_args, and
adjust_args.

	PR fortran/115271

gcc/fortran/ChangeLog:

	* module.cc (mio_omp_declare_simd_clauses): New, moved from ...
	(mio_omp_declare_simd): ... here. Update call, write empty '( )'
	if there is no declare simd but a declare variant.
	(mio_omp_declare_variant): New.
	(mio_symbol): Call it.
	* openmp.cc (gfc_match_omp_context_selector): Add comment about
	module.cc to TODO note.
	* trans-stmt.h (gfc_trans_omp_declare_variant): Take additional
	parent_ns argument.
	* trans-decl.cc (create_function_arglist,
	gfc_create_function_decl): Update call.
	* trans-openmp.cc (gfc_trans_omp_declare_variant): Take new
	argument, add some special case handling for attr.use_assoc.

gcc/testsuite/ChangeLog:

	* gfortran.dg/gomp/declare-variant-mod-1-use.f90: New test.
	* gfortran.dg/gomp/declare-variant-mod-1.f90: New test.
	* gfortran.dg/gomp/declare-variant-mod-2-use.f90: New test.
	* gfortran.dg/gomp/declare-variant-mod-2.f90: New test.

9 files changed, 650 insertions, 66 deletions

diff --git a/gcc/fortran/module.cc b/gcc/fortran/module.cc
index 490eaa9..070b316 100644
--- a/gcc/fortran/module.cc
+++ b/gcc/fortran/module.cc
@@ -4381,75 +4381,58 @@ static const mstring omp_declare_simd_clauses[] =
     minit (NULL, -1)
 };
 
-/* Handle !$omp declare simd.  */
+/* Handle OpenMP's declare-simd clauses.  */
 
 static void
-mio_omp_declare_simd (gfc_namespace *ns, gfc_omp_declare_simd **odsp)
+mio_omp_declare_simd_clauses (gfc_omp_clauses **clausesp)
 {
   if (iomode == IO_OUTPUT)
     {
-      if (*odsp == NULL)
-	return;
-    }
-  else if (peek_atom () != ATOM_LPAREN)
-    return;
-
-  gfc_omp_declare_simd *ods = *odsp;
+      gfc_omp_clauses *clauses = *clausesp;
+      gfc_omp_namelist *n;
 
-  mio_lparen ();
-  if (iomode == IO_OUTPUT)
-    {
       write_atom (ATOM_NAME, "OMP_DECLARE_SIMD");
-      if (ods->clauses)
+      if (clauses->inbranch)
+	mio_name (0, omp_declare_simd_clauses);
+      if (clauses->notinbranch)
+	mio_name (1, omp_declare_simd_clauses);
+      if (clauses->simdlen_expr)
 	{
-	  gfc_omp_namelist *n;
-
-	  if (ods->clauses->inbranch)
-	    mio_name (0, omp_declare_simd_clauses);
-	  if (ods->clauses->notinbranch)
-	    mio_name (1, omp_declare_simd_clauses);
-	  if (ods->clauses->simdlen_expr)
-	    {
-	      mio_name (2, omp_declare_simd_clauses);
-	      mio_expr (&ods->clauses->simdlen_expr);
-	    }
-	  for (n = ods->clauses->lists[OMP_LIST_UNIFORM]; n; n = n->next)
-	    {
-	      mio_name (3, omp_declare_simd_clauses);
-	      mio_symbol_ref (&n->sym);
-	    }
-	  for (n = ods->clauses->lists[OMP_LIST_LINEAR]; n; n = n->next)
-	    {
-	      if (n->u.linear.op == OMP_LINEAR_DEFAULT)
-		mio_name (4, omp_declare_simd_clauses);
-	      else
-		mio_name (32 + n->u.linear.op, omp_declare_simd_clauses);
-	      mio_symbol_ref (&n->sym);
-	      mio_expr (&n->expr);
-	    }
-	  for (n = ods->clauses->lists[OMP_LIST_ALIGNED]; n; n = n->next)
-	    {
-	      mio_name (5, omp_declare_simd_clauses);
-	      mio_symbol_ref (&n->sym);
-	      mio_expr (&n->expr);
-	    }
+	  mio_name (2, omp_declare_simd_clauses);
+	  mio_expr (&clauses->simdlen_expr);
+	}
+      for (n = clauses->lists[OMP_LIST_UNIFORM]; n; n = n->next)
+	{
+	  mio_name (3, omp_declare_simd_clauses);
+	  mio_symbol_ref (&n->sym);
+	}
+      for (n = clauses->lists[OMP_LIST_LINEAR]; n; n = n->next)
+	{
+	  if (n->u.linear.op == OMP_LINEAR_DEFAULT)
+	    mio_name (4, omp_declare_simd_clauses);
+	  else
+	    mio_name (32 + n->u.linear.op, omp_declare_simd_clauses);
+	  mio_symbol_ref (&n->sym);
+	  mio_expr (&n->expr);
+	}
+      for (n = clauses->lists[OMP_LIST_ALIGNED]; n; n = n->next)
+	{
+	  mio_name (5, omp_declare_simd_clauses);
+	  mio_symbol_ref (&n->sym);
+	  mio_expr (&n->expr);
 	}
     }
   else
     {
+      if (peek_atom () != ATOM_NAME)
+	return;
+
       gfc_omp_namelist **ptrs[3] = { NULL, NULL, NULL };
+      gfc_omp_clauses *clauses = *clausesp = gfc_get_omp_clauses ();
+      ptrs[0] = &clauses->lists[OMP_LIST_UNIFORM];
+      ptrs[1] = &clauses->lists[OMP_LIST_LINEAR];
+      ptrs[2] = &clauses->lists[OMP_LIST_ALIGNED];
 
-      require_atom (ATOM_NAME);
-      *odsp = ods = gfc_get_omp_declare_simd ();
-      ods->where = gfc_current_locus;
-      ods->proc_name = ns->proc_name;
-      if (peek_atom () == ATOM_NAME)
-	{
-	  ods->clauses = gfc_get_omp_clauses ();
-	  ptrs[0] = &ods->clauses->lists[OMP_LIST_UNIFORM];
-	  ptrs[1] = &ods->clauses->lists[OMP_LIST_LINEAR];
-	  ptrs[2] = &ods->clauses->lists[OMP_LIST_ALIGNED];
-	}
       while (peek_atom () == ATOM_NAME)
 	{
 	  gfc_omp_namelist *n;
@@ -4457,9 +4440,9 @@ mio_omp_declare_simd (gfc_namespace *ns, gfc_omp_declare_simd **odsp)
 
 	  switch (t)
 	    {
-	    case 0: ods->clauses->inbranch = true; break;
-	    case 1: ods->clauses->notinbranch = true; break;
-	    case 2: mio_expr (&ods->clauses->simdlen_expr); break;
+	    case 0: clauses->inbranch = true; break;
+	    case 1: clauses->notinbranch = true; break;
+	    case 2: mio_expr (&clauses->simdlen_expr); break;
 	    case 3:
 	    case 4:
 	    case 5:
@@ -4481,12 +4464,309 @@ mio_omp_declare_simd (gfc_namespace *ns, gfc_omp_declare_simd **odsp)
 	    }
 	}
     }
+}
+
+
+/* Handle !$omp declare simd.  */
+
+static void
+mio_omp_declare_simd (gfc_namespace *ns, gfc_omp_declare_simd **odsp)
+{
+  if (iomode == IO_OUTPUT)
+    {
+      if (*odsp == NULL)
+	{
+	  if (ns->omp_declare_variant)
+	    {
+	      mio_lparen ();
+	      mio_rparen ();
+	    }
+	  return;
+	}
+    }
+  else if (peek_atom () != ATOM_LPAREN)
+    return;
+
+  gfc_omp_declare_simd *ods = *odsp;
+
+  mio_lparen ();
+  if (iomode == IO_OUTPUT)
+    {
+      if (ods->clauses)
+	mio_omp_declare_simd_clauses (&ods->clauses);
+    }
+  else
+    {
+      if (peek_atom () == ATOM_RPAREN)
+	{
+	  mio_rparen ();
+	  return;
+	}
+
+      require_atom (ATOM_NAME);
+      *odsp = ods = gfc_get_omp_declare_simd ();
+      ods->where = gfc_current_locus;
+      ods->proc_name = ns->proc_name;
+      mio_omp_declare_simd_clauses (&ods->clauses);
+    }
 
   mio_omp_declare_simd (ns, &ods->next);
 
   mio_rparen ();
 }
 
+/* Handle !$omp declare variant.  */
+
+static void
+mio_omp_declare_variant (gfc_namespace *ns, gfc_omp_declare_variant **odvp)
+{
+  if (iomode == IO_OUTPUT)
+    {
+      if (*odvp == NULL)
+	return;
+    }
+  else if (peek_atom () != ATOM_LPAREN)
+    return;
+
+  gfc_omp_declare_variant *odv;
+
+  mio_lparen ();
+  if (iomode == IO_OUTPUT)
+    {
+      odv = *odvp;
+      write_atom (ATOM_NAME, "OMP_DECLARE_VARIANT");
+      gfc_symtree *st;
+      st = (odv->base_proc_symtree
+	    ? odv->base_proc_symtree
+	    : gfc_find_symtree (ns->sym_root, ns->proc_name->name));
+      mio_symtree_ref (&st);
+      st = (st->n.sym->attr.if_source == IFSRC_IFBODY
+	    && st->n.sym->formal_ns == ns
+	    ? gfc_find_symtree (ns->parent->sym_root,
+				odv->variant_proc_symtree->name)
+	    : odv->variant_proc_symtree);
+      mio_symtree_ref (&st);
+
+      mio_lparen ();
+      write_atom (ATOM_NAME, "SEL");
+      for (gfc_omp_set_selector *set = odv->set_selectors; set; set = set->next)
+	{
+	  int set_code = set->code;
+	  mio_integer (&set_code);
+	  mio_lparen ();
+	  for (gfc_omp_selector *sel = set->trait_selectors; sel;
+	       sel = sel->next)
+	    {
+	      int sel_code = sel->code;
+	      mio_integer (&sel_code);
+	      mio_expr (&sel->score);
+	      mio_lparen ();
+	      for (gfc_omp_trait_property *prop = sel->properties; prop;
+		   prop = prop->next)
+		{
+		  int kind = prop->property_kind;
+		  mio_integer (&kind);
+		  int is_name = prop->is_name;
+		  mio_integer (&is_name);
+		  switch (prop->property_kind)
+		    {
+		    case OMP_TRAIT_PROPERTY_DEV_NUM_EXPR:
+		    case OMP_TRAIT_PROPERTY_BOOL_EXPR:
+		      mio_expr (&prop->expr);
+		      break;
+		    case OMP_TRAIT_PROPERTY_ID:
+		      write_atom (ATOM_STRING, prop->name);
+		      break;
+		    case OMP_TRAIT_PROPERTY_NAME_LIST:
+		      if (prop->is_name)
+			write_atom (ATOM_STRING, prop->name);
+		      else
+			mio_expr (&prop->expr);
+		      break;
+		    case OMP_TRAIT_PROPERTY_CLAUSE_LIST:
+		      {
+			/* Currently only declare simd.  */
+			mio_lparen ();
+			mio_omp_declare_simd_clauses (&prop->clauses);
+			mio_rparen ();
+		      }
+		      break;
+		    default:
+		      gcc_unreachable ();
+		    }
+		}
+	      mio_rparen ();
+	    }
+	  mio_rparen ();
+	}
+      mio_rparen ();
+
+      mio_lparen ();
+      write_atom (ATOM_NAME, "ADJ");
+      for (gfc_omp_namelist *arg = odv->adjust_args_list; arg; arg = arg->next)
+	{
+	  int need_ptr = arg->u.adj_args.need_ptr;
+	  int need_addr = arg->u.adj_args.need_addr;
+	  int range_start = arg->u.adj_args.range_start;
+	  int omp_num_args_plus = arg->u.adj_args.omp_num_args_plus;
+	  int omp_num_args_minus = arg->u.adj_args.omp_num_args_minus;
+	  mio_integer (&need_ptr);
+	  mio_integer (&need_addr);
+	  mio_integer (&range_start);
+	  mio_integer (&omp_num_args_plus);
+	  mio_integer (&omp_num_args_minus);
+	  mio_expr (&arg->expr);
+	}
+      mio_rparen ();
+
+      mio_lparen ();
+      write_atom (ATOM_NAME, "APP");
+      for (gfc_omp_namelist *arg = odv->append_args_list; arg; arg = arg->next)
+	{
+	  int target = arg->u.init.target;
+	  int targetsync = arg->u.init.targetsync;
+	  mio_integer (&target);
+	  mio_integer (&targetsync);
+	  mio_integer (&arg->u.init.len);
+	  gfc_char_t *p = XALLOCAVEC (gfc_char_t, arg->u.init.len);
+	  for (int i = 0; i < arg->u.init.len; i++)
+	    p[i] = arg->u2.init_interop[i];
+	  mio_allocated_wide_string (p, arg->u.init.len);
+	}
+      mio_rparen ();
+    }
+  else
+    {
+      if (peek_atom () == ATOM_RPAREN)
+	{
+	  mio_rparen ();
+	  return;
+	}
+
+      require_atom (ATOM_NAME);
+      odv = *odvp = gfc_get_omp_declare_variant ();
+      odv->where = gfc_current_locus;
+
+      mio_symtree_ref (&odv->base_proc_symtree);
+      mio_symtree_ref (&odv->variant_proc_symtree);
+
+      mio_lparen ();
+      require_atom (ATOM_NAME);  /* SEL */
+      gfc_omp_set_selector **set = &odv->set_selectors;
+      while (peek_atom () != ATOM_RPAREN)
+	{
+	  *set = gfc_get_omp_set_selector ();
+	  int set_code;
+	  mio_integer (&set_code);
+	  (*set)->code = (enum omp_tss_code) set_code;
+
+	  mio_lparen ();
+	  gfc_omp_selector **sel = &(*set)->trait_selectors;
+	  while (peek_atom () != ATOM_RPAREN)
+	    {
+	      *sel = gfc_get_omp_selector ();
+	      int sel_code = 0;
+	      mio_integer (&sel_code);
+	      (*sel)->code = (enum omp_ts_code) sel_code;
+	      mio_expr (&(*sel)->score);
+
+	      mio_lparen ();
+	      gfc_omp_trait_property **prop = &(*sel)->properties;
+	      while (peek_atom () != ATOM_RPAREN)
+		{
+		  *prop = gfc_get_omp_trait_property ();
+		  int kind = 0, is_name = 0;
+		  mio_integer (&kind);
+		  mio_integer (&is_name);
+		  (*prop)->property_kind = (enum omp_tp_type) kind;
+		  (*prop)->is_name = is_name;
+		  switch ((*prop)->property_kind)
+		    {
+		    case OMP_TRAIT_PROPERTY_DEV_NUM_EXPR:
+		    case OMP_TRAIT_PROPERTY_BOOL_EXPR:
+		      mio_expr (&(*prop)->expr);
+		      break;
+		    case OMP_TRAIT_PROPERTY_ID:
+		      (*prop)->name = read_string ();
+		      break;
+		    case OMP_TRAIT_PROPERTY_NAME_LIST:
+		      if ((*prop)->is_name)
+			(*prop)->name = read_string ();
+		      else
+			mio_expr (&(*prop)->expr);
+		      break;
+		    case OMP_TRAIT_PROPERTY_CLAUSE_LIST:
+		      {
+			/* Currently only declare simd.  */
+			mio_lparen ();
+			mio_omp_declare_simd_clauses (&(*prop)->clauses);
+			mio_rparen ();
+		      }
+		      break;
+		    default:
+		      gcc_unreachable ();
+		    }
+		  prop = &(*prop)->next;
+		}
+	      mio_rparen ();
+	      sel = &(*sel)->next;
+	    }
+	  mio_rparen ();
+	  set = &(*set)->next;
+	}
+      mio_rparen ();
+
+      mio_lparen ();
+      require_atom (ATOM_NAME);  /* ADJ */
+      gfc_omp_namelist **nl = &odv->adjust_args_list;
+      while (peek_atom () != ATOM_RPAREN)
+	{
+	  *nl = gfc_get_omp_namelist ();
+	  (*nl)->where = gfc_current_locus;
+	  int need_ptr, need_addr, range_start;
+	  int omp_num_args_plus, omp_num_args_minus;
+	  mio_integer (&need_ptr);
+	  mio_integer (&need_addr);
+	  mio_integer (&range_start);
+	  mio_integer (&omp_num_args_plus);
+	  mio_integer (&omp_num_args_minus);
+	  (*nl)->u.adj_args.need_ptr = need_ptr;
+	  (*nl)->u.adj_args.need_addr = need_addr;
+	  (*nl)->u.adj_args.range_start = range_start;
+	  (*nl)->u.adj_args.omp_num_args_plus = omp_num_args_minus;
+	  (*nl)->u.adj_args.omp_num_args_plus = omp_num_args_minus;
+	  mio_expr (&(*nl)->expr);
+	  nl = &(*nl)->next;
+	}
+      mio_rparen ();
+
+      mio_lparen ();
+      require_atom (ATOM_NAME);  /* APP */
+      nl = &odv->append_args_list;
+      while (peek_atom () != ATOM_RPAREN)
+	{
+	  *nl = gfc_get_omp_namelist ();
+	  (*nl)->where = gfc_current_locus;
+	  int target, targetsync;
+	  mio_integer (&target);
+	  mio_integer (&targetsync);
+	  mio_integer (&(*nl)->u.init.len);
+	  (*nl)->u.init.target = target;
+	  (*nl)->u.init.targetsync = targetsync;
+	  const gfc_char_t *p = XALLOCAVEC (gfc_char_t, (*nl)->u.init.len); // FIXME: memory handling?
+	  (*nl)->u2.init_interop = XCNEWVEC (char,  (*nl)->u.init.len);
+	  p = mio_allocated_wide_string (NULL, (*nl)->u.init.len);
+	  for (int i = 0; i < (*nl)->u.init.len; i++)
+	    (*nl)->u2.init_interop[i] = p[i];
+	  nl = &(*nl)->next;
+	}
+      mio_rparen ();
+    }
+
+  mio_omp_declare_variant (ns, &odv->next);
+
+  mio_rparen ();
+}
 
 static const mstring omp_declare_reduction_stmt[] =
 {
@@ -4665,7 +4945,14 @@ mio_symbol (gfc_symbol *sym)
   if (sym->formal_ns
       && sym->formal_ns->proc_name == sym
       && sym->formal_ns->entries == NULL)
-    mio_omp_declare_simd (sym->formal_ns, &sym->formal_ns->omp_declare_simd);
+    {
+      mio_omp_declare_simd (sym->formal_ns, &sym->formal_ns->omp_declare_simd);
+      mio_omp_declare_variant (sym->formal_ns,
+			       &sym->formal_ns->omp_declare_variant);
+    }
+  else if ((iomode == IO_OUTPUT && sym->ns->proc_name == sym)
+	   || (iomode == IO_INPUT && peek_atom () == ATOM_LPAREN))
+    mio_omp_declare_variant (sym->ns, &sym->ns->omp_declare_variant);
 
   mio_rparen ();
 }
diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc
index c30ab99..905980a 100644
--- a/gcc/fortran/openmp.cc
+++ b/gcc/fortran/openmp.cc
@@ -6535,7 +6535,8 @@ gfc_match_omp_context_selector (gfc_omp_set_selector *oss,
 		  {
 		    /* FIXME: The "requires" selector was added in OpenMP 5.1.
 		       Currently only the now-deprecated syntax
-		       from OpenMP 5.0 is supported.  */
+		       from OpenMP 5.0 is supported.
+		       TODO: When implementing, update modules.cc as well.  */
 		    sorry_at (gfc_get_location (&gfc_current_locus),
 			      "%<requires%> selector is not supported yet");
 		    return MATCH_ERROR;
diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index 893eac0..8dd1c93 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -2481,7 +2481,7 @@ module_sym:
 	  // We need DECL_ARGUMENTS to put attributes on, in case some arguments
 	  // need adjustment
 	  create_function_arglist (sym->formal_ns->proc_name);
-	  gfc_trans_omp_declare_variant (sym->formal_ns);
+	  gfc_trans_omp_declare_variant (sym->formal_ns, sym->ns);
 	}
     }
 
@@ -3269,7 +3269,7 @@ gfc_create_function_decl (gfc_namespace * ns, bool global)
      be declared in a parent namespace, so this needs to be called even if
      there are no local directives.  */
   if (flag_openmp)
-    gfc_trans_omp_declare_variant (ns);
+    gfc_trans_omp_declare_variant (ns, NULL);
 }
 
 /* Return the decl used to hold the function return value.  If
diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc
index 3e5f92f..d1c05d0 100644
--- a/gcc/fortran/trans-openmp.cc
+++ b/gcc/fortran/trans-openmp.cc
@@ -8697,9 +8697,11 @@ gfc_trans_omp_set_selector (gfc_omp_set_selector *gfc_selectors, locus where)
   return set_selectors;
 }
 
+/* If 'ns' points to a formal namespace in an interface, ns->parent == NULL;
+   hence, parent_ns is used instead.  */
 
 void
-gfc_trans_omp_declare_variant (gfc_namespace *ns)
+gfc_trans_omp_declare_variant (gfc_namespace *ns, gfc_namespace *parent_ns)
 {
   tree base_fn_decl = ns->proc_name->backend_decl;
   gfc_namespace *search_ns = ns;
@@ -8712,7 +8714,10 @@ gfc_trans_omp_declare_variant (gfc_namespace *ns)
 	 current namespace.  */
       if (!odv)
 	{
-	  search_ns = search_ns->parent;
+	  if (!search_ns->parent && search_ns == ns)
+	    search_ns = parent_ns;
+	  else
+	    search_ns = search_ns->parent;
 	  if (search_ns)
 	    next = search_ns->omp_declare_variant;
 	  continue;
@@ -8740,6 +8745,7 @@ gfc_trans_omp_declare_variant (gfc_namespace *ns)
       else
 	{
 	  if (!search_ns->contained
+	      && !odv->base_proc_symtree->n.sym->attr.use_assoc
 	      && strcmp (odv->base_proc_symtree->name,
 			 ns->proc_name->name))
 	    gfc_error ("The base name at %L does not match the name of the "
@@ -8770,7 +8776,12 @@ gfc_trans_omp_declare_variant (gfc_namespace *ns)
       /* Ignore directives that do not apply to the current procedure.  */
       if ((odv->base_proc_symtree == NULL && search_ns != ns)
 	  || (odv->base_proc_symtree != NULL
-	      && strcmp (odv->base_proc_symtree->name, ns->proc_name->name)))
+	      && !ns->proc_name->attr.use_assoc
+	      && strcmp (odv->base_proc_symtree->name, ns->proc_name->name))
+	  || (odv->base_proc_symtree != NULL
+	      && ns->proc_name->attr.use_assoc
+	      && strcmp (odv->base_proc_symtree->n.sym->name,
+			 ns->proc_name->name)))
 	continue;
 
       tree set_selectors = gfc_trans_omp_set_selector (odv->set_selectors,
diff --git a/gcc/fortran/trans-stmt.h b/gcc/fortran/trans-stmt.h
index 36cabaf..67b1970 100644
--- a/gcc/fortran/trans-stmt.h
+++ b/gcc/fortran/trans-stmt.h
@@ -70,7 +70,7 @@ tree gfc_trans_deallocate (gfc_code *);
 /* trans-openmp.cc */
 tree gfc_trans_omp_directive (gfc_code *);
 void gfc_trans_omp_declare_simd (gfc_namespace *);
-void gfc_trans_omp_declare_variant (gfc_namespace *);
+void gfc_trans_omp_declare_variant (gfc_namespace *, gfc_namespace *);
 tree gfc_trans_omp_metadirective (gfc_code *code);
 tree gfc_trans_oacc_directive (gfc_code *);
 tree gfc_trans_oacc_declare (gfc_namespace *);
diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-variant-mod-1-use.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-variant-mod-1-use.f90
new file mode 100644
index 0000000..759f8fc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/declare-variant-mod-1-use.f90
@@ -0,0 +1,81 @@
+! { dg-do compile  { target skip-all-targets } }
+! used by declare-variant-mod-1.f90
+
+! Check that module-file handling works for declare_variant
+! and its match/adjust_args/append_args clauses
+!
+! PR fortran/115271
+
+subroutine test1
+  use m1
+  use iso_c_binding, only: c_loc, c_ptr
+  implicit none (type, external)
+
+  integer :: i, j
+  type(c_ptr) :: a1, b1, c1, x1, y1, z1
+
+  !$omp dispatch
+    i = m1_g (a1, b1, c1)
+   j = m1_g (x1, y1, z1)
+end
+! { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ = __builtin_omp_get_mapped_ptr \\(c1.\[0-9\]+, D\\.\[0-9\]+\\);" 1 "gimplify" } }
+! { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ = __builtin_omp_get_mapped_ptr \\(a1, D\\.\[0-9\]+\\);" 1 "gimplify" } }
+! { dg-final { scan-tree-dump-times "i = m1_f \\(D\\.\[0-9\]+, &b1, &D\\.\[0-9\]+\\);" 1 "gimplify" } }
+! { dg-final { scan-tree-dump-times "j = m1_g \\(x1, &y1, &z1\\);" 1 "gimplify" } }
+
+subroutine test2
+  use m2, only: m2_g 
+  use iso_c_binding, only: c_loc, c_ptr
+  implicit none (type, external)
+
+  integer :: i, j
+  type(c_ptr) :: a2, b2, c2, x2, y2, z2
+
+  !$omp dispatch
+    i = m2_g (a2, b2, c2)
+  j = m2_g (x2, y2, z2)
+end
+! { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ = __builtin_omp_get_mapped_ptr (c2.\[0-9\]+, D\\.\[0-9\]+);" 1 "gimplify" } }
+! { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ = __builtin_omp_get_mapped_ptr (a2, D\\.\[0-9\]+);" 1 "gimplify" } }
+! { dg-final { scan-tree-dump-times "i = m2_f (D\\.\[0-9\]+, &b2, &D\\.\[0-9\]+);" 1 "gimplify" } }
+! { dg-final { scan-tree-dump-times "j = m2_g \\(x2, &y2, &z2\\);" 1 "gimplify" } }
+
+subroutine test3
+  use m2, only: my_func => m2_g 
+  use iso_c_binding, only: c_loc, c_ptr
+  implicit none (type, external)
+
+  integer :: i, j
+  type(c_ptr) :: a3, b3, c3, x3, y3, z3
+
+  !$omp dispatch
+    i = my_func (a3, b3, c3)
+  j = my_func (x3, y3, z3)
+end
+! { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ = __builtin_omp_get_mapped_ptr (c3.\[0-9\]+, D\\.\[0-9\]+);" 1 "gimplify" } }
+! { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ = __builtin_omp_get_mapped_ptr (a3, D\\.\[0-9\]+);" 1 "gimplify" } }
+! { dg-final { scan-tree-dump-times "i = m2_f (D\\.\[0-9\]+, &b3, &D\\.\[0-9\]+);" 1 "gimplify" } }
+! { dg-final { scan-tree-dump-times "j = m2_g \\(x3, &y3, &z3\\);" 1 "gimplify" } }
+
+subroutine test4
+  use m3, only: my_m3_g
+  use iso_c_binding, only: c_loc, c_ptr
+  implicit none (type, external)
+
+  integer :: i, j
+  type(c_ptr) :: a4, b4, c4, x4, y4, z4
+
+  !$omp dispatch
+    i = my_m3_g (a4, b4, c4)
+  j = my_m3_g (x4, y4, z4)
+end
+! { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ = __builtin_omp_get_mapped_ptr (c4.\[0-9\]+, D\\.\[0-9\]+);" 1 "gimplify" } }
+! { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ = __builtin_omp_get_mapped_ptr (a4, D\\.\[0-9\]+);" 1 "gimplify" } }
+! { dg-final { scan-tree-dump-times "i = m3_f (D\\.\[0-9\]+, &b4, &D\\.\[0-9\]+);" 1 "gimplify" } }
+! { dg-final { scan-tree-dump-times "j = m3_g \\(x4, &y4, &z4\\);" 1 "gimplify" } }
+
+program main
+  call test1
+  call test2
+  call test3
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-variant-mod-1.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-variant-mod-1.f90
new file mode 100644
index 0000000..b6ed2c7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/declare-variant-mod-1.f90
@@ -0,0 +1,83 @@
+! { dg-do link }
+! { dg-additional-options "-fdump-tree-gimple" }
+! { dg-additional-sources "declare-variant-mod-1-use.f90" }
+
+! Note: We have to use 'link' as otherwise '-o' is specified,
+! which does not work with multiple files.
+
+! Check that module-file handling works for declare_variant
+! and its match/adjust_args/append_args clauses
+!
+! PR fortran/115271
+
+! Define to make linker happy
+integer function m1_f (x, y, z)
+  use iso_c_binding
+  type(c_ptr) :: x, y, z
+  value :: x
+end
+
+integer function m1_g (x, y, z)
+  use iso_c_binding
+  type(c_ptr) :: x, y, z
+  value :: x
+end
+
+module m1
+  implicit none (type, external)
+
+  interface
+    integer function m1_f (x, y, z)
+      use iso_c_binding
+      type(c_ptr) :: x, y, z
+      value :: x
+    end
+    integer function m1_g (x, y, z)
+      !$omp declare variant(m1_f) match(construct={dispatch}) adjust_args(need_device_ptr: x, 3) adjust_args(nothing: y)
+      use iso_c_binding
+      type(c_ptr) :: x, y, z
+      value :: x
+    end
+  end interface
+end module m1
+
+module m2
+  implicit none (type, external)
+contains
+  integer function m2_f (x, y, z)
+    use iso_c_binding
+    type(c_ptr) :: x, y, z
+    value :: x
+    m2_f = 1
+  end
+  integer function m2_g (x, y, z)
+    !$omp declare variant(m2_f) match(construct={dispatch}) adjust_args(need_device_ptr: x, 3) adjust_args(nothing: y)
+    use iso_c_binding
+    type(c_ptr) :: x, y, z
+    value :: x
+    m2_g = 2
+  end
+end module m2
+
+module m3_pre
+  implicit none (type, external)
+contains
+  integer function m3_f (x, y, z)
+    use iso_c_binding
+    type(c_ptr) :: x, y, z
+    value :: x
+    m3_f = 1
+  end
+  integer function m3_g (x, y, z)
+    use iso_c_binding
+    type(c_ptr) :: x, y, z
+    value :: x
+    m3_g = 2
+  end
+end module m3_pre
+
+module m3
+  use m3_pre, only: my_m3_f => m3_f, my_m3_g => m3_g
+  implicit none (type, external)
+  !$omp declare variant(my_m3_g : my_m3_f) match(construct={dispatch}) adjust_args(need_device_ptr: 1, 3) adjust_args(nothing: 2)
+end module m3
diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-variant-mod-2-use.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-variant-mod-2-use.f90
new file mode 100644
index 0000000..9d65a3f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/declare-variant-mod-2-use.f90
@@ -0,0 +1,47 @@
+! { dg-do compile  { target skip-all-targets } }
+! used by declare-variant-mod-2.f90
+
+! Check that module-file handling works for declare_variant
+! and its match/adjust_args/append_args clauses
+!
+! PR fortran/115271
+
+! THIS FILE PROCUEDES ERROR - SEE declare-variant-mod-2.f90 for dg-error lines
+
+module m_test1
+  use m1, only: my_m1_f => m1_f, my_m1_g => m1_g
+  !$omp declare variant(my_m1_g : my_m1_f) match(construct={dispatch}) adjust_args(need_device_ptr: 1, 3) adjust_args(nothing: 1)
+end
+
+subroutine test1  ! See PR fortran/119288 - related to the following 'adjust_args' diagnostic
+  use m_test1  ! { dg-error "'x' at .1. is specified more than once" }
+  use iso_c_binding, only: c_ptr
+  implicit none (type, external)
+  type(c_ptr) :: a1,b1,c1
+  integer :: i
+  !$omp dispatch
+    i = my_m1_g(a1,b1,c1)
+end
+
+subroutine test2
+  use m2
+  implicit none (type, external)
+  integer :: i, t2_a1, t2_a2, t2_a3, t2_a4
+
+  call m2_g(t2_a1)
+
+  !$omp dispatch
+    call m2_g(t2_a2)
+
+  !$omp parallel if(.false.)
+    !$omp dispatch
+      call m2_g(t2_a3)
+  !$omp end parallel
+
+  !$omp do
+  do i = 1, 1
+    !$omp dispatch
+      call m2_g(t2_a4)
+  end do
+
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-variant-mod-2.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-variant-mod-2.f90
new file mode 100644
index 0000000..f75b49c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/declare-variant-mod-2.f90
@@ -0,0 +1,74 @@
+! { dg-do link }
+! { dg-additional-options "-fdump-tree-gimple" }
+! { dg-additional-sources "declare-variant-mod-2-use.f90" }
+
+! Note: We have to use 'link' as otherwise '-o' is specified,
+! which does not work with multiple files.
+
+! Error message in the additional-sources file:
+
+! { dg-error "'x' at .1. is specified more than once" "" { target *-*-* } 17 }
+
+! { dg-message "sorry, unimplemented: 'append_args' clause not yet supported for 'm2_f1', except when specifying all 1 objects in the 'interop' clause of the 'dispatch' directive" "" { target *-*-* } 27 }
+! { dg-note "required by 'dispatch' construct" "" { target *-*-* } 33 }
+! { dg-message "sorry, unimplemented: 'append_args' clause not yet supported for 'm2_f2', except when specifying all 2 objects in the 'interop' clause of the 'dispatch' directive" "" { target *-*-* } 27 }
+! { dg-note "required by 'dispatch' construct" "" { target *-*-* } 37 }
+! { dg-message "sorry, unimplemented: 'append_args' clause not yet supported for 'm2_f3', except when specifying all 3 objects in the 'interop' clause of the 'dispatch' directive" "" { target *-*-* } 27 }
+! { dg-note "required by 'dispatch' construct" "" { target *-*-* } 43 }
+
+! Check that module-file handling works for declare_variant
+! and its match/adjust_args/append_args clauses
+!
+! PR fortran/115271
+
+module m1
+  implicit none (type, external)
+contains
+  integer function m1_f (x, y, z)
+    use iso_c_binding
+    type(c_ptr) :: x, y, z
+    value :: x
+    m1_f = 1
+  end
+  integer function m1_g (x, y, z)
+    use iso_c_binding
+    type(c_ptr) :: x, y, z
+    value :: x
+    m1_g = 2
+  end
+end module m1
+
+module m2
+  use iso_c_binding, only: c_intptr_t
+  implicit none (type, external)
+  integer, parameter :: omp_interop_kind = c_intptr_t
+
+  !$omp declare variant(m2_g : m2_f3) match(construct={do,dispatch}, device={kind(host)}) &
+  !$omp&   append_args(interop(target),interop(targetsync), interop(prefer_type({fr("cuda"), attr("ompx_A")}, {fr("hip")}, {attr("ompx_B")}), targetsync))
+
+contains
+  subroutine m2_f3 (x, obj1, obj2, obj3)
+    use iso_c_binding
+    integer(omp_interop_kind) :: obj1, obj2, obj3
+    value :: obj1
+    integer, value :: x
+  end
+
+  subroutine m2_f2 (x, obj1, obj2)
+    use iso_c_binding
+    integer(omp_interop_kind) :: obj1, obj2
+    integer, value :: x
+  end
+
+  subroutine m2_f1 (x, obj1)
+    use iso_c_binding
+    integer(omp_interop_kind), value :: obj1
+    integer, value :: x
+  end
+
+  subroutine m2_g (x)
+    integer, value :: x
+    !$omp declare variant(m2_g : m2_f1) match(construct={dispatch}) append_args(interop(target, targetsync, prefer_type("cuda", "hip")))
+    !$omp declare variant(m2_f2) match(construct={parallel,dispatch}, implementation={vendor("gnu")}) append_args(interop(target),interop(targetsync))
+  end
+end module