Fortran: Add 'device_type' clause to OpenMP's declare target

gcc/fortran/ChangeLog:

	* gfortran.h (enum gfc_omp_device_type): New.
	(symbol_attribute, gfc_omp_clauses, gfc_common_head): Use it.
	* module.c (enum ab_attribute): Add AB_OMP_DEVICE_TYPE_HOST,
	AB_OMP_DEVICE_TYPE_NOHOST and AB_OMP_DEVICE_TYPE_ANY.
	(attr_bits, mio_symbol_attribute): Handle it.
	(load_commons, write_common_0): Handle omp_device_type flag.
	* openmp.c (enum omp_mask1): Add OMP_CLAUSE_DEVICE_TYPE
	(OMP_DECLARE_TARGET_CLAUSES): Likewise.
	(gfc_match_omp_clauses): Match 'device_type'.
	(gfc_match_omp_declare_target): Handle it.
	* trans-common.c (build_common_decl): Write device-type clause.
	* trans-decl.c (add_attributes_to_decl): Likewise.

gcc/testsuite/ChangeLog:

	* gfortran.dg/gomp/declare-target-4.f90: New test.
	* gfortran.dg/gomp/declare-target-5.f90: New test.

5 files changed, 133 insertions, 7 deletions

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 559d3c6b8b8..d0cea838444 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -753,6 +753,13 @@ CInteropKind_t;
    that the list is initialized.  */
 extern CInteropKind_t c_interop_kinds_table[];
 
+enum gfc_omp_device_type
+{
+  OMP_DEVICE_TYPE_UNSET,
+  OMP_DEVICE_TYPE_HOST,
+  OMP_DEVICE_TYPE_NOHOST,
+  OMP_DEVICE_TYPE_ANY
+};
 
 /* Structure and list of supported extension attributes.  */
 typedef enum
@@ -919,6 +926,7 @@ typedef struct
   /* Mentioned in OMP DECLARE TARGET.  */
   unsigned omp_declare_target:1;
   unsigned omp_declare_target_link:1;
+  ENUM_BITFIELD (gfc_omp_device_type) omp_device_type:2;
 
   /* Mentioned in OACC DECLARE.  */
   unsigned oacc_declare_create:1;
@@ -1360,6 +1368,7 @@ typedef struct gfc_omp_clauses
   struct gfc_expr *num_threads;
   gfc_omp_namelist *lists[OMP_LIST_NUM];
   enum gfc_omp_sched_kind sched_kind;
+  enum gfc_omp_device_type device_type;
   struct gfc_expr *chunk_size;
   enum gfc_omp_default_sharing default_sharing;
   int collapse, orderedc;
@@ -1699,6 +1708,7 @@ typedef struct gfc_common_head
   char use_assoc, saved, threadprivate;
   unsigned char omp_declare_target : 1;
   unsigned char omp_declare_target_link : 1;
+  ENUM_BITFIELD (gfc_omp_device_type) omp_device_type:2;
   /* Provide sufficient space to hold "symbol.symbol.eq.1234567890".  */
   char name[2*GFC_MAX_SYMBOL_LEN + 1 + 14 + 1];
   struct gfc_symbol *head;
diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index 5114d5534b8..714fbd9c299 100644
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -2051,7 +2051,8 @@ enum ab_attribute
   AB_OMP_REQ_REVERSE_OFFLOAD, AB_OMP_REQ_UNIFIED_ADDRESS,
   AB_OMP_REQ_UNIFIED_SHARED_MEMORY, AB_OMP_REQ_DYNAMIC_ALLOCATORS,
   AB_OMP_REQ_MEM_ORDER_SEQ_CST, AB_OMP_REQ_MEM_ORDER_ACQ_REL,
-  AB_OMP_REQ_MEM_ORDER_RELAXED
+  AB_OMP_REQ_MEM_ORDER_RELAXED, AB_OMP_DEVICE_TYPE_NOHOST,
+  AB_OMP_DEVICE_TYPE_HOST, AB_OMP_DEVICE_TYPE_ANY
 };
 
 static const mstring attr_bits[] =
