This patch adds the first OpenMP 5 feature to gfortran – which is
trivial as it justs adds some parsing, the heavy lifting is already done
in the middle end. (Minus bugs.)
Additionally, I add a check for "is_device_ptr" – which is explicitly is
specified in the OpenMP 4.5/5.0 spec. (i.e. dummy argument w/o
pointer/allocatable/value attribute; C/C++ have the requirement pointer
or array - or (C++) reference to those.) – I am not sure whether the
Fortran restrictions make sense, but that's a OpenMP spec issue (for
OpenMP 5.x?).
I am a bit unsure about checks for use_device_…. The spec has no
explicit rules, only some with can be deduced from the semantic. For
C/C++, gcc/g++ has for OpenMP 4.5 (_ptr) and for OpenMP 5 (_addr): only
accept pointer or array type and C++ additionally for references to
those. OpenMP 5 for _ptr accepts only POINTER_TYPE (C++: plus refs to it).
The current omp-low.c implementation has in any case issues with
use_device_ptr and nonallocatable, nonpointer scalars, which are locally
defined or have the value attribute.
Build and regtested on x86_64-gnu-linux.
OK for the trunk?
Tobias
* dump-parse-tree.c (show_omp_clauses): Handle OMP_LIST_USE_DEVICE_ADDR.
* gfortran.h (enum): Add OMP_LIST_USE_DEVICE_ADDR.
* openmp.c (omp_mask1): Likewise.
(gfc_match_omp_clauses): Match 'use_device_addr'.
(OMP_TARGET_DATA_CLAUSES): Add OMP_LIST_USE_DEVICE_ADDR.
(resolve_omp_clauses): Add it; add is_device_ptr checks.
* gfortran.dg/gomp/is_device_ptr-1.f90: New.
diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
index 513f211b68b..9d7b26f5f6a 100644
--- a/gcc/fortran/dump-parse-tree.c
+++ b/gcc/fortran/dump-parse-tree.c
@@ -1507,6 +1507,7 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses)
case OMP_LIST_CACHE: type = "CACHE"; break;
case OMP_LIST_IS_DEVICE_PTR: type = "IS_DEVICE_PTR"; break;
case OMP_LIST_USE_DEVICE_PTR: type = "USE_DEVICE_PTR"; break;
+ case OMP_LIST_USE_DEVICE_ADDR: type = "USE_DEVICE_ADDR"; break;
default:
gcc_unreachable ();
}
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 6f7717d1134..a70978bf49b 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1263,6 +1263,7 @@ enum
OMP_LIST_CACHE,
OMP_LIST_IS_DEVICE_PTR,
OMP_LIST_USE_DEVICE_PTR,
+ OMP_LIST_USE_DEVICE_ADDR,
OMP_LIST_NUM
};
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index bda7f288989..17b0461276a 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -780,6 +780,7 @@ 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_NOWAIT,
/* This must come last. */
OMP_MASK1_LAST
@@ -1849,6 +1850,11 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
("use_device_ptr (",
&c->lists[OMP_LIST_USE_DEVICE_PTR], false) == MATCH_YES)
continue;
+ if ((mask & OMP_CLAUSE_USE_DEVICE_ADDR)
+ && gfc_match_omp_variable_list
+ ("use_device_addr (",
+ &c->lists[OMP_LIST_USE_DEVICE_ADDR], false) == MATCH_YES)
+ continue;
break;
case 'v':
/* VECTOR_LENGTH must be matched before VECTOR, because the latter
@@ -2477,7 +2485,7 @@ cleanup:
| OMP_CLAUSE_IS_DEVICE_PTR)
#define OMP_TARGET_DATA_CLAUSES \
(omp_mask (OMP_CLAUSE_DEVICE) | OMP_CLAUSE_MAP | OMP_CLAUSE_IF \
- | OMP_CLAUSE_USE_DEVICE_PTR)
+ | OMP_CLAUSE_USE_DEVICE_PTR | OMP_CLAUSE_USE_DEVICE_ADDR)
#define OMP_TARGET_ENTER_DATA_CLAUSES \
(omp_mask (OMP_CLAUSE_DEVICE) | OMP_CLAUSE_MAP | OMP_CLAUSE_IF \
| OMP_CLAUSE_DEPEND | OMP_CLAUSE_NOWAIT)
@@ -4006,7 +4014,7 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
= { "PRIVATE", "FIRSTPRIVATE", "LASTPRIVATE", "COPYPRIVATE", "SHARED",
"COPYIN", "UNIFORM", "ALIGNED", "LINEAR", "DEPEND", "MAP",
"TO", "FROM", "REDUCTION", "DEVICE_RESIDENT", "LINK", "USE_DEVICE",
- "CACHE", "IS_DEVICE_PTR", "USE_DEVICE_PTR" };
+ "CACHE", "IS_DEVICE_PTR", "USE_DEVICE_PTR", "USE_DEVICE_ADDR" };
if (omp_clauses == NULL)
return;
@@ -4563,7 +4571,25 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
}
break;
case OMP_LIST_IS_DEVICE_PTR:
+ if (!n->sym->attr.dummy)
+ gfc_error ("Non-dummy object %qs in %s clause at %L",
+ n->sym->name, name, &n->where);
+ if (n->sym->attr.allocatable
+ || (n->sym->ts.type == BT_CLASS
+ && CLASS_DATA (n->sym)->attr.allocatable))
+ gfc_error ("ALLOCATABLE object %qs in %s clause at %L",
+ n->sym->name, name, &n->where);
+ if (n->sym->attr.pointer
+ || (n->sym->ts.type == BT_CLASS
+ && CLASS_DATA (n->sym)->attr.pointer))
+ gfc_error ("POINTER object %qs in %s clause at %L",
+ n->sym->name, name, &n->where);
+ if (n->sym->attr.value)
+ gfc_error ("VALUE object %qs in %s clause at %L",
+ n->sym->name, name, &n->where);
+ break;
case OMP_LIST_USE_DEVICE_PTR:
+ case OMP_LIST_USE_DEVICE_ADDR:
/* FIXME: Handle these. */
break;
default:
diff --git a/gcc/testsuite/gfortran.dg/gomp/is_device_ptr-1.f90 b/gcc/testsuite/gfortran.dg/gomp/is_device_ptr-1.f90
new file mode 100644
index 00000000000..18211df0ea4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/is_device_ptr-1.f90
@@ -0,0 +1,24 @@
+! { dg-do compile }
+subroutine test(b,c,d)
+ implicit none
+ integer, value, target :: b
+ integer, pointer :: c
+ integer, allocatable, target :: d
+
+ integer, target :: a(5)
+
+ !$omp target is_device_ptr(a) ! { dg-error "Non-dummy object .a. in IS_DEVICE_PTR clause" }
+ !$omp target is_device_ptr(b) ! { dg-error "VALUE object .b. in IS_DEVICE_PTR clause" }
+ !$omp target is_device_ptr(c) ! { dg-error "POINTER object .c. in IS_DEVICE_PTR clause" }
+ !$omp target is_device_ptr(d) ! { dg-error "ALLOCATABLE object .d. in IS_DEVICE_PTR clause" }
+ !$omp end target
+ !$omp end target
+ !$omp end target
+ !$omp end target
+
+ !$omp target data map(a) use_device_addr(a) ! Should be okay
+ !$omp end target data
+
+ !$omp target data map(c) use_device_ptr(c) ! Should be okay
+ !$omp end target data
+end subroutine test
