2014-07-24 Cesar Philippidis <cesar@codesourcery.com>
gcc/fortran/
* gfortran.h (gfc_omp_map_op): Add OMP_MAP_FORCE_ALLOC,
OMP_MAP_FORCE_DEALLOC, OMP_MAP_FORCE_TO, OMP_MAP_FORCE_FROM,
OMP_MAP_FORCE_TOFROM, OMP_MAP_FORCE_PRESENT.
(enum) Remove OMP_LIST_OACC_COPYIN, OMP_LIST_COPYOUT,
OMP_LIST_CREATE, OMP_LIST_DELETE, OMP_LIST_PRESENT,
OMP_LIST_PRESENT_OR_COPY, OMP_LIST_PRESENT_OR_COPYIN,
OMP_LIST_PRESENT_OR_COPYOUT, OMP_LIST_PRESENT_OR_CREATE.
* dump-parse-tree.c (show_omp_clauses): Remove handling of
OMP_LIST_OACC_COPYIN, OMP_LIST_COPYOUT, OMP_LIST_CREATE,
OMP_LIST_DELETE, OMP_LIST_PRESENT, OMP_LIST_PRESENT_OR_COPY,
OMP_LIST_PRESENT_OR_COPYIN, OMP_LIST_PRESENT_OR_COPYOUT,
OMP_LIST_PRESENT_OR_CREATE.
* openmp.c (OMP_CLAUSE_OACC_COPYIN): Remove define.
(gfc_match_omp_map_clause): New function.
(gfc_match_omp_clauses): New openacc argument. Treat
OMP_CLAUSE_COPY, OMP_CLAUSE_COPYOUT, OMP_CLAUSE_CREATE,
OMP_CLAUSE_DELETE, OMP_CLAUSE_PRESENT, OMP_CLAUSE_PRESENT_OR_COPY,
OMP_CLAUSE_PRESENT_OR_COPYIN, OMP_CLAUSE_PRESENT_OR_COPYOUT, and
OMP_CLAUSE_PRESENT_OR_CREATE as OpenMP memory maps. Also, remove
support for OMP_CLAUSE_OACC_COPYIN. Make OMP_CLAUSE_COPYIN
represent the COPYIN clause for both OpenACC and OpenMP.
(OACC_PARALLEL_CLAUSES): Replace OMP_CLAUSE_OACC_COPYIN with
OMC_CLAUSE_COPYIN.
(OACC_KERNEL_CLAUSES): Likewise.
(OACC_DATA_CLAUSES): Likewise.
(OACC_DECLARE_CLAUSES): Likewise.
(OACC_ENTER_DATA_CLAUSES): Likewise.
(gfc_match_oacc_parallel_loop): Call gfc_match_omp_clauses with
the openacc parameter as true.
(gfc_match_oacc_parallel): Likewise.
(gfc_match_oacc_kernels_loop): Likewise.
(gfc_match_oacc_kernels): Likewise.
(gfc_match_oacc_data): Likewise.
(gfc_match_oacc_host_data): Likewise.
(gfc_match_oacc_loop): Likewise.
(gfc_match_oacc_declare): Likewise.
(gfc_match_oacc_update): Likewise.
(gfc_match_oacc_enter_data): Likewise.
(gfc_match_oacc_exit_data): Likewise.
(resolve_omp_clauses): New openacc argument. Call
resolve_oacc_data_clauses to check additional errors.
(resolve_oacc_loop): Update call to resolve_omp_clauses.
(resolve_oacc_wait): Likewise.
(gfc_resolve_oacc_declare): Likewise.
(gfc_resolve_oacc_directive): Likewise.
* trans-openmp.c (gfc_trans_omp_clauses): Remove
OMP_LIST_OACC_COPYIN, OMP_LIST_COPYOUT, OMP_LIST_CREATE,
OMP_LIST_DELETE, OMP_LIST_PRESENT, OMP_LIST_PRESENT_OR_COPY,
OMP_LIST_PRESENT_OR_COPYIN, OMP_LIST_PRESENT_OR_COPYOUT,
OMP_LIST_PRESENT_OR_CREATE switch items. Handle
OMP_MAP_FORCE_ALLOC, OMP_MAP_FORCE_DEALLOC, OMP_MAP_FORCE_TO,
OMP_MAP_FORCE_FROM, OMP_MAP_FORCE_TOFROM, OMP_MAP_FORCE_PRESENT
clause memory mappings.
gcc/testsuite/
* gfortran.dg/goacc/subarrays.f95: New test.
* gfortran.dg/gomp/map-1.f90: New test.
@@ -1258,15 +1258,6 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses)
switch (list_type)
{
case OMP_LIST_COPY: type = "COPY"; break;
- case OMP_LIST_OACC_COPYIN: type = "COPYIN"; break;
- case OMP_LIST_COPYOUT: type = "COPYOUT"; break;
- case OMP_LIST_CREATE: type = "CREATE"; break;
- case OMP_LIST_DELETE: type = "DELETE"; break;
- case OMP_LIST_PRESENT: type = "PRESENT"; break;
- case OMP_LIST_PRESENT_OR_COPY: type = "PRESENT_OR_COPY"; break;
- case OMP_LIST_PRESENT_OR_COPYIN: type = "PRESENT_OR_COPYIN"; break;
- case OMP_LIST_PRESENT_OR_COPYOUT: type = "PRESENT_OR_COPYOUT"; break;
- case OMP_LIST_PRESENT_OR_CREATE: type = "PRESENT_OR_CREATE"; break;
case OMP_LIST_DEVICEPTR: type = "DEVICEPTR"; break;
case OMP_LIST_USE_DEVICE: type = "USE_DEVICE"; break;
case OMP_LIST_DEVICE_RESIDENT: type = "USE_DEVICE"; break;
@@ -1111,7 +1111,13 @@ typedef enum
OMP_MAP_ALLOC,
OMP_MAP_TO,
OMP_MAP_FROM,
- OMP_MAP_TOFROM
+ OMP_MAP_TOFROM,
+ OMP_MAP_FORCE_ALLOC,
+ OMP_MAP_FORCE_DEALLOC,
+ OMP_MAP_FORCE_TO,
+ OMP_MAP_FORCE_FROM,
+ OMP_MAP_FORCE_TOFROM,
+ OMP_MAP_FORCE_PRESENT
}
gfc_omp_map_op;
@@ -1153,15 +1159,6 @@ enum
OMP_LIST_REDUCTION,
OMP_LIST_COPY,
OMP_LIST_DATA_CLAUSE_FIRST = OMP_LIST_COPY,
- OMP_LIST_OACC_COPYIN,
- OMP_LIST_COPYOUT,
- OMP_LIST_CREATE,
- OMP_LIST_DELETE,
- OMP_LIST_PRESENT,
- OMP_LIST_PRESENT_OR_COPY,
- OMP_LIST_PRESENT_OR_COPYIN,
- OMP_LIST_PRESENT_OR_COPYOUT,
- OMP_LIST_PRESENT_OR_CREATE,
OMP_LIST_DEVICEPTR,
OMP_LIST_DATA_CLAUSE_LAST = OMP_LIST_DEVICEPTR,
OMP_LIST_DEVICE_RESIDENT,
@@ -448,18 +448,37 @@ match_oacc_clause_gang (gfc_omp_clauses *cp)
#define OMP_CLAUSE_DEVICE_RESIDENT (1ULL << 51)
#define OMP_CLAUSE_HOST (1ULL << 52)
#define OMP_CLAUSE_OACC_DEVICE (1ULL << 53)
-#define OMP_CLAUSE_OACC_COPYIN (1ULL << 54)
-#define OMP_CLAUSE_WAIT (1ULL << 55)
-#define OMP_CLAUSE_DELETE (1ULL << 56)
-#define OMP_CLAUSE_AUTO (1ULL << 57)
-#define OMP_CLAUSE_TILE (1ULL << 58)
+#define OMP_CLAUSE_WAIT (1ULL << 54)
+#define OMP_CLAUSE_DELETE (1ULL << 55)
+#define OMP_CLAUSE_AUTO (1ULL << 56)
+#define OMP_CLAUSE_TILE (1ULL << 57)
+
+/* Helper function for OpenACC and OpenMP clauses involving memory
+ mapping. */
+
+static bool
+gfc_match_omp_map_clause (gfc_omp_namelist **list, gfc_omp_map_op map_op)
+{
+ gfc_omp_namelist **head = NULL;
+ if (gfc_match_omp_variable_list ("", list, false, NULL, &head, true)
+ == MATCH_YES)
+ {
+ gfc_omp_namelist *n;
+ for (n = *head; n; n = n->next)
+ n->u.map_op = map_op;
+ return true;
+ }
+
+ return false;
+}
/* Match OpenMP and OpenACC directive clauses. MASK is a bitmask of
clauses that are allowed for a particular directive. */
static match
gfc_match_omp_clauses (gfc_omp_clauses **cp, unsigned long long mask,
- bool first = true, bool needs_space = true)
+ bool first = true, bool needs_space = true,
+ bool openacc = false)
{
gfc_omp_clauses *c = gfc_get_omp_clauses ();
locus old_loc;
@@ -561,11 +580,20 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, unsigned long long mask,
&c->lists[OMP_LIST_SHARED], true)
== MATCH_YES)
continue;
- if ((mask & OMP_CLAUSE_COPYIN)
- && gfc_match_omp_variable_list ("copyin (",
- &c->lists[OMP_LIST_COPYIN], true)
- == MATCH_YES)
- continue;
+ if (mask & OMP_CLAUSE_COPYIN)
+ {
+ if (openacc)
+ {
+ if (gfc_match ("copyin ( ") == MATCH_YES
+ && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
+ OMP_MAP_FORCE_TO))
+ continue;
+ }
+ else if (gfc_match_omp_variable_list ("copyin (",
+ &c->lists[OMP_LIST_COPYIN],
+ true) == MATCH_YES)
+ continue;
+ }
if ((mask & OMP_CLAUSE_NUM_GANGS) && c->num_gangs_expr == NULL
&& gfc_match ("num_gangs ( %e )", &c->num_gangs_expr) == MATCH_YES)
continue;
@@ -574,82 +602,69 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, unsigned long long mask,
== MATCH_YES)
continue;
if ((mask & OMP_CLAUSE_COPY)
- && gfc_match_omp_variable_list ("copy (",
- &c->lists[OMP_LIST_COPY], true)
- == MATCH_YES)
- continue;
- if ((mask & OMP_CLAUSE_OACC_COPYIN)
- && gfc_match_omp_variable_list ("copyin (",
- &c->lists[OMP_LIST_OACC_COPYIN], true)
- == MATCH_YES)
+ && gfc_match ("copy ( ") == MATCH_YES
+ && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
+ OMP_MAP_FORCE_TOFROM))
continue;
if ((mask & OMP_CLAUSE_COPYOUT)
- && gfc_match_omp_variable_list ("copyout (",
- &c->lists[OMP_LIST_COPYOUT], true)
- == MATCH_YES)
+ && gfc_match ("copyout ( ") == MATCH_YES
+ && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
+ OMP_MAP_FORCE_FROM))
continue;
if ((mask & OMP_CLAUSE_CREATE)
- && gfc_match_omp_variable_list ("create (",
- &c->lists[OMP_LIST_CREATE], true)
- == MATCH_YES)
+ && gfc_match ("create ( ") == MATCH_YES
+ && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
+ OMP_MAP_FORCE_ALLOC))
continue;
if ((mask & OMP_CLAUSE_DELETE)
- && gfc_match_omp_variable_list ("delete (",
- &c->lists[OMP_LIST_DELETE], true)
- == MATCH_YES)
+ && gfc_match ("delete ( ") == MATCH_YES
+ && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
+ OMP_MAP_FORCE_DEALLOC))
continue;
if ((mask & OMP_CLAUSE_PRESENT)
- && gfc_match_omp_variable_list ("present (",
- &c->lists[OMP_LIST_PRESENT], true)
- == MATCH_YES)
+ && gfc_match ("present ( ") == MATCH_YES
+ && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
+ OMP_MAP_FORCE_PRESENT))
continue;
if ((mask & OMP_CLAUSE_PRESENT_OR_COPY)
- && gfc_match_omp_variable_list ("present_or_copy (",
- &c->lists[OMP_LIST_PRESENT_OR_COPY],
- true)
- == MATCH_YES)
+ && gfc_match ("present_or_copy ( ") == MATCH_YES
+ && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
+ OMP_MAP_TOFROM))
continue;
if ((mask & OMP_CLAUSE_PRESENT_OR_COPY)
- && gfc_match_omp_variable_list ("pcopy (",
- &c->lists[OMP_LIST_PRESENT_OR_COPY],
- true)
- == MATCH_YES)
+ && gfc_match ("pcopy ( ") == MATCH_YES
+ && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
+ OMP_MAP_TOFROM))
continue;
if ((mask & OMP_CLAUSE_PRESENT_OR_COPYIN)
- && gfc_match_omp_variable_list ("present_or_copyin (",
- &c->lists[OMP_LIST_PRESENT_OR_COPYIN],
- true)
- == MATCH_YES)
+ && gfc_match ("present_or_copyin ( ") == MATCH_YES
+ && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
+ OMP_MAP_TO))
continue;
if ((mask & OMP_CLAUSE_PRESENT_OR_COPYIN)
- && gfc_match_omp_variable_list ("pcopyin (",
- &c->lists[OMP_LIST_PRESENT_OR_COPYIN],
- true)
- == MATCH_YES)
+ && gfc_match ("pcopyin ( ") == MATCH_YES
+ && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
+ OMP_MAP_TO))
continue;
if ((mask & OMP_CLAUSE_PRESENT_OR_COPYOUT)
- && gfc_match_omp_variable_list ("present_or_copyout (",
- &c->lists[OMP_LIST_PRESENT_OR_COPYOUT],
- true)
- == MATCH_YES)
+ && gfc_match ("present_or_copyout ( ") == MATCH_YES
+ && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
+ OMP_MAP_FROM))
continue;
if ((mask & OMP_CLAUSE_PRESENT_OR_COPYOUT)
- && gfc_match_omp_variable_list ("pcopyout (",
- &c->lists[OMP_LIST_PRESENT_OR_COPYOUT],
- true)
- == MATCH_YES)
+ && gfc_match ("pcopyout ( ") == MATCH_YES
+ && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
+ OMP_MAP_FROM))
continue;
if ((mask & OMP_CLAUSE_PRESENT_OR_CREATE)
- && gfc_match_omp_variable_list ("present_or_create (",
- &c->lists[OMP_LIST_PRESENT_OR_CREATE],
- true)
- == MATCH_YES)
+ && gfc_match ("present_or_create ( ") == MATCH_YES
+ && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
+ OMP_MAP_ALLOC))
continue;
if ((mask & OMP_CLAUSE_PRESENT_OR_CREATE)
- && gfc_match_omp_variable_list ("pcreate (",
- &c->lists[OMP_LIST_PRESENT_OR_CREATE],
- true)
- == MATCH_YES)
+ && gfc_match ("pcreate ( ") == MATCH_YES
+ && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
+ OMP_MAP_ALLOC))
continue;
if ((mask & OMP_CLAUSE_DEVICEPTR)
&& gfc_match_omp_variable_list ("deviceptr (",
@@ -1112,20 +1127,20 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, unsigned long long mask,
#define OACC_PARALLEL_CLAUSES \
(OMP_CLAUSE_IF | OMP_CLAUSE_ASYNC | OMP_CLAUSE_NUM_GANGS \
| OMP_CLAUSE_NUM_WORKERS | OMP_CLAUSE_VECTOR_LENGTH | OMP_CLAUSE_REDUCTION \
- | OMP_CLAUSE_COPY | OMP_CLAUSE_OACC_COPYIN | OMP_CLAUSE_COPYOUT \
+ | OMP_CLAUSE_COPY | OMP_CLAUSE_COPYIN | OMP_CLAUSE_COPYOUT \
| OMP_CLAUSE_CREATE | OMP_CLAUSE_PRESENT | OMP_CLAUSE_PRESENT_OR_COPY \
| OMP_CLAUSE_PRESENT_OR_COPYIN | OMP_CLAUSE_PRESENT_OR_COPYOUT \
| OMP_CLAUSE_PRESENT_OR_CREATE | OMP_CLAUSE_DEVICEPTR | OMP_CLAUSE_PRIVATE \
| OMP_CLAUSE_FIRSTPRIVATE | OMP_CLAUSE_DEFAULT | OMP_CLAUSE_WAIT)
#define OACC_KERNELS_CLAUSES \
(OMP_CLAUSE_IF | OMP_CLAUSE_ASYNC | OMP_CLAUSE_DEVICEPTR \
- | OMP_CLAUSE_COPY | OMP_CLAUSE_OACC_COPYIN | OMP_CLAUSE_COPYOUT \
+ | OMP_CLAUSE_COPY | OMP_CLAUSE_COPYIN | OMP_CLAUSE_COPYOUT \
| OMP_CLAUSE_CREATE | OMP_CLAUSE_PRESENT | OMP_CLAUSE_PRESENT_OR_COPY \
| OMP_CLAUSE_PRESENT_OR_COPYIN | OMP_CLAUSE_PRESENT_OR_COPYOUT \
| OMP_CLAUSE_PRESENT_OR_CREATE | OMP_CLAUSE_DEFAULT | OMP_CLAUSE_WAIT)
#define OACC_DATA_CLAUSES \
(OMP_CLAUSE_IF | OMP_CLAUSE_DEVICEPTR | OMP_CLAUSE_COPY \
- | OMP_CLAUSE_OACC_COPYIN | OMP_CLAUSE_COPYOUT | OMP_CLAUSE_CREATE \
+ | OMP_CLAUSE_COPYIN | OMP_CLAUSE_COPYOUT | OMP_CLAUSE_CREATE \
| OMP_CLAUSE_PRESENT | OMP_CLAUSE_PRESENT_OR_COPY \
| OMP_CLAUSE_PRESENT_OR_COPYIN | OMP_CLAUSE_PRESENT_OR_COPYOUT \
| OMP_CLAUSE_PRESENT_OR_CREATE)
@@ -1140,7 +1155,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, unsigned long long mask,
(OACC_LOOP_CLAUSES | OACC_KERNELS_CLAUSES)
#define OACC_HOST_DATA_CLAUSES OMP_CLAUSE_USE_DEVICE
#define OACC_DECLARE_CLAUSES \
- (OMP_CLAUSE_COPY | OMP_CLAUSE_OACC_COPYIN | OMP_CLAUSE_COPYOUT \
+ (OMP_CLAUSE_COPY | OMP_CLAUSE_COPYIN | OMP_CLAUSE_COPYOUT \
| OMP_CLAUSE_CREATE | OMP_CLAUSE_DEVICEPTR | OMP_CLAUSE_DEVICE_RESIDENT \
| OMP_CLAUSE_PRESENT | OMP_CLAUSE_PRESENT_OR_COPY \
| OMP_CLAUSE_PRESENT_OR_COPYIN | OMP_CLAUSE_PRESENT_OR_COPYOUT \
@@ -1148,7 +1163,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, unsigned long long mask,
#define OACC_UPDATE_CLAUSES \
(OMP_CLAUSE_IF | OMP_CLAUSE_ASYNC | OMP_CLAUSE_HOST | OMP_CLAUSE_OACC_DEVICE)
#define OACC_ENTER_DATA_CLAUSES \
- (OMP_CLAUSE_IF | OMP_CLAUSE_ASYNC | OMP_CLAUSE_WAIT | OMP_CLAUSE_OACC_COPYIN \
+ (OMP_CLAUSE_IF | OMP_CLAUSE_ASYNC | OMP_CLAUSE_WAIT | OMP_CLAUSE_COPYIN \
| OMP_CLAUSE_CREATE | OMP_CLAUSE_PRESENT_OR_COPYIN \
| OMP_CLAUSE_PRESENT_OR_CREATE)
#define OACC_EXIT_DATA_CLAUSES \
@@ -1160,7 +1175,8 @@ match
gfc_match_oacc_parallel_loop (void)
{
gfc_omp_clauses *c;
- if (gfc_match_omp_clauses (&c, OACC_PARALLEL_LOOP_CLAUSES) != MATCH_YES)
+ if (gfc_match_omp_clauses (&c, OACC_PARALLEL_LOOP_CLAUSES, false, false,
+ true) != MATCH_YES)
return MATCH_ERROR;
new_st.op = EXEC_OACC_PARALLEL_LOOP;
@@ -1173,7 +1189,8 @@ match
gfc_match_oacc_parallel (void)
{
gfc_omp_clauses *c;
- if (gfc_match_omp_clauses (&c, OACC_PARALLEL_CLAUSES) != MATCH_YES)
+ if (gfc_match_omp_clauses (&c, OACC_PARALLEL_CLAUSES, false, false, true)
+ != MATCH_YES)
return MATCH_ERROR;
new_st.op = EXEC_OACC_PARALLEL;
@@ -1186,7 +1203,8 @@ match
gfc_match_oacc_kernels_loop (void)
{
gfc_omp_clauses *c;
- if (gfc_match_omp_clauses (&c, OACC_KERNELS_LOOP_CLAUSES) != MATCH_YES)
+ if (gfc_match_omp_clauses (&c, OACC_KERNELS_LOOP_CLAUSES, false, false,
+ true) != MATCH_YES)
return MATCH_ERROR;
new_st.op = EXEC_OACC_KERNELS_LOOP;
@@ -1199,7 +1217,8 @@ match
gfc_match_oacc_kernels (void)
{
gfc_omp_clauses *c;
- if (gfc_match_omp_clauses (&c, OACC_KERNELS_CLAUSES) != MATCH_YES)
+ if (gfc_match_omp_clauses (&c, OACC_KERNELS_CLAUSES, false, false, true)
+ != MATCH_YES)
return MATCH_ERROR;
new_st.op = EXEC_OACC_KERNELS;
@@ -1212,7 +1231,8 @@ match
gfc_match_oacc_data (void)
{
gfc_omp_clauses *c;
- if (gfc_match_omp_clauses (&c, OACC_DATA_CLAUSES) != MATCH_YES)
+ if (gfc_match_omp_clauses (&c, OACC_DATA_CLAUSES, false, false, true)
+ != MATCH_YES)
return MATCH_ERROR;
new_st.op = EXEC_OACC_DATA;
@@ -1225,7 +1245,8 @@ match
gfc_match_oacc_host_data (void)
{
gfc_omp_clauses *c;
- if (gfc_match_omp_clauses (&c, OACC_HOST_DATA_CLAUSES) != MATCH_YES)
+ if (gfc_match_omp_clauses (&c, OACC_HOST_DATA_CLAUSES, false, false, true)
+ != MATCH_YES)
return MATCH_ERROR;
new_st.op = EXEC_OACC_HOST_DATA;
@@ -1238,7 +1259,8 @@ match
gfc_match_oacc_loop (void)
{
gfc_omp_clauses *c;
- if (gfc_match_omp_clauses (&c, OACC_LOOP_CLAUSES) != MATCH_YES)
+ if (gfc_match_omp_clauses (&c, OACC_LOOP_CLAUSES, false, false, true)
+ != MATCH_YES)
return MATCH_ERROR;
new_st.op = EXEC_OACC_LOOP;
@@ -1251,7 +1273,8 @@ match
gfc_match_oacc_declare (void)
{
gfc_omp_clauses *c;
- if (gfc_match_omp_clauses (&c, OACC_DECLARE_CLAUSES) != MATCH_YES)
+ if (gfc_match_omp_clauses (&c, OACC_DECLARE_CLAUSES, false, false, true)
+ != MATCH_YES)
return MATCH_ERROR;
new_st.ext.omp_clauses = c;
@@ -1264,7 +1287,8 @@ match
gfc_match_oacc_update (void)
{
gfc_omp_clauses *c;
- if (gfc_match_omp_clauses (&c, OACC_UPDATE_CLAUSES) != MATCH_YES)
+ if (gfc_match_omp_clauses (&c, OACC_UPDATE_CLAUSES, false, false, true)
+ != MATCH_YES)
return MATCH_ERROR;
new_st.op = EXEC_OACC_UPDATE;
@@ -1277,7 +1301,8 @@ match
gfc_match_oacc_enter_data (void)
{
gfc_omp_clauses *c;
- if (gfc_match_omp_clauses (&c, OACC_ENTER_DATA_CLAUSES) != MATCH_YES)
+ if (gfc_match_omp_clauses (&c, OACC_ENTER_DATA_CLAUSES, false, false, true)
+ != MATCH_YES)
return MATCH_ERROR;
new_st.op = EXEC_OACC_ENTER_DATA;
@@ -1290,7 +1315,8 @@ match
gfc_match_oacc_exit_data (void)
{
gfc_omp_clauses *c;
- if (gfc_match_omp_clauses (&c, OACC_EXIT_DATA_CLAUSES) != MATCH_YES)
+ if (gfc_match_omp_clauses (&c, OACC_EXIT_DATA_CLAUSES, false, false, true)
+ != MATCH_YES)
return MATCH_ERROR;
new_st.op = EXEC_OACC_EXIT_DATA;
@@ -2692,7 +2718,8 @@ resolve_omp_udr_clause (gfc_omp_namelist *n, gfc_namespace *ns,
static void
resolve_omp_clauses (gfc_code *code, locus *where,
- gfc_omp_clauses *omp_clauses, gfc_namespace *ns)
+ gfc_omp_clauses *omp_clauses, gfc_namespace *ns,
+ bool openacc = false)
{
gfc_omp_namelist *n;
gfc_expr_list *el;
@@ -2794,7 +2821,7 @@ resolve_omp_clauses (gfc_code *code, locus *where,
&& list != OMP_LIST_LASTPRIVATE
&& list != OMP_LIST_ALIGNED
&& list != OMP_LIST_DEPEND
- && list != OMP_LIST_MAP
+ && (list != OMP_LIST_MAP || openacc)
&& list != OMP_LIST_FROM
&& list != OMP_LIST_TO)
for (n = omp_clauses->lists[list]; n; n = n->next)
@@ -2941,53 +2968,59 @@ resolve_omp_clauses (gfc_code *code, locus *where,
case OMP_LIST_TO:
case OMP_LIST_FROM:
for (; n != NULL; n = n->next)
- if (n->expr)
- {
- if (!gfc_resolve_expr (n->expr)
- || n->expr->expr_type != EXPR_VARIABLE
- || n->expr->ref == NULL
- || n->expr->ref->next
- || n->expr->ref->type != REF_ARRAY)
- gfc_error ("'%s' in %s clause at %L is not a proper "
- "array section", n->sym->name, name, where);
- else if (n->expr->ref->u.ar.codimen)
- gfc_error ("Coarrays not supported in %s clause at %L",
- name, where);
- else
- {
- int i;
- gfc_array_ref *ar = &n->expr->ref->u.ar;
- for (i = 0; i < ar->dimen; i++)
- if (ar->stride[i])
- {
- gfc_error ("Stride should not be specified for "
- "array section in %s clause at %L",
- name, where);
- break;
- }
- else if (ar->dimen_type[i] != DIMEN_ELEMENT
- && ar->dimen_type[i] != DIMEN_RANGE)
- {
- gfc_error ("'%s' in %s clause at %L is not a "
- "proper array section",
- n->sym->name, name, where);
- break;
- }
- else if (list == OMP_LIST_DEPEND
- && ar->start[i]
- && ar->start[i]->expr_type == EXPR_CONSTANT
- && ar->end[i]
- && ar->end[i]->expr_type == EXPR_CONSTANT
- && mpz_cmp (ar->start[i]->value.integer,
- ar->end[i]->value.integer) > 0)
- {
- gfc_error ("'%s' in DEPEND clause at %L is a zero "
- "size array section", n->sym->name,
- where);
- break;
- }
- }
- }
+ {
+ if (n->expr)
+ {
+ if (!gfc_resolve_expr (n->expr)
+ || n->expr->expr_type != EXPR_VARIABLE
+ || n->expr->ref == NULL
+ || n->expr->ref->next
+ || n->expr->ref->type != REF_ARRAY)
+ gfc_error ("'%s' in %s clause at %L is not a proper "
+ "array section", n->sym->name, name, where);
+ else if (n->expr->ref->u.ar.codimen)
+ gfc_error ("Coarrays not supported in %s clause at %L",
+ name, where);
+ else
+ {
+ int i;
+ gfc_array_ref *ar = &n->expr->ref->u.ar;
+ for (i = 0; i < ar->dimen; i++)
+ if (ar->stride[i])
+ {
+ gfc_error ("Stride should not be specified for "
+ "array section in %s clause at %L",
+ name, where);
+ break;
+ }
+ else if (ar->dimen_type[i] != DIMEN_ELEMENT
+ && ar->dimen_type[i] != DIMEN_RANGE)
+ {
+ gfc_error ("'%s' in %s clause at %L is not a "
+ "proper array section",
+ n->sym->name, name, where);
+ break;
+ }
+ else if (list == OMP_LIST_DEPEND
+ && ar->start[i]
+ && ar->start[i]->expr_type == EXPR_CONSTANT
+ && ar->end[i]
+ && ar->end[i]->expr_type == EXPR_CONSTANT
+ && mpz_cmp (ar->start[i]->value.integer,
+ ar->end[i]->value.integer) > 0)
+ {
+ gfc_error ("'%s' in DEPEND clause at %L is a "
+ "zero size array section",
+ n->sym->name, where);
+ break;
+ }
+ }
+ }
+ else if (openacc)
+ resolve_oacc_data_clauses (n->sym, *where,
+ clause_names[list]);
+ }
+
if (list != OMP_LIST_DEPEND)
for (n = omp_clauses->lists[list]; n != NULL; n = n->next)
{
@@ -4407,7 +4440,7 @@ resolve_oacc_loop(gfc_code *code)
int collapse;
if (code->ext.omp_clauses)
- resolve_omp_clauses (code, &code->loc, code->ext.omp_clauses, NULL);
+ resolve_omp_clauses (code, &code->loc, code->ext.omp_clauses, NULL, true);
do_code = code->block->next;
collapse = code->ext.omp_clauses->collapse;
@@ -4451,6 +4484,7 @@ gfc_resolve_oacc_declare (gfc_namespace *ns)
loc = ns->oacc_declare_clauses->ext.loc;
+ /* FIXME: handle omp_list_map. */
for (list = OMP_LIST_DATA_CLAUSE_FIRST;
list <= OMP_LIST_DEVICE_RESIDENT; list++)
for (n = ns->oacc_declare_clauses->lists[list]; n; n = n->next)
@@ -4507,7 +4541,8 @@ gfc_resolve_oacc_directive (gfc_code *code, gfc_namespace *ns ATTRIBUTE_UNUSED)
case EXEC_OACC_UPDATE:
case EXEC_OACC_ENTER_DATA:
case EXEC_OACC_EXIT_DATA:
- resolve_omp_clauses (code, &code->loc, code->ext.omp_clauses, NULL);
+ resolve_omp_clauses (code, &code->loc, code->ext.omp_clauses, NULL,
+ true);
break;
case EXEC_OACC_PARALLEL_LOOP:
case EXEC_OACC_KERNELS_LOOP:
@@ -1743,36 +1743,6 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
enum omp_clause_map_kind kind;
switch (list)
{
- case OMP_LIST_COPY:
- kind = OMP_CLAUSE_MAP_FORCE_TOFROM;
- break;
- case OMP_LIST_OACC_COPYIN:
- kind = OMP_CLAUSE_MAP_FORCE_TO;
- break;
- case OMP_LIST_COPYOUT:
- kind = OMP_CLAUSE_MAP_FORCE_FROM;
- break;
- case OMP_LIST_CREATE:
- kind = OMP_CLAUSE_MAP_FORCE_ALLOC;
- break;
- case OMP_LIST_DELETE:
- kind = OMP_CLAUSE_MAP_FORCE_DEALLOC;
- break;
- case OMP_LIST_PRESENT:
- kind = OMP_CLAUSE_MAP_FORCE_PRESENT;
- break;
- case OMP_LIST_PRESENT_OR_COPY:
- kind = OMP_CLAUSE_MAP_TOFROM;
- break;
- case OMP_LIST_PRESENT_OR_COPYIN:
- kind = OMP_CLAUSE_MAP_TO;
- break;
- case OMP_LIST_PRESENT_OR_COPYOUT:
- kind = OMP_CLAUSE_MAP_FROM;
- break;
- case OMP_LIST_PRESENT_OR_CREATE:
- kind = OMP_CLAUSE_MAP_ALLOC;
- break;
case OMP_LIST_DEVICEPTR:
kind = OMP_CLAUSE_MAP_FORCE_DEVICEPTR;
break;
@@ -2142,6 +2112,24 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
case OMP_MAP_TOFROM:
OMP_CLAUSE_MAP_KIND (node) = OMP_CLAUSE_MAP_TOFROM;
break;
+ case OMP_MAP_FORCE_ALLOC:
+ OMP_CLAUSE_MAP_KIND (node) = OMP_CLAUSE_MAP_FORCE_ALLOC;
+ break;
+ case OMP_MAP_FORCE_DEALLOC:
+ OMP_CLAUSE_MAP_KIND (node) = OMP_CLAUSE_MAP_FORCE_DEALLOC;
+ break;
+ case OMP_MAP_FORCE_TO:
+ OMP_CLAUSE_MAP_KIND (node) = OMP_CLAUSE_MAP_FORCE_TO;
+ break;
+ case OMP_MAP_FORCE_FROM:
+ OMP_CLAUSE_MAP_KIND (node) = OMP_CLAUSE_MAP_FORCE_FROM;
+ break;
+ case OMP_MAP_FORCE_TOFROM:
+ OMP_CLAUSE_MAP_KIND (node) = OMP_CLAUSE_MAP_FORCE_TOFROM;
+ break;
+ case OMP_MAP_FORCE_PRESENT:
+ OMP_CLAUSE_MAP_KIND (node) = OMP_CLAUSE_MAP_FORCE_PRESENT;
+ break;
default:
gcc_unreachable ();
}
new file mode 100644
@@ -0,0 +1,41 @@
+! { dg-do compile }
+program test
+ implicit none
+ integer :: a(10), b(10, 10), c(3:7), i
+
+ !$acc parallel copy(a(1:5))
+ !$acc end parallel
+ !$acc parallel copy(a(1 + 0 : 5 + 2))
+ !$acc end parallel
+ !$acc parallel copy(a(:3))
+ !$acc end parallel
+ !$acc parallel copy(a(3:))
+ !$acc end parallel
+ !$acc parallel copy(a(:))
+ !$acc end parallel
+ !$acc parallel copy(a(2:3,2:3))
+ ! { dg-error "Rank mismatch" "" { target *-*-* } 16 }
+ ! { dg-error "'a' in MAP clause" "" { target *-*-* } 16 }
+ !$acc end parallel
+ !$acc parallel copy (a(:11)) ! { dg-warning "Upper array reference" }
+ !$acc end parallel
+ !$acc parallel copy (a(i:))
+ !$acc end parallel
+
+ !$acc parallel copy (a(:b))
+ ! { dg-error "Array index" "" { target *-*-* } 25 }
+ ! { dg-error "'a' in MAP clause" "" { target *-*-* } 25 }
+ !$acc end parallel
+
+ !$acc parallel copy (b(1:3,2:4))
+ !$acc end parallel
+ !$acc parallel copy (b(2:3))
+ ! { dg-error "Rank mismatch" "" { target *-*-* } 32 }
+ ! { dg-error "'b' in MAP clause" "" { target *-*-* } 32 }
+ !$acc end parallel
+ !$acc parallel copy (b(1:, 4:6))
+ !$acc end parallel
+
+ !$acc parallel copy (c(2:)) ! { dg-warning "Lower array reference" }
+ !$acc end parallel
+end program test
new file mode 100644
@@ -0,0 +1,109 @@
+subroutine test(aas)
+ implicit none
+
+ integer :: i, j(10), k(10, 10), aas(*)
+ integer, save :: tp
+ !$omp threadprivate(tp)
+ integer, parameter :: p = 1
+
+ type t
+ integer :: i, j(10)
+ end type t
+
+ type(t) :: tt
+
+ !$omp target map(i)
+ !$omp end target
+
+ !$omp target map(j)
+ !$omp end target
+
+ !$omp target map(p) ! { dg-error "Object 'p' is not a variable" }
+ !$omp end target
+
+ !$omp target map(j(1))
+ !$omp end target
+
+ !$omp target map(j(i))
+ !$omp end target
+
+ !$omp target map(j(i:))
+ !$omp end target
+
+ !$omp target map(j(:i))
+ !$omp end target
+
+ !$omp target map(j(i:i+1))
+ !$omp end target
+
+ !$omp target map(j(11)) ! { dg-warning "out of bounds" }
+ !$omp end target
+
+ !$omp target map(j(:11)) ! { dg-warning "out of bounds" }
+ !$omp end target
+
+ !$omp target map(j(0:)) ! { dg-warning "out of bounds" }
+ !$omp end target
+
+ !$omp target map(j(5:4)) ! { dg-error "Lower bound of OpenMP array section in greater than upper" "" { xfail *-*-* } }
+ !$omp end target
+
+ !$omp target map(j(5:))
+ !$omp end target
+
+ !$omp target map(j(:5))
+ !$omp end target
+
+ !$omp target map(j(:))
+ !$omp end target
+
+ !$omp target map(j(1:9:2)) ! { dg-error "Stride should not be specified for array section in MAP clause" }
+ !$omp end target
+
+ !$omp target map(aas(5:))
+ !$omp end target
+ ! { dg-error "Rightmost upper bound of assumed size array section not specified" "" { target *-*-* } 63 }
+ ! { dg-error "'aas' in MAP clause at \\\(1\\\) is not a proper array section" "" { target *-*-* } 63 }
+
+ !$omp target map(aas(:))
+ !$omp end target
+ ! { dg-error "Rightmost upper bound of assumed size array section not specified" "" { target *-*-* } 68 }
+ ! { dg-error "'aas' in MAP clause at \\\(1\\\) is not a proper array section" "" { target *-*-* } 68 }
+
+ !$omp target map(aas) ! { dg-error "The upper bound in the last dimension must appear" "" { xfail *-*-* } }
+ !$omp end target
+
+ !$omp target map(aas(5:7))
+ !$omp end target
+
+ !$omp target map(aas(:7))
+ !$omp end target
+
+ !$omp target map(k(5:))
+ !$omp end target
+ ! { dg-error "Rank mismatch in array reference" "" { target *-*-* } 82 }
+ ! { dg-error "'k' in MAP clause at \\\(1\\\) is not a proper array section" "" { target *-*-* } 82 }
+
+ !$omp target map(k(5:,:,3))
+ !$omp end target
+ ! { dg-error "Rank mismatch in array reference" "" { target *-*-* } 87 }
+ ! { dg-error "'k' in MAP clause at \\\(1\\\) is not a proper array section" "" { target *-*-* } 87 }
+
+ !$omp target map(tt)
+ !$omp end target
+
+ !$omp target map(tt%i) ! { dg-error "Syntax error in OpenMP variable list" }
+ !$omp end target ! { dg-bogus "Unexpected !\\\$OMP END TARGET statement" "" { xfail *-*-* } }
+
+ !$omp target map(tt%j) ! { dg-error "Syntax error in OpenMP variable list" }
+ !$omp end target ! { dg-bogus "Unexpected !\\\$OMP END TARGET statement" "" { xfail *-*-* } }
+
+ !$omp target map(tt%j(1)) ! { dg-bogus "Syntax error in OpenMP variable list" "" { xfail *-*-* } }
+ !$omp end target ! { dg-bogus "Unexpected !\\\$OMP END TARGET statement" "" { xfail *-*-* } }
+
+ !$omp target map(tt%j(1:)) ! { dg-bogus "Syntax error in OpenMP variable list" "" { xfail *-*-* } }
+ !$omp end target ! { dg-bogus "Unexpected !\\\$OMP END TARGET statement" "" { xfail *-*-* } }
+
+ !$omp target map(tp) ! { dg-error "THREADPRIVATE object 'tp' in MAP clause" }
+ !$omp end target
+end subroutine test