@@ -2132,6 +2133,9 @@ static const mstring attr_bits[] =
     minit ("OMP_REQ_MEM_ORDER_SEQ_CST", AB_OMP_REQ_MEM_ORDER_SEQ_CST),
     minit ("OMP_REQ_MEM_ORDER_ACQ_REL", AB_OMP_REQ_MEM_ORDER_ACQ_REL),
     minit ("OMP_REQ_MEM_ORDER_RELAXED", AB_OMP_REQ_MEM_ORDER_RELAXED),
+    minit ("OMP_DEVICE_TYPE_HOST", AB_OMP_DEVICE_TYPE_HOST),
+    minit ("OMP_DEVICE_TYPE_NOHOST", AB_OMP_DEVICE_TYPE_NOHOST),
+    minit ("OMP_DEVICE_TYPE_ANYHOST", AB_OMP_DEVICE_TYPE_ANY),
     minit (NULL, -1)
 };
 
@@ -2397,6 +2401,22 @@ mio_symbol_attribute (symbol_attribute *attr)
 	      == OMP_REQ_ATOMIC_MEM_ORDER_RELAXED)
 	    MIO_NAME (ab_attribute) (AB_OMP_REQ_MEM_ORDER_RELAXED, attr_bits);
 	}
+      switch (attr->omp_device_type)
+	{
+	case OMP_DEVICE_TYPE_UNSET:
+	  break;
+	case OMP_DEVICE_TYPE_HOST:
+	  MIO_NAME (ab_attribute) (AB_OMP_DEVICE_TYPE_HOST, attr_bits);
+	  break;
+	case OMP_DEVICE_TYPE_NOHOST:
+	  MIO_NAME (ab_attribute) (AB_OMP_DEVICE_TYPE_NOHOST, attr_bits);
+	  break;
+	case OMP_DEVICE_TYPE_ANY:
+	  MIO_NAME (ab_attribute) (AB_OMP_DEVICE_TYPE_ANY, attr_bits);
+	  break;
+	default:
+	  gcc_unreachable ();
+	}
       mio_rparen ();
     }
   else
@@ -2661,6 +2681,15 @@ mio_symbol_attribute (symbol_attribute *attr)
 					   "relaxed", &gfc_current_locus,
 					   module_name);
 	      break;
+	    case AB_OMP_DEVICE_TYPE_HOST:
+	      attr->omp_device_type = OMP_DEVICE_TYPE_HOST;
+	      break;
+	    case AB_OMP_DEVICE_TYPE_NOHOST:
+	      attr->omp_device_type = OMP_DEVICE_TYPE_NOHOST;
+	      break;
+	    case AB_OMP_DEVICE_TYPE_ANY:
+	      attr->omp_device_type = OMP_DEVICE_TYPE_ANY;
+	      break;
 	    }
 	}
     }
@@ -4849,6 +4878,7 @@ load_commons (void)
 	p->saved = 1;
       if (flags & 2)
 	p->threadprivate = 1;
+      p->omp_device_type = (gfc_omp_device_type) ((flags >> 2) & 3);
       p->use_assoc = 1;
 
       /* Get whether this was a bind(c) common or not.  */
@@ -5713,6 +5743,7 @@ write_common_0 (gfc_symtree *st, bool this_module)
       flags = p->saved ? 1 : 0;
       if (p->threadprivate)
 	flags |= 2;
+      flags |= p->omp_device_type << 2;
       mio_integer (&flags);
 
       /* Write out whether the common block is bind(c) or not.  */
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 50983737af4..d0e516c472d 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -752,7 +752,7 @@ cleanup:
   return MATCH_ERROR;
 }
 
-/* OpenMP 4.5 clauses.  */
+/* OpenMP clauses.  */
 enum omp_mask1
 {
   OMP_CLAUSE_PRIVATE,
@@ -800,7 +800,8 @@ enum omp_mask1
   OMP_CLAUSE_SIMD,
   OMP_CLAUSE_THREADS,
   OMP_CLAUSE_USE_DEVICE_PTR,
-  OMP_CLAUSE_USE_DEVICE_ADDR,  /* Actually, OpenMP 5.0.  */
+  OMP_CLAUSE_USE_DEVICE_ADDR,  /* OpenMP 5.0.  */
+  OMP_CLAUSE_DEVICE_TYPE,  /* OpenMP 5.0.  */
   OMP_CLAUSE_NOWAIT,
   /* This must come last.  */
   OMP_MASK1_LAST
@@ -1214,6 +1215,24 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 					   OMP_MAP_FORCE_DEVICEPTR, false,
 					   allow_derived))
 	    continue;
