On 07/11/2014 03:29 AM, Jakub Jelinek wrote:
> On Fri, Jul 11, 2014 at 12:11:10PM +0200, Thomas Schwinge wrote:
>> To avoid duplication of work: with Jakub's Fortran OpenMP 4 target
>> changes recently committed to trunk, and now merged into gomp-4_0-branch,
>> I have trimmed down Ilmir's patch to just the OpenACC bits, OpenMP 4
>> target changes removed, and TODO markers added to integrate into that.
>
> Resolving the TODO markers would be nice, indeed.
This patch has the openacc data clauses use the new openmp maps. In the
process of doing so, I removed a lot of the old OMP_LIST_ enums and
added a few OMP_MAP enums to match what the c frontend currently supports.
Thomas, is this OK for gomp-4_0-branch? There are no new regressions.
This patch doesn't depend on the nested function patch I posted a while ago.
>> Jakub, before your Fortran OpenMP 4 target changes, Ilmir had written the
>> test case gcc/testsuite/gfortran.dg/gomp/map-1.f90 (based on his
>> interpretation and implementation of OpenMP 4 target), which I have now
>> amended with XFAILs and changed error messages -- anything in there that
>> you'd like to see addressed for Fortran OpenMP 4 target?
>
>> + !$omp target map(j(5:4)) ! { dg-error "Lower bound of OpenMP array
>> section in greater than upper" "" { xfail *-*-* } }
>> + !$omp end target
>
> I think this isn't an error in Fortran, if low bound is above upper bound,
> then it is considered a zero size array section. Though supposedly for
> depend clause we might want to diagnose that.
>
>> + !$omp target map(aas) ! { dg-error "The upper bound in the last dimension
>> must appear" "" { xfail *-*-* } }
>> + !$omp end target
>
> Assumed-size in map without array section would be indeed nice thing to
> diagnose.
>
>> + !$omp target map(tt%i) ! { dg-error "Syntax error in OpenMP variable
>> list" }
>> + !$omp end target ! { dg-bogus "Unexpected !\\\$OMP END TARGET statement"
>> "" { xfail *-*-* } }
>
> Right now the parsing of !$omp directives in case of parsing error rejects
> the whole directive, perhaps it should be reconsidered unless it is a fatal
> error from which there is no easy way out.
>
>> + !$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 *-*-* } }
>
> These two are pending resolution on omp-lang, I had exchanged a few mails
> about it, I think we shouldn't support those for consistency with the C/C++
> support, where tt.j[1] or tt.j[1:] and similar is explicitly invalid.
Jakub, should I drop the map-1.f90 test?
Thanks,
Cesar
2014-07-23 Cesar Philippidis <[email protected]>
Thomas Schwinge <[email protected]>
Ilmir Usmanov <[email protected]>
gcc/fortran/
* gfortran.h (gfc_omp_map_op): Add 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.
(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_oacc_data_clauses): New function.
(gfc_match_omp_data_clauses): New function.
(gfc_match_omp_clauses): And an openacc argument. Treat openacc
data clauses as OMP maps.
(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): Likwise.
(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.
gcc/testsuite/
* gfortran.dg/goacc/subarrays.f95: New test.
* gfortran.dg/gomp/map-1.f90: New test.
diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
index c367139..d7f2182 100644
--- a/gcc/fortran/dump-parse-tree.c
+++ b/gcc/fortran/dump-parse-tree.c
@@ -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;
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index cc445e6..0cde668 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -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,
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 7b87e78..785456c 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -448,18 +448,177 @@ 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 OpenACC data clauses. */
+
+static bool
+gfc_match_oacc_data_clauses (unsigned long long mask, gfc_omp_clauses *c)
+{
+ if ((mask & OMP_CLAUSE_COPYIN)
+ && gfc_match ("copyin ( ") == MATCH_YES
+ && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
+ OMP_MAP_FORCE_TO))
+ return true;
+ if ((mask & OMP_CLAUSE_COPY)
+ && gfc_match ("copy ( ") == MATCH_YES
+ && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
+ OMP_MAP_FORCE_TOFROM))
+ return true;
+ if ((mask & OMP_CLAUSE_COPYOUT)
+ && gfc_match ("copyout ( ") == MATCH_YES
+ && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
+ OMP_MAP_FORCE_FROM))
+ return true;
+ if ((mask & OMP_CLAUSE_CREATE)
+ && gfc_match ("create ( ") == MATCH_YES
+ && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
+ OMP_MAP_FORCE_ALLOC))
+ return true;
+ if ((mask & OMP_CLAUSE_DELETE)
+ && gfc_match ("delete ( ") == MATCH_YES
+ && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
+ OMP_MAP_FORCE_DEALLOC))
+ return true;
+ if ((mask & OMP_CLAUSE_PRESENT)
+ && gfc_match ("present ( ") == MATCH_YES
+ && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
+ OMP_MAP_FORCE_PRESENT))
+ return true;
+ if ((mask & OMP_CLAUSE_PRESENT_OR_COPY)
+ && gfc_match ("present_or_copy ( ") == MATCH_YES
+ && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
+ OMP_MAP_TOFROM))
+ return true;
+ if ((mask & OMP_CLAUSE_PRESENT_OR_COPY)
+ && gfc_match ("pcopy ( ") == MATCH_YES
+ && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
+ OMP_MAP_TOFROM))
+ return true;
+ if ((mask & OMP_CLAUSE_PRESENT_OR_COPYIN)
+ && gfc_match ("present_or_copyin ( ") == MATCH_YES
+ && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
+ OMP_MAP_TO))
+ return true;
+ if ((mask & OMP_CLAUSE_PRESENT_OR_COPYIN)
+ && gfc_match ("pcopyin ( ") == MATCH_YES
+ && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
+ OMP_MAP_TO))
+ return true;
+ if ((mask & OMP_CLAUSE_PRESENT_OR_COPYOUT)
+ && gfc_match ("present_or_copyout ( ") == MATCH_YES
+ && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
+ OMP_MAP_FROM))
+ return true;
+ if ((mask & OMP_CLAUSE_PRESENT_OR_COPYOUT)
+ && gfc_match ("pcopyout ( ") == MATCH_YES
+ && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
+ OMP_MAP_FROM))
+ return true;
+ if ((mask & OMP_CLAUSE_PRESENT_OR_CREATE)
+ && gfc_match ("present_or_create ( ") == MATCH_YES
+ && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
+ OMP_MAP_ALLOC))
+ return true;
+ if ((mask & OMP_CLAUSE_PRESENT_OR_CREATE)
+ && gfc_match ("pcreate ( ") == MATCH_YES
+ && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
+ OMP_MAP_ALLOC))
+ return true;
+ /* TODO */
+ if ((mask & OMP_CLAUSE_DEVICEPTR)
+ && gfc_match_omp_variable_list ("deviceptr (",
+ &c->lists[OMP_LIST_DEVICEPTR], true)
+ == MATCH_YES)
+ return true;
+ /* TODO */
+ if ((mask & OMP_CLAUSE_HOST)
+ && gfc_match_omp_variable_list ("host (",
+ &c->lists[OMP_LIST_HOST], true)
+ == MATCH_YES)
+ return true;
+ /* TODO */
+ if ((mask & OMP_CLAUSE_OACC_DEVICE)
+ && gfc_match_omp_variable_list ("device (",
+ &c->lists[OMP_LIST_DEVICE], true)
+ == MATCH_YES)
+ return true;
+
+ return false;
+}
+
+/* Match OpenMP data clauses. */
+
+static bool
+gfc_match_omp_data_clauses (unsigned long long mask, gfc_omp_clauses *c)
+{
+ if ((mask & OMP_CLAUSE_COPYIN)
+ && gfc_match_omp_variable_list ("copyin (",
+ &c->lists[OMP_LIST_COPYIN], true)
+ == MATCH_YES)
+ return true;
+ if ((mask & OMP_CLAUSE_COPY)
+ && gfc_match_omp_variable_list ("copy (",
+ &c->lists[OMP_LIST_COPY], true)
+ == MATCH_YES)
+ return true;
+ if (mask & OMP_CLAUSE_COPYOUT)
+ gfc_error ("Invalid OpenMP clause COPYOUT");
+ if (mask & OMP_CLAUSE_CREATE)
+ gfc_error ("Invalid OpenMP clause CREATE");
+ if (mask & OMP_CLAUSE_DELETE)
+ gfc_error ("Invalid OpenMP clause DELETE");
+ if (mask & OMP_CLAUSE_PRESENT)
+ gfc_error ("Invalid OpenMP clause PRESENT");
+ if (mask & OMP_CLAUSE_PRESENT_OR_COPY)
+ gfc_error ("Invalid OpenMP clause PRESENT_OR_COPY");
+ if (mask & OMP_CLAUSE_PRESENT_OR_COPY)
+ gfc_error ("Invalid OpenMP clause PRESENT_OR_COPY");
+ if (mask & OMP_CLAUSE_PRESENT_OR_COPYIN)
+ gfc_error ("Invalid OpenMP clause PRESENT_OR_COPYIN");
+ if (mask & OMP_CLAUSE_PRESENT_OR_COPYIN)
+ gfc_error ("Invalid OpenMP clause PRESENT_OR_COPYIN");
+ if (mask & OMP_CLAUSE_PRESENT_OR_COPYOUT)
+ gfc_error ("Invalid OpenMP clause PRESENT_OR_COPYOUT");
+ if (mask & OMP_CLAUSE_PRESENT_OR_COPYOUT)
+ gfc_error ("Invalid OpenMP clause PRESENT_OR_COPYOUT");
+ if (mask & OMP_CLAUSE_PRESENT_OR_CREATE)
+ gfc_error ("Invalid OpenMP clause PRESENT_OR_CREATE");
+ if (mask & OMP_CLAUSE_PRESENT_OR_CREATE)
+ gfc_error ("Invalid OpenMP clause PRESENT_OR_CREATE");
+
+ 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;
@@ -533,181 +692,109 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, unsigned long long mask,
if ((mask & OMP_CLAUSE_NUM_THREADS) && c->num_threads == NULL
&& gfc_match ("num_threads ( %e )", &c->num_threads) == 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;
+ if ((mask & OMP_CLAUSE_NUM_WORKERS) && c->num_workers_expr == NULL
+ && gfc_match ("num_workers ( %e )", &c->num_workers_expr)
+ == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_TILE)
+ && match_oacc_expr_list ("tile (", &c->tile_list, true) == MATCH_YES)
+ continue;
+ if ((mask & OMP_CLAUSE_SEQ) && !c->seq
+ && gfc_match ("seq") == MATCH_YES)
+ {
+ c->seq = true;
+ needs_space = true;
+ continue;
+ }
+ if ((mask & OMP_CLAUSE_INDEPENDENT) && !c->independent
+ && gfc_match ("independent") == MATCH_YES)
+ {
+ c->independent = true;
+ needs_space = true;
+ continue;
+ }
+ if ((mask & OMP_CLAUSE_AUTO) && !c->par_auto
+ && gfc_match ("auto") == MATCH_YES)
+ {
+ c->par_auto = true;
+ needs_space = true;
+ continue;
+ }
+ if ((mask & OMP_CLAUSE_WAIT) && !c->wait
+ && gfc_match ("wait") == MATCH_YES)
+ {
+ c->wait = true;
+ match_oacc_expr_list (" (", &c->wait_list, false);
+ continue;
+ }
+ /* Common, in the sense that no special handling is required,
+ OpenACC and OpenMP data clauses. */
if ((mask & OMP_CLAUSE_PRIVATE)
&& gfc_match_omp_variable_list ("private (",
&c->lists[OMP_LIST_PRIVATE], true)
- == MATCH_YES)
+ == MATCH_YES)
continue;
if ((mask & OMP_CLAUSE_FIRSTPRIVATE)
&& gfc_match_omp_variable_list ("firstprivate (",
&c->lists[OMP_LIST_FIRSTPRIVATE],
true)
- == MATCH_YES)
+ == MATCH_YES)
continue;
if ((mask & OMP_CLAUSE_LASTPRIVATE)
&& gfc_match_omp_variable_list ("lastprivate (",
&c->lists[OMP_LIST_LASTPRIVATE],
true)
- == MATCH_YES)
+ == MATCH_YES)
continue;
if ((mask & OMP_CLAUSE_COPYPRIVATE)
&& gfc_match_omp_variable_list ("copyprivate (",
&c->lists[OMP_LIST_COPYPRIVATE],
true)
- == MATCH_YES)
+ == MATCH_YES)
continue;
if ((mask & OMP_CLAUSE_SHARED)
&& gfc_match_omp_variable_list ("shared (",
&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_NUM_GANGS) && c->num_gangs_expr == NULL
- && gfc_match ("num_gangs ( %e )", &c->num_gangs_expr) == MATCH_YES)
- continue;
- if ((mask & OMP_CLAUSE_NUM_WORKERS) && c->num_workers_expr == NULL
- && gfc_match ("num_workers ( %e )", &c->num_workers_expr)
== 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)
- continue;
- if ((mask & OMP_CLAUSE_COPYOUT)
- && gfc_match_omp_variable_list ("copyout (",
- &c->lists[OMP_LIST_COPYOUT], true)
- == MATCH_YES)
- continue;
- if ((mask & OMP_CLAUSE_CREATE)
- && gfc_match_omp_variable_list ("create (",
- &c->lists[OMP_LIST_CREATE], true)
- == MATCH_YES)
- continue;
- if ((mask & OMP_CLAUSE_DELETE)
- && gfc_match_omp_variable_list ("delete (",
- &c->lists[OMP_LIST_DELETE], true)
- == MATCH_YES)
- continue;
- if ((mask & OMP_CLAUSE_PRESENT)
- && gfc_match_omp_variable_list ("present (",
- &c->lists[OMP_LIST_PRESENT], true)
- == MATCH_YES)
- 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)
- continue;
- if ((mask & OMP_CLAUSE_PRESENT_OR_COPY)
- && gfc_match_omp_variable_list ("pcopy (",
- &c->lists[OMP_LIST_PRESENT_OR_COPY],
- true)
- == MATCH_YES)
- 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)
- continue;
- if ((mask & OMP_CLAUSE_PRESENT_OR_COPYIN)
- && gfc_match_omp_variable_list ("pcopyin (",
- &c->lists[OMP_LIST_PRESENT_OR_COPYIN],
- true)
- == MATCH_YES)
- 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)
- continue;
- if ((mask & OMP_CLAUSE_PRESENT_OR_COPYOUT)
- && gfc_match_omp_variable_list ("pcopyout (",
- &c->lists[OMP_LIST_PRESENT_OR_COPYOUT],
- true)
- == MATCH_YES)
- 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)
- continue;
- if ((mask & OMP_CLAUSE_PRESENT_OR_CREATE)
- && gfc_match_omp_variable_list ("pcreate (",
- &c->lists[OMP_LIST_PRESENT_OR_CREATE],
- true)
- == MATCH_YES)
+ if ((mask & OMP_CLAUSE_USE_DEVICE)
+ && gfc_match_omp_variable_list ("use_device (",
+ &c->lists[OMP_LIST_USE_DEVICE], true)
+ == MATCH_YES)
continue;
if ((mask & OMP_CLAUSE_DEVICEPTR)
&& gfc_match_omp_variable_list ("deviceptr (",
&c->lists[OMP_LIST_DEVICEPTR], true)
- == MATCH_YES)
- continue;
- if ((mask & OMP_CLAUSE_USE_DEVICE)
- && gfc_match_omp_variable_list ("use_device (",
- &c->lists[OMP_LIST_USE_DEVICE], true)
- == MATCH_YES)
+ == MATCH_YES)
continue;
if ((mask & OMP_CLAUSE_DEVICE_RESIDENT)
&& gfc_match_omp_variable_list ("device_resident (",
&c->lists[OMP_LIST_DEVICE_RESIDENT],
true)
- == MATCH_YES)
+ == MATCH_YES)
continue;
if ((mask & OMP_CLAUSE_HOST)
&& gfc_match_omp_variable_list ("host (",
&c->lists[OMP_LIST_HOST], true)
- == MATCH_YES)
+ == MATCH_YES)
continue;
if ((mask & OMP_CLAUSE_OACC_DEVICE)
&& gfc_match_omp_variable_list ("device (",
&c->lists[OMP_LIST_DEVICE], true)
- == MATCH_YES)
- continue;
- if ((mask & OMP_CLAUSE_TILE)
- && match_oacc_expr_list ("tile (", &c->tile_list, true) == MATCH_YES)
+ == MATCH_YES)
continue;
- if ((mask & OMP_CLAUSE_SEQ) && !c->seq
- && gfc_match ("seq") == MATCH_YES)
+ /* Both OpenACC and OpenMP handle the data clauses a bit differently.
+ Process them separately. */
+ if (openacc)
{
- c->seq = true;
- needs_space = true;
- continue;
- }
- if ((mask & OMP_CLAUSE_INDEPENDENT) && !c->independent
- && gfc_match ("independent") == MATCH_YES)
- {
- c->independent = true;
- needs_space = true;
- continue;
- }
- if ((mask & OMP_CLAUSE_AUTO) && !c->par_auto
- && gfc_match ("auto") == MATCH_YES)
- {
- c->par_auto = true;
- needs_space = true;
- continue;
- }
- if ((mask & OMP_CLAUSE_WAIT) && !c->wait
- && gfc_match ("wait") == MATCH_YES)
- {
- c->wait = true;
- match_oacc_expr_list (" (", &c->wait_list, false);
- continue;
+ if (gfc_match_oacc_data_clauses (mask, c))
+ continue;
}
+ else if (gfc_match_omp_data_clauses (mask, c))
+ continue;
old_loc = gfc_current_locus;
if ((mask & OMP_CLAUSE_REDUCTION)
&& gfc_match ("reduction ( ") == MATCH_YES)
@@ -1112,20 +1199,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 +1227,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 +1235,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 +1247,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 +1261,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 +1275,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 +1289,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 +1303,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 +1317,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 +1331,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 +1345,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 +1359,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 +1373,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 +1387,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 +2790,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 +2893,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 +3040,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 +4512,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;
@@ -4434,7 +4539,6 @@ resolve_oacc_wait (gfc_code *code)
resolve_oacc_positive_int_expr (el->expr, "WAIT");
}
-
void
gfc_resolve_oacc_declare (gfc_namespace *ns)
{
@@ -4451,6 +4555,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 +4612,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:
diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index aaf50d3..5f61877 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -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 ();
}
diff --git a/gcc/testsuite/gfortran.dg/goacc/subarrays.f95 b/gcc/testsuite/gfortran.dg/goacc/subarrays.f95
new file mode 100644
index 0000000..4b3ef42
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/subarrays.f95
@@ -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
diff --git a/gcc/testsuite/gfortran.dg/gomp/map-1.f90 b/gcc/testsuite/gfortran.dg/gomp/map-1.f90
new file mode 100644
index 0000000..de96ed2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/map-1.f90
@@ -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
