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.

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 559d3c6b8b833d25bf91e8107ffec408e40145b8..d0cea838444c3f76753f68263add5b969edfa7d9 100644 (file)
--- 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 5114d5534b8adb77912911c675e45c9bb9311a23..714fbd9c299ca3bd86dd2ec0eb7573c55256e172 100644 (file)
--- 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 50983737af4e1c66b9721ce654d96bc151dd7b33..d0e516c472ddd72d5310fdf6e1167fbceb68ceba 100644 (file)
--- 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 c6383fc23529e23f4d942baadb0d9882e640e1d9..52a9b2f4f49f94e223edf0dee96e7e4e3692cf57 100644 (file)
--- 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 45a739ac860ae6a0375c37c5426efd2df23ccb3c..92242771dde6a6ad4c1ee1e04c8b6d10ab56fc3b 100644 (file)
--- 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

diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-target-4.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-target-4.f90
new file mode 100644 (file)
index 0000000..6e3f91e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/declare-target-4.f90
@@ -0,0 +1,81 @@
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-original" }
+
+subroutine f1
+  !$omp declare target device_type (any)  ! { dg-warning "OMP DECLARE TARGET directive at .1. with only DEVICE_TYPE clause is ignored" }
+end subroutine
+
+subroutine f2
+  !$omp declare target to (f2) device_type (any)
+end subroutine
+
+subroutine f3
+  !$omp declare target device_type (any) to (f3)
+end subroutine
+
+subroutine f4
+  !$omp declare target device_type (host) to (f4)
+end subroutine
+
+subroutine f5
+  !$omp declare target device_type (nohost) to (f5)
+end subroutine
+
+module mymod
+  ! device_type is ignored for variables in OpenMP 5.0
+  ! but TR8 and later apply those rules to variables as well
+  implicit none
+  integer :: a, b(4), c, d
+  integer :: e, f, g
+  integer :: m, n, o, p, q, r, s, t, u, v, w, x
+  common /block1/ m, n
+  common /block2/ o, p
+  common /block3/ q, r
+  common /block4/ s, t
+  common /block5/ u, v
+  common /block6/ w, x
+
+  !$omp declare target to(a) device_type(nohost)
+  !$omp declare target to(b) device_type(host)
+  !$omp declare target to(c) device_type(any)
+ ! Fails in ME with "Error: wrong number of arguments specified for 'omp declare target link' attribute"
+ ! !$omp declare target link(e) device_type(nohost)
+ ! !$omp declare target link(f) device_type(host)
+ ! !$omp declare target link(g) device_type(any)
+
+  !$omp declare target to(/block1/) device_type(nohost)
+  !$omp declare target to(/block2/) device_type(host)
+  !$omp declare target to(/block3/) device_type(any)
+  !$omp declare target link(/block4/) device_type(nohost)
+  !$omp declare target link(/block5/) device_type(host)
+  !$omp declare target link(/block6/) device_type(any)
+contains
+  subroutine s1
+    !$omp declare target to (s1) device_type (any)
+  end
+  subroutine s2
+    !$omp declare target to (s2) device_type (nohost)
+  end
+  subroutine s3
+    !$omp declare target to (s3) device_type (host)
+  end
+end module
+
+module m2
+  use mymod
+  implicit none
+  public
+  private :: s1, s2, s3, a, b, c, d, e, f, g
+  public :: m, n, o, p, q, r, s, t, u, v, w, x
+end module m2
+
+! { dg-final { scan-tree-dump-times "omp declare target" 7 "original" } }
+! { dg-final { scan-tree-dump-times "__attribute__\\(\\(omp declare target \\(device_type\\(" 7 "original" } }
+! { dg-final { scan-tree-dump-times "\[\n\r]\[\n\r]f1" 1 "original" } }
+! { dg-final { scan-tree-dump-times "__attribute__\\(\\(omp declare target \\(device_type\\(any\\)\\)\\)\\)\[\n\r]f2" 1 "original" } }
+! { dg-final { scan-tree-dump-times "__attribute__\\(\\(omp declare target \\(device_type\\(any\\)\\)\\)\\)\[\n\r]f3" 1 "original" } }
+! { dg-final { scan-tree-dump-times "__attribute__\\(\\(omp declare target \\(device_type\\(host\\)\\)\\)\\)\[\n\r]f4" 1 "original" } }
+! { dg-final { scan-tree-dump-times "__attribute__\\(\\(omp declare target \\(device_type\\(nohost\\)\\)\\)\\)\[\n\r]f5" 1 "original" } }
+! { dg-final { scan-tree-dump-times "__attribute__\\(\\(omp declare target \\(device_type\\(any\\)\\)\\)\\)\[\n\r]s1" 1 "original" } }
+! { dg-final { scan-tree-dump-times "__attribute__\\(\\(omp declare target \\(device_type\\(nohost\\)\\)\\)\\)\[\n\r]s2" 1 "original" } }
+! { dg-final { scan-tree-dump-times "__attribute__\\(\\(omp declare target \\(device_type\\(host\\)\\)\\)\\)\[\n\r]s3" 1 "original" } }

diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-target-5.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-target-5.f90
new file mode 100644 (file)
index 0000000..76687d4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/declare-target-5.f90
@@ -0,0 +1,63 @@
+subroutine foo()
+  !$omp declare target  to(foo) device_type(bar)  ! { dg-error "Expected HOST, NOHOST or ANY" }
+end
+
+subroutine bar()
+  !$omp declare target  to(bar) device_type(nohost)
+  !$omp declare target  to(bar) device_type(host)  ! { dg-error "previous OMP DECLARE TARGET directive to a different DEVICE_TYPE" }
+end
+
+module mymod_one
+  implicit none
+  integer :: a, b, c, d, e ,f
+  integer :: m, n, o, p, q, r
+  common /block1/ m, n
+  common /block2/ o, p
+  common /block3/ q, r
+  !$omp declare target  to(a) device_type(nohost)
+  !$omp declare target  to(b) device_type(any)
+  !$omp declare target  to(c) device_type(host)
+  !$omp declare target  link(d) device_type(nohost)
+  !$omp declare target  link(e) device_type(any)
+  !$omp declare target  link(f) device_type(host)
+
+  !$omp declare target  to(c) device_type(host)
+  !$omp declare target  link(d) device_type(nohost)
+end module
+
+module mtest
+  use mymod_one ! { dg-error "Cannot change attributes of USE-associated symbol" }
+  implicit none
+
+  !$omp declare target  to(a) device_type(any)  ! { dg-error "previous OMP DECLARE TARGET directive to a different DEVICE_TYPE" }
+  !$omp declare target  to(b) device_type(host)  ! { dg-error "previous OMP DECLARE TARGET directive to a different DEVICE_TYPE" }
+  !$omp declare target  to(c) device_type(nohost)  ! { dg-error "previous OMP DECLARE TARGET directive to a different DEVICE_TYPE" }
+  !$omp declare target  link(d) device_type(host)  ! { dg-error "previous OMP DECLARE TARGET directive to a different DEVICE_TYPE" }
+  !$omp declare target  link(e) device_type(nohost)  ! { dg-error "previous OMP DECLARE TARGET directive to a different DEVICE_TYPE" }
+  !$omp declare target  link(f) device_type(any)  ! { dg-error "previous OMP DECLARE TARGET directive to a different DEVICE_TYPE" }
+end module
+
+module mymod
+  implicit none
+  integer :: a, b, c, d, e ,f
+  integer :: m, n, o, p, q, r
+  common /block1/ m, n
+  common /block2/ o, p
+  common /block3/ q, r
+  !$omp declare target  to(a) device_type(nohost)
+  !$omp declare target  to(b) device_type(any)
+  !$omp declare target  to(c) device_type(host)
+  !$omp declare target  link(d) device_type(nohost)
+  !$omp declare target  link(e) device_type(any)
+  !$omp declare target  link(f) device_type(host)
+
+  !$omp declare target  to(c) device_type(host)
+  !$omp declare target  link(d) device_type(nohost)
+
+  !$omp declare target  to(a) device_type(any)  ! { dg-error "previous OMP DECLARE TARGET directive to a different DEVICE_TYPE" }
+  !$omp declare target  to(b) device_type(host)  ! { dg-error "previous OMP DECLARE TARGET directive to a different DEVICE_TYPE" }
+  !$omp declare target  to(c) device_type(nohost)  ! { dg-error "previous OMP DECLARE TARGET directive to a different DEVICE_TYPE" }
+  !$omp declare target  link(d) device_type(host)  ! { dg-error "previous OMP DECLARE TARGET directive to a different DEVICE_TYPE" }
+  !$omp declare target  link(e) device_type(nohost)  ! { dg-error "previous OMP DECLARE TARGET directive to a different DEVICE_TYPE" }
+  !$omp declare target  link(f) device_type(any)  ! { dg-error "previous OMP DECLARE TARGET directive to a different DEVICE_TYPE" }
+end