+	  if ((mask & OMP_CLAUSE_DEVICE_TYPE)
+	      && gfc_match ("device_type ( ") == MATCH_YES)
+	    {
+	      if (gfc_match ("host") == MATCH_YES)
+		c->device_type = OMP_DEVICE_TYPE_HOST;
+	      else if (gfc_match ("nohost") == MATCH_YES)
+		c->device_type = OMP_DEVICE_TYPE_NOHOST;
+	      else if (gfc_match ("any") == MATCH_YES)
+		c->device_type = OMP_DEVICE_TYPE_ANY;
+	      else
+		{
+		  gfc_error ("Expected HOST, NOHOST or ANY at %C");
+		  break;
+		}
+	      if (gfc_match (" )") != MATCH_YES)
+		break;
+	      continue;
+	    }
 	  if ((mask & OMP_CLAUSE_DEVICE_RESIDENT)
 	      && gfc_match_omp_variable_list
 		   ("device_resident (",
@@ -2638,7 +2657,7 @@ cleanup:
 #define OMP_ORDERED_CLAUSES \
   (omp_mask (OMP_CLAUSE_THREADS) | OMP_CLAUSE_SIMD)
 #define OMP_DECLARE_TARGET_CLAUSES \
-  (omp_mask (OMP_CLAUSE_TO) | OMP_CLAUSE_LINK)
+  (omp_mask (OMP_CLAUSE_TO) | OMP_CLAUSE_LINK | OMP_CLAUSE_DEVICE_TYPE)
 
 
 static match
@@ -3275,6 +3294,15 @@ gfc_match_omp_declare_target (void)
 		gfc_add_omp_declare_target_link (&n->sym->attr, n->sym->name,
 						 &n->sym->declared_at);
 	    }
+	  if (c->device_type != OMP_DEVICE_TYPE_UNSET)
+	    {
+	      if (n->sym->attr.omp_device_type != OMP_DEVICE_TYPE_UNSET
+		  && n->sym->attr.omp_device_type != c->device_type)
+		gfc_error_now ("List item %qs at %L set in previous OMP DECLARE "
+			       "TARGET directive to a different DEVICE_TYPE",
+			       n->sym->name, &n->where);
+	      n->sym->attr.omp_device_type = c->device_type;
+	    }
 	  n->sym->mark = 1;
 	}
       else if (n->u.common->omp_declare_target
@@ -3297,6 +3325,13 @@ gfc_match_omp_declare_target (void)
 	{
 	  n->u.common->omp_declare_target = 1;
 	  n->u.common->omp_declare_target_link = (list == OMP_LIST_LINK);
+	  if (n->u.common->omp_device_type != OMP_DEVICE_TYPE_UNSET
+	      && n->u.common->omp_device_type != c->device_type)
+	    gfc_error_now ("COMMON at %L set in previous OMP DECLARE "
+			   "TARGET directive to a different DEVICE_TYPE",
+			   &n->where);
+	  n->u.common->omp_device_type = c->device_type;
+
 	  for (s = n->u.common->head; s; s = s->common_next)
 	    {
 	      s->mark = 1;
@@ -3307,8 +3342,17 @@ gfc_match_omp_declare_target (void)
 		    gfc_add_omp_declare_target_link (&s->attr, s->name,
 						     &s->declared_at);
 		}
+	      if (s->attr.omp_device_type != OMP_DEVICE_TYPE_UNSET
+		  && s->attr.omp_device_type != c->device_type)
+		gfc_error_now ("List item %qs at %L set in previous OMP DECLARE"
+			       " TARGET directive to a different DEVICE_TYPE",
+			       s->name, &n->where);
+	      s->attr.omp_device_type = c->device_type;
 	    }
 	}
+  if (c->device_type && !c->lists[OMP_LIST_TO] && !c->lists[OMP_LIST_LINK])
+    gfc_warning_now (0, "OMP DECLARE TARGET directive at %L with only "
+			"DEVICE_TYPE clause is ignored", &old_loc);
 
   gfc_buffer_error (true);
 
diff --git a/gcc/fortran/trans-common.c b/gcc/fortran/trans-common.c
index c6383fc2352..52a9b2f4f49 100644
--- a/gcc/fortran/trans-common.c
+++ b/gcc/fortran/trans-common.c
@@ -426,6 +426,8 @@ build_common_decl (gfc_common_head *com, tree union_type, bool is_init)
   /* If there is no backend_decl for the common block, build it.  */
   if (decl == NULL_TREE)
     {
+      tree omp_clauses = NULL_TREE;
+
       if (com->is_bind_c == 1 && com->binding_label)
 	decl = build_decl (input_location, VAR_DECL, identifier, union_type);
       else
@@ -460,14 +462,33 @@ build_common_decl (gfc_common_head *com, tree union_type, bool is_init)
       if (com->threadprivate)
 	set_decl_tls_model (decl, decl_default_tls_model (decl));
 
+      if (com->omp_device_type != OMP_DEVICE_TYPE_UNSET)
+	{
+	  tree c = build_omp_clause (UNKNOWN_LOCATION, OMP_CLAUSE_DEVICE_TYPE);
+	  switch (com->omp_device_type)
+	    {
+	    case OMP_DEVICE_TYPE_HOST:
+	      OMP_CLAUSE_DEVICE_TYPE_KIND (c) = OMP_CLAUSE_DEVICE_TYPE_HOST;
+	      break;
+	    case OMP_DEVICE_TYPE_NOHOST:
+	      OMP_CLAUSE_DEVICE_TYPE_KIND (c) = OMP_CLAUSE_DEVICE_TYPE_NOHOST;
+	      break;
+	    case OMP_DEVICE_TYPE_ANY:
+	      OMP_CLAUSE_DEVICE_TYPE_KIND (c) = OMP_CLAUSE_DEVICE_TYPE_ANY;
+	      break;
+	    default:
+	      gcc_unreachable ();
+	    }
+	  omp_clauses = c;
+	}
       if (com->omp_declare_target_link)
 	DECL_ATTRIBUTES (decl)
 	  = tree_cons (get_identifier ("omp declare target link"),
-		       NULL_TREE, DECL_ATTRIBUTES (decl));
+		       omp_clauses, DECL_ATTRIBUTES (decl));
       else if (com->omp_declare_target)
 	DECL_ATTRIBUTES (decl)
 	  = tree_cons (get_identifier ("omp declare target"),
-		       NULL_TREE, DECL_ATTRIBUTES (decl));
+		       omp_clauses, DECL_ATTRIBUTES (decl));
 
       /* Place the back end declaration for this common block in
          GLOBAL_BINDING_LEVEL.  */
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 45a739ac860..92242771dde 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -1465,11 +1465,31 @@ add_attributes_to_decl (symbol_attribute sym_attr, tree list)
       tree dims = oacc_build_routine_dims (clauses);
       list = oacc_replace_fn_attrib_attr (list, dims);
     }
+  if (sym_attr.omp_device_type != OMP_DEVICE_TYPE_UNSET)
+    {
+      tree c = build_omp_clause (UNKNOWN_LOCATION, OMP_CLAUSE_DEVICE_TYPE);
+      switch (sym_attr.omp_device_type)
+	{
+	case OMP_DEVICE_TYPE_HOST:
+	  OMP_CLAUSE_DEVICE_TYPE_KIND (c) = OMP_CLAUSE_DEVICE_TYPE_HOST;
+	  break;
+	case OMP_DEVICE_TYPE_NOHOST:
+	  OMP_CLAUSE_DEVICE_TYPE_KIND (c) = OMP_CLAUSE_DEVICE_TYPE_NOHOST;
+	  break;
+	case OMP_DEVICE_TYPE_ANY:
+	  OMP_CLAUSE_DEVICE_TYPE_KIND (c) = OMP_CLAUSE_DEVICE_TYPE_ANY;
+	  break;
+	default:
+	  gcc_unreachable ();
+	}
+      OMP_CLAUSE_CHAIN (c) = clauses;
+      clauses = c;
+    }
 
   if (sym_attr.omp_declare_target_link
       || sym_attr.oacc_declare_link)
     list = tree_cons (get_identifier ("omp declare target link"),
-		      NULL_TREE, list);
+		      clauses, list);
   else if (sym_attr.omp_declare_target
 	   || sym_attr.oacc_declare_create
 	   || sym_attr.oacc_declare_copyin