>From 5ba154b9af6499f567172b92f9abcf362584be58 Mon Sep 17 00:00:00 2001
From: Ilmir Usmanov <i.usmanov@samsung.com>
Date: Tue, 8 Apr 2014 17:08:02 +0400
Subject: [PATCH] Subarrays
---
gcc/fortran/dump-parse-tree.c | 55 +++--
gcc/fortran/gfortran.h | 21 +-
gcc/fortran/match.h | 1 +
gcc/fortran/openmp.c | 292 +++++++++++++++++++++++---
gcc/fortran/parse.c | 17 +-
gcc/fortran/resolve.c | 3 +
gcc/fortran/st.c | 1 +
gcc/fortran/trans-openmp.c | 185 +++++++++++++++-
gcc/fortran/trans.c | 1 +
gcc/testsuite/gfortran.dg/goacc/subarrays.f95 | 36 ++++
gcc/testsuite/gfortran.dg/gomp/map-1.f90 | 101 +++++++++
gcc/testsuite/gfortran.dg/gomp/target-1.f90 | 21 ++
12 files changed, 674 insertions(+), 60 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/goacc/subarrays.f95
create mode 100644 gcc/testsuite/gfortran.dg/gomp/map-1.f90
create mode 100644 gcc/testsuite/gfortran.dg/gomp/target-1.f90
@@ -1023,6 +1023,17 @@ show_namelist (gfc_namelist *n)
fprintf (dumpfile, "%s", n->sym->name);
}
+static void
+show_expr_list (gfc_expr_list *el)
+{
+ for (; el->next; el = el->next)
+ {
+ show_expr (el->expr);
+ fputc (',', dumpfile);
+ }
+ show_expr (el->expr);
+}
+
/* Show OpenMP or OpenACC clauses. */
@@ -1043,6 +1054,12 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses)
show_expr (omp_clauses->final_expr);
fputc (')', dumpfile);
}
+ if (omp_clauses->device_id)
+ {
+ fputs (" DEVICE(", dumpfile);
+ show_expr (omp_clauses->device_id);
+ fputc (')', dumpfile);
+ }
if (omp_clauses->num_threads)
{
fputs (" NUM_THREADS(", dumpfile);
@@ -1148,28 +1165,35 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses)
}
fprintf (dumpfile, " DEFAULT(%s)", type);
}
- if (omp_clauses->tile_list)
+ for (int kind = 0; kind < OMP_MAP_LIST_LAST; kind++)
{
- gfc_expr_list *list;
- fputs (" TILE(", dumpfile);
- for (list = omp_clauses->tile_list; list; list = list->next)
+ const char *type;
+ if (omp_clauses->map_lists[kind] == NULL)
+ continue;
+
+ switch (kind)
{
- show_expr (list->expr);
- if (list->next)
- fputs (", ", dumpfile);
+ case OMP_MAP_LIST_ALLOC: type = "ALLOC"; break;
+ case OMP_MAP_LIST_TO: type = "TO"; break;
+ case OMP_MAP_LIST_FROM: type = "FROM"; break;
+ case OMP_MAP_LIST_TOFROM: type = "TOFROM"; break;
+ default:
+ gcc_unreachable ();
}
+ fprintf (dumpfile, " MAP(%s:", type);
+ show_expr_list (omp_clauses->map_lists[kind]);
+ fputc (')', dumpfile);
+ }
+ if (omp_clauses->tile_list)
+ {
+ fputs (" TILE(", dumpfile);
+ show_expr_list (omp_clauses->tile_list);
fputc (')', dumpfile);
}
if (omp_clauses->wait_list)
{
- gfc_expr_list *list;
fputs (" WAIT(", dumpfile);
- for (list = omp_clauses->wait_list; list; list = list->next)
- {
- show_expr (list->expr);
- if (list->next)
- fputs (", ", dumpfile);
- }
+ show_expr_list (omp_clauses->wait_list);
fputc (')', dumpfile);
}
if (omp_clauses->seq)
@@ -1286,6 +1310,7 @@ show_omp_node (int level, gfc_code *c)
case EXEC_OMP_PARALLEL_WORKSHARE: name = "PARALLEL WORKSHARE"; break;
case EXEC_OMP_SECTIONS: name = "SECTIONS"; break;
case EXEC_OMP_SINGLE: name = "SINGLE"; break;
+ case EXEC_OMP_TARGET: name = "TARGET"; break;
case EXEC_OMP_TASK: name = "TASK"; break;
case EXEC_OMP_TASKWAIT: name = "TASKWAIT"; break;
case EXEC_OMP_TASKYIELD: name = "TASKYIELD"; break;
@@ -1316,6 +1341,7 @@ show_omp_node (int level, gfc_code *c)
case EXEC_OMP_SINGLE:
case EXEC_OMP_WORKSHARE:
case EXEC_OMP_PARALLEL_WORKSHARE:
+ case EXEC_OMP_TARGET:
case EXEC_OMP_TASK:
omp_clauses = c->ext.omp_clauses;
break;
@@ -2368,6 +2394,7 @@ show_code_node (int level, gfc_code *c)
case EXEC_OMP_PARALLEL_WORKSHARE:
case EXEC_OMP_SECTIONS:
case EXEC_OMP_SINGLE:
+ case EXEC_OMP_TARGET:
case EXEC_OMP_TASK:
case EXEC_OMP_TASKWAIT:
case EXEC_OMP_TASKYIELD:
@@ -217,6 +217,7 @@ typedef enum
ST_OMP_PARALLEL, ST_OMP_PARALLEL_DO, ST_OMP_PARALLEL_SECTIONS,
ST_OMP_PARALLEL_WORKSHARE, ST_OMP_SECTIONS, ST_OMP_SECTION, ST_OMP_SINGLE,
ST_OMP_THREADPRIVATE, ST_OMP_WORKSHARE, ST_OMP_TASK, ST_OMP_END_TASK,
+ ST_OMP_TARGET, ST_OMP_END_TARGET,
ST_OMP_TASKWAIT, ST_OMP_TASKYIELD, ST_PROCEDURE, ST_GENERIC, ST_CRITICAL,
ST_END_CRITICAL, ST_GET_FCN_CHARACTERISTICS, ST_LOCK, ST_UNLOCK, ST_NONE
}
@@ -1084,6 +1085,22 @@ enum
OMP_LIST_NUM
};
+/* OpenMP 4.0: map clause kind.
+ OpenACC 2.0: data clauses kind. */
+enum gfc_omp_clause_map_kind
+{
+ /* If not already present, allocate. */
+ OMP_MAP_LIST_ALLOC,
+ /* ..., and copy to device. */
+ OMP_MAP_LIST_TO,
+ /* ..., and copy from device. */
+ OMP_MAP_LIST_FROM,
+ /* ..., and copy to and from device. */
+ OMP_MAP_LIST_TOFROM,
+ /* End marker. */
+ OMP_MAP_LIST_LAST
+};
+
/* Because a symbol can belong to multiple namelists, they must be
linked externally to the symbol itself. */
@@ -1112,8 +1129,10 @@ typedef struct gfc_omp_clauses
struct gfc_expr *final_expr;
struct gfc_expr *num_threads;
gfc_namelist *lists[OMP_LIST_NUM];
+ gfc_expr_list *map_lists[OMP_MAP_LIST_LAST];
enum gfc_omp_sched_kind sched_kind;
struct gfc_expr *chunk_size;
+ struct gfc_expr *device_id;
enum gfc_omp_default_sharing default_sharing;
int collapse;
bool nowait, ordered, untied, mergeable;
@@ -2170,7 +2189,7 @@ typedef enum
EXEC_OMP_PARALLEL_SECTIONS, EXEC_OMP_PARALLEL_WORKSHARE,
EXEC_OMP_SECTIONS, EXEC_OMP_SINGLE, EXEC_OMP_WORKSHARE,
EXEC_OMP_ATOMIC, EXEC_OMP_BARRIER, EXEC_OMP_END_NOWAIT,
- EXEC_OMP_END_SINGLE, EXEC_OMP_TASK, EXEC_OMP_TASKWAIT,
+ EXEC_OMP_END_SINGLE, EXEC_OMP_TASK, EXEC_OMP_TARGET, EXEC_OMP_TASKWAIT,
EXEC_OMP_TASKYIELD
}
gfc_exec_op;
@@ -152,6 +152,7 @@ match gfc_match_omp_parallel_sections (void);
match gfc_match_omp_parallel_workshare (void);
match gfc_match_omp_sections (void);
match gfc_match_omp_single (void);
+match gfc_match_omp_target (void);
match gfc_match_omp_task (void);
match gfc_match_omp_taskwait (void);
match gfc_match_omp_taskyield (void);
@@ -69,6 +69,7 @@ gfc_free_omp_clauses (gfc_omp_clauses *c)
gfc_free_expr (c->final_expr);
gfc_free_expr (c->num_threads);
gfc_free_expr (c->chunk_size);
+ gfc_free_expr (c->device_id);
gfc_free_expr (c->async_expr);
gfc_free_expr (c->gang_expr);
gfc_free_expr (c->worker_expr);
@@ -81,6 +82,9 @@ gfc_free_omp_clauses (gfc_omp_clauses *c)
for (i = 0; i < OMP_LIST_NUM; i++)
gfc_free_namelist (c->lists[i]);
+ for (i = 0; i < OMP_MAP_LIST_LAST; i++)
+ gfc_free_expr_list (c->map_lists[i]);
+
gfc_free_expr_list (c->wait_list);
gfc_free_expr_list (c->tile_list);
@@ -196,7 +200,7 @@ cleanup:
}
static match
-match_oacc_expr_list (const char *str, gfc_expr_list **list, bool allow_asterisk)
+match_omp_expr_list (const char *str, gfc_expr_list **list, bool allow_asterisk)
{
gfc_expr_list *head, *tail, *p;
locus old_loc;
@@ -248,7 +252,7 @@ match_oacc_expr_list (const char *str, gfc_expr_list **list, bool allow_asterisk
return MATCH_YES;
syntax:
- gfc_error ("Syntax error in OpenACC expression list at %C");
+ gfc_error ("Syntax error in expression list at %C");
cleanup:
gfc_free_expr_list (head);
@@ -294,33 +298,37 @@ match_oacc_clause_gang (gfc_omp_clauses *cp)
#define OMP_CLAUSE_MERGEABLE (1 << 15)
/* OpenACC 2.0 clauses. */
-#define OMP_CLAUSE_ASYNC (1 << 16)
-#define OMP_CLAUSE_NUM_GANGS (1 << 17)
-#define OMP_CLAUSE_NUM_WORKERS (1 << 18)
-#define OMP_CLAUSE_VECTOR_LENGTH (1 << 19)
-#define OMP_CLAUSE_COPY (1 << 20)
-#define OMP_CLAUSE_COPYOUT (1 << 21)
-#define OMP_CLAUSE_CREATE (1 << 22)
-#define OMP_CLAUSE_PRESENT (1 << 23)
-#define OMP_CLAUSE_PRESENT_OR_COPY (1 << 24)
-#define OMP_CLAUSE_PRESENT_OR_COPYIN (1 << 25)
-#define OMP_CLAUSE_PRESENT_OR_COPYOUT (1 << 26)
-#define OMP_CLAUSE_PRESENT_OR_CREATE (1 << 27)
-#define OMP_CLAUSE_DEVICEPTR (1 << 28)
-#define OMP_CLAUSE_GANG (1 << 29)
-#define OMP_CLAUSE_WORKER (1 << 30)
-#define OMP_CLAUSE_VECTOR (1 << 31)
-#define OMP_CLAUSE_SEQ (1LL << 32)
-#define OMP_CLAUSE_INDEPENDENT (1LL << 33)
-#define OMP_CLAUSE_USE_DEVICE (1LL << 34)
-#define OMP_CLAUSE_DEVICE_RESIDENT (1LL << 35)
-#define OMP_CLAUSE_HOST (1LL << 36)
-#define OMP_CLAUSE_DEVICE (1LL << 37)
-#define OMP_CLAUSE_OACC_COPYIN (1LL << 38)
-#define OMP_CLAUSE_WAIT (1LL << 39)
-#define OMP_CLAUSE_DELETE (1LL << 40)
-#define OMP_CLAUSE_AUTO (1LL << 41)
-#define OMP_CLAUSE_TILE (1LL << 42)
+#define OMP_CLAUSE_ASYNC (1 << 16)
+#define OMP_CLAUSE_NUM_GANGS (1 << 17)
+#define OMP_CLAUSE_NUM_WORKERS (1 << 18)
+#define OMP_CLAUSE_VECTOR_LENGTH (1 << 19)
+#define OMP_CLAUSE_COPY (1 << 20)
+#define OMP_CLAUSE_COPYOUT (1 << 21)
+#define OMP_CLAUSE_CREATE (1 << 22)
+#define OMP_CLAUSE_PRESENT (1 << 23)
+#define OMP_CLAUSE_PRESENT_OR_COPY (1 << 24)
+#define OMP_CLAUSE_PRESENT_OR_COPYIN (1 << 25)
+#define OMP_CLAUSE_PRESENT_OR_COPYOUT (1 << 26)
+#define OMP_CLAUSE_PRESENT_OR_CREATE (1 << 27)
+#define OMP_CLAUSE_DEVICEPTR (1 << 28)
+#define OMP_CLAUSE_GANG (1 << 29)
+#define OMP_CLAUSE_WORKER (1 << 30)
+#define OMP_CLAUSE_VECTOR (1 << 31)
+#define OMP_CLAUSE_SEQ (1LL << 32)
+#define OMP_CLAUSE_INDEPENDENT (1LL << 33)
+#define OMP_CLAUSE_USE_DEVICE (1LL << 34)
+#define OMP_CLAUSE_DEVICE_RESIDENT (1LL << 35)
+#define OMP_CLAUSE_HOST (1LL << 36)
+#define OMP_CLAUSE_OACC_DEVICE (1LL << 37)
+#define OMP_CLAUSE_OACC_COPYIN (1LL << 38)
+#define OMP_CLAUSE_WAIT (1LL << 39)
+#define OMP_CLAUSE_DELETE (1LL << 40)
+#define OMP_CLAUSE_AUTO (1LL << 41)
+#define OMP_CLAUSE_TILE (1LL << 42)
+
+/* OpenMP 4.0 clauses. */
+#define OMP_CLAUSE_DEVICE (1LL << 43)
+#define OMP_CLAUSE_MAP (1LL << 44)
/* Match OpenMP and OpenACC directive clauses. MASK is a bitmask of
clauses that are allowed for a particular directive. */
@@ -393,6 +401,9 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, long long mask)
if ((mask & OMP_CLAUSE_FINAL) && c->final_expr == NULL
&& gfc_match ("final ( %e )", &c->final_expr) == MATCH_YES)
continue;
+ if ((mask & OMP_CLAUSE_DEVICE) && c->device_id == NULL
+ && gfc_match ("device ( %e )", &c->device_id) == MATCH_YES)
+ continue;
if ((mask & OMP_CLAUSE_NUM_THREADS) && c->num_threads == NULL
&& gfc_match ("num_threads ( %e )", &c->num_threads) == MATCH_YES)
continue;
@@ -535,13 +546,13 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, long long mask)
&c->lists[OMP_LIST_HOST], true)
== MATCH_YES)
continue;
- if ((mask & OMP_CLAUSE_DEVICE)
+ 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_omp_expr_list ("tile (", &c->tile_list, true) == MATCH_YES)
continue;
if ((mask & OMP_CLAUSE_SEQ) && !c->seq
&& gfc_match ("seq") == MATCH_YES)
@@ -568,7 +579,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, long long mask)
&& gfc_match ("wait") == MATCH_YES)
{
c->wait = true;
- match_oacc_expr_list (" (", &c->wait_list, false);
+ match_omp_expr_list (" (", &c->wait_list, false);
continue;
}
old_loc = gfc_current_locus;
@@ -700,6 +711,23 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, long long mask)
else
gfc_current_locus = old_loc;
}
+ old_loc = gfc_current_locus;
+ if ((mask & OMP_CLAUSE_MAP)
+ && gfc_match ("map ( ") == MATCH_YES)
+ {
+ enum gfc_omp_clause_map_kind kind = OMP_MAP_LIST_TOFROM;
+ if (gfc_match ("alloc : ") == MATCH_YES)
+ kind = OMP_MAP_LIST_ALLOC;
+ if (gfc_match ("to : ") == MATCH_YES)
+ kind = OMP_MAP_LIST_TO;
+ if (gfc_match ("from : ") == MATCH_YES)
+ kind = OMP_MAP_LIST_FROM;
+ if (gfc_match ("tofrom : ") == MATCH_YES)
+ kind = OMP_MAP_LIST_TOFROM;
+ if (match_omp_expr_list ("", &c->map_lists[kind], false) == MATCH_YES)
+ continue;
+ gfc_current_locus = old_loc;
+ }
if ((mask & OMP_CLAUSE_ORDERED) && !c->ordered
&& gfc_match ("ordered") == MATCH_YES)
{
@@ -794,7 +822,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, long long mask)
| OMP_CLAUSE_PRESENT_OR_COPYIN | OMP_CLAUSE_PRESENT_OR_COPYOUT \
| OMP_CLAUSE_PRESENT_OR_CREATE)
#define OACC_UPDATE_CLAUSES \
- (OMP_CLAUSE_IF | OMP_CLAUSE_ASYNC | OMP_CLAUSE_HOST | OMP_CLAUSE_DEVICE)
+ (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_CREATE | OMP_CLAUSE_PRESENT_OR_COPYIN \
@@ -814,6 +842,9 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, long long mask)
#define OMP_SECTIONS_CLAUSES \
(OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE \
| OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION)
+#define OMP_TARGET_CLAUSES \
+ ( OMP_CLAUSE_IF | OMP_CLAUSE_DEVICE | OMP_CLAUSE_MAP)
+#define OMP_TARGET_DATA_CLAUSES OMP_TARGET_CLAUSES
#define OMP_TASK_CLAUSES \
(OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE | OMP_CLAUSE_SHARED \
| OMP_CLAUSE_IF | OMP_CLAUSE_DEFAULT | OMP_CLAUSE_UNTIED \
@@ -1013,6 +1044,18 @@ gfc_match_omp_parallel (void)
match
+gfc_match_omp_target (void)
+{
+ gfc_omp_clauses *c;
+ if (gfc_match_omp_clauses (&c, OMP_TARGET_CLAUSES) != MATCH_YES)
+ return MATCH_ERROR;
+ new_st.op = EXEC_OMP_TARGET;
+ new_st.ext.omp_clauses = c;
+ return MATCH_YES;
+}
+
+
+match
gfc_match_omp_task (void)
{
gfc_omp_clauses *c;
@@ -1352,6 +1395,23 @@ oacc_is_loop (gfc_code *code)
|| code->op == EXEC_OACC_LOOP;
}
+static const char*
+map_list_to_ascii (gfc_code *code, int list)
+{
+ gcc_assert (code->op == EXEC_OMP_TARGET);
+
+ switch (list)
+ {
+ case OMP_MAP_LIST_ALLOC:
+ case OMP_MAP_LIST_TO:
+ case OMP_MAP_LIST_FROM:
+ case OMP_MAP_LIST_TOFROM:
+ return ("MAP");
+ default:
+ gcc_unreachable ();
+ }
+}
+
static void
resolve_oacc_scalar_int_expr (gfc_expr *expr, const char *clause)
{
@@ -1438,6 +1498,31 @@ resolve_oacc_data_clauses (gfc_symbol *sym, locus loc, const char *name)
}
static void
+resolve_omp_map_clauses (gfc_symbol *sym, locus loc)
+{
+ const char *name = "MAP";
+ if (sym->ts.type == BT_DERIVED && sym->attr.allocatable)
+ gfc_error ("ALLOCATABLE object '%s' of derived type in %s clause at %L",
+ sym->name, name, &loc);
+ if ((sym->ts.type == BT_ASSUMED && sym->attr.allocatable)
+ || (sym->ts.type == BT_CLASS && CLASS_DATA (sym)
+ && CLASS_DATA (sym)->attr.allocatable))
+ gfc_error ("ALLOCATABLE object '%s' of polymorphic type "
+ "in %s clause at %L", sym->name, name, &loc);
+ check_symbol_not_pointer (sym, loc, name);
+ if (sym->as && sym->as->type == AS_ASSUMED_RANK)
+ gfc_error ("Assumed rank array '%s' in %s clause at %L",
+ sym->name, name, &loc);
+ if (sym->as && sym->as->type == AS_DEFERRED && sym->attr.pointer
+ && !sym->attr.contiguous)
+ gfc_error ("Noncontiguous deferred shape array '%s' in %s clause at %L",
+ sym->name, name, &loc);
+ if (sym->attr.threadprivate)
+ gfc_error ("Threadprivate variable '%s' is not allowed in %s clause at %L",
+ sym->name, name, &loc);
+}
+
+static void
resolve_oacc_deviceptr_clause (gfc_symbol *sym, locus loc, const char *name)
{
if (sym->attr.pointer
@@ -1466,6 +1551,58 @@ resolve_oacc_deviceptr_clause (gfc_symbol *sym, locus loc, const char *name)
check_array_not_assumed (sym, loc, name);
}
+static void
+resolve_omp_array_section (gfc_array_ref *ar, gfc_code *code,
+ const char *clause, const char *sym_name,
+ bool component)
+{
+ int i;
+ const char *str;
+
+ switch (code->op)
+ {
+ case EXEC_OACC_KERNELS:
+ case EXEC_OACC_PARALLEL:
+ case EXEC_OACC_DATA:
+ case EXEC_OACC_CACHE:
+ str = "OpenACC subarray";
+ break;
+ default:
+ str = "OpenMP array section";
+ }
+ if (ar->type == AR_UNKNOWN)
+ {
+ gfc_error ("Expression in %s clause is not %s of "
+ "array '%s' at %L", clause, str, sym_name, &code->loc);
+ return;
+ }
+ if (component && ar->type == AR_FULL)
+ {
+ gfc_error ("Component of derived type '%s' in %s clause must be single "
+ "array element or %s at %L", sym_name, clause, str,
+ &code->loc);
+ return;
+ }
+ for (i = 0; i < ar->as->rank; i++)
+ {
+ gfc_expr *start = ar->start[i];
+ gfc_expr *end = ar->end[i];
+ if (ar->stride[i])
+ {
+ gfc_error ("Stride is not allowed in %s at %L", str, &ar->c_where[i]);
+ continue;
+ }
+ /* Since stride is not allowed, lower bound cannot be greater
+ than upper one. */
+ if (start && end
+ && mpz_cmp (start->value.integer, end->value.integer) > 0)
+ gfc_error ("Lower bound of %s in greater than "
+ "upper (%ld > %ld) at %L", str,
+ mpz_get_si (start->value.integer),
+ mpz_get_si (end->value.integer), &ar->c_where[i]);
+ }
+}
+
/* OpenMP directive resolving routines. */
static void
@@ -1501,6 +1638,8 @@ resolve_omp_clauses (gfc_code *code)
gfc_error ("FINAL clause at %L requires a scalar LOGICAL expression",
&expr->where);
}
+ if (omp_clauses->device_id)
+ resolve_oacc_scalar_int_expr (omp_clauses->device_id, "DEVICE");
if (omp_clauses->num_threads)
{
gfc_expr *expr = omp_clauses->num_threads;
@@ -1598,6 +1737,90 @@ resolve_omp_clauses (gfc_code *code)
else
n->sym->mark = 1;
}
+
+ for (list = 0; list < OMP_MAP_LIST_LAST; list++)
+ for (el = omp_clauses->map_lists[list]; el; el = el->next)
+ {
+ gfc_ref *ref;
+ gfc_symbol *sym;
+ bool component = false;
+
+ gfc_resolve_expr (el->expr);
+
+ if (el->expr->expr_type != EXPR_VARIABLE)
+ {
+ gfc_error ("Expression in %s clause is not a variable at %L",
+ map_list_to_ascii (code, list), &code->loc);
+ continue;
+ }
+
+ sym = el->expr->symtree->n.sym;
+ sym->mark = 0;
+ if (sym->attr.flavor != FL_VARIABLE && !sym->attr.proc_pointer)
+ {
+ gfc_error ("Object '%s' is not a variable at %L", sym->name,
+ &code->loc);
+ continue;
+ }
+
+ if (el->expr->ts.type == BT_CLASS)
+ {
+ gfc_error ("CLASS object '%s' cannot appear in %s clause at %L",
+ sym->name, map_list_to_ascii (code, list), &code->loc);
+ continue;
+ }
+
+ if (el->expr->rank != 0 && !gfc_is_simply_contiguous(el->expr, false))
+ {
+ gfc_error ("Object %s in %s clause is not contiguous at %L",
+ sym->name, map_list_to_ascii (code, list), &code->loc);
+ continue;
+ }
+
+ for (ref = el->expr->ref; ref; ref = ref->next)
+ if (ref->type == REF_ARRAY)
+ resolve_omp_array_section (&ref->u.ar, code,
+ map_list_to_ascii (code, list),
+ sym->name, component);
+ else if (ref->type == REF_COMPONENT)
+ {
+ if (!ref->u.c.component->as)
+ {
+ gfc_error ("Component '%s' of derived type in %s clause must "
+ "be single array element or array section at %L",
+ ref->u.c.component->name,
+ map_list_to_ascii (code, list), &code->loc);
+ continue;
+ }
+ component = true;
+ }
+ else if (ref->type == REF_SUBSTRING)
+ gfc_error ("Substrings are not allowed in array section in %s "
+ "clause at %L", map_list_to_ascii (code, list),
+ &code->loc);
+ else
+ gcc_unreachable ();
+ }
+
+
+ for (list = 0; list < OMP_MAP_LIST_LAST; list++)
+ for (el = omp_clauses->map_lists[list]; el; el = el->next)
+ {
+ gfc_symbol *sym;
+
+ if (el->expr->expr_type != EXPR_VARIABLE)
+ continue;
+
+ sym = el->expr->symtree->n.sym;
+ if (sym->mark)
+ gfc_error ("Symbol '%s' present on multiple clauses at %L",
+ sym->name, &code->loc);
+ else
+ sym->mark = 1;
+
+ resolve_omp_map_clauses (sym, code->loc);
+ }
+
for (list = 0; list < OMP_LIST_NUM; list++)
if ((n = omp_clauses->lists[list]) != NULL)
{
@@ -2492,6 +2715,8 @@ switch (code->op)
return ST_OMP_MASTER;
case EXEC_OMP_SINGLE:
return ST_OMP_SINGLE;
+ case EXEC_OMP_TARGET:
+ return ST_OMP_TARGET;
case EXEC_OMP_TASK:
return ST_OMP_TASK;
case EXEC_OMP_WORKSHARE:
@@ -2934,6 +3159,7 @@ gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns ATTRIBUTE_UNUSED)
case EXEC_OMP_PARALLEL_SECTIONS:
case EXEC_OMP_SECTIONS:
case EXEC_OMP_SINGLE:
+ case EXEC_OMP_TARGET:
case EXEC_OMP_TASK:
if (code->ext.omp_clauses)
resolve_omp_clauses (code);
@@ -674,6 +674,7 @@ decode_omp_directive (void)
match ("end parallel", gfc_match_omp_eos, ST_OMP_END_PARALLEL);
match ("end sections", gfc_match_omp_end_nowait, ST_OMP_END_SECTIONS);
match ("end single", gfc_match_omp_end_single, ST_OMP_END_SINGLE);
+ match ("end target", gfc_match_omp_eos, ST_OMP_END_TARGET);
match ("end task", gfc_match_omp_eos, ST_OMP_END_TASK);
match ("end workshare", gfc_match_omp_end_nowait,
ST_OMP_END_WORKSHARE);
@@ -701,6 +702,7 @@ decode_omp_directive (void)
match ("single", gfc_match_omp_single, ST_OMP_SINGLE);
break;
case 't':
+ match ("target", gfc_match_omp_target, ST_OMP_TARGET);
match ("task", gfc_match_omp_task, ST_OMP_TASK);
match ("taskwait", gfc_match_omp_taskwait, ST_OMP_TASKWAIT);
match ("taskyield", gfc_match_omp_taskyield, ST_OMP_TASKYIELD);
@@ -1187,9 +1189,10 @@ next_statement (void)
case ST_OMP_CRITICAL: case ST_OMP_MASTER: case ST_OMP_SINGLE: \
case ST_OMP_DO: case ST_OMP_PARALLEL_DO: case ST_OMP_ATOMIC: \
case ST_OMP_WORKSHARE: case ST_OMP_PARALLEL_WORKSHARE: \
- case ST_OMP_TASK: case ST_CRITICAL: \
+ case ST_OMP_TARGET: case ST_OMP_TASK: case ST_CRITICAL: \
case ST_OACC_PARALLEL_LOOP: case ST_OACC_PARALLEL: case ST_OACC_KERNELS: \
- case ST_OACC_DATA: case ST_OACC_HOST_DATA: case ST_OACC_LOOP: case ST_OACC_KERNELS_LOOP
+ case ST_OACC_DATA: case ST_OACC_HOST_DATA: case ST_OACC_LOOP: \
+ case ST_OACC_KERNELS_LOOP
/* Declaration statements */
@@ -1788,6 +1791,9 @@ gfc_ascii_statement (gfc_statement st)
case ST_OMP_END_SINGLE:
p = "!$OMP END SINGLE";
break;
+ case ST_OMP_END_TARGET:
+ p = "!$OMP END TARGET";
+ break;
case ST_OMP_END_TASK:
p = "!$OMP END TASK";
break;
@@ -1824,6 +1830,9 @@ gfc_ascii_statement (gfc_statement st)
case ST_OMP_SINGLE:
p = "!$OMP SINGLE";
break;
+ case ST_OMP_TARGET:
+ p = "!$OMP TARGET";
+ break;
case ST_OMP_TASK:
p = "!$OMP TASK";
break;
@@ -4047,6 +4056,9 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only)
case ST_OMP_SINGLE:
omp_end_st = ST_OMP_END_SINGLE;
break;
+ case ST_OMP_TARGET:
+ omp_end_st = ST_OMP_END_TARGET;
+ break;
case ST_OMP_TASK:
omp_end_st = ST_OMP_END_TASK;
break;
@@ -4296,6 +4308,7 @@ parse_executable (gfc_statement st)
case ST_OMP_CRITICAL:
case ST_OMP_MASTER:
case ST_OMP_SINGLE:
+ case ST_OMP_TARGET:
case ST_OMP_TASK:
parse_omp_structured_block (st, false);
break;
@@ -9005,6 +9005,7 @@ gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns)
case EXEC_OMP_PARALLEL_WORKSHARE:
case EXEC_OMP_SECTIONS:
case EXEC_OMP_SINGLE:
+ case EXEC_OMP_TARGET:
case EXEC_OMP_TASK:
case EXEC_OMP_TASKWAIT:
case EXEC_OMP_TASKYIELD:
@@ -9760,6 +9761,7 @@ resolve_code (gfc_code *code, gfc_namespace *ns)
case EXEC_OMP_PARALLEL:
case EXEC_OMP_PARALLEL_DO:
case EXEC_OMP_PARALLEL_SECTIONS:
+ case EXEC_OMP_TARGET:
case EXEC_OMP_TASK:
omp_workshare_save = omp_workshare_flag;
omp_workshare_flag = 0;
@@ -10112,6 +10114,7 @@ resolve_code (gfc_code *code, gfc_namespace *ns)
case EXEC_OMP_PARALLEL_DO:
case EXEC_OMP_PARALLEL_SECTIONS:
case EXEC_OMP_PARALLEL_WORKSHARE:
+ case EXEC_OMP_TARGET:
case EXEC_OMP_TASK:
omp_workshare_save = omp_workshare_flag;
omp_workshare_flag = 0;
@@ -204,6 +204,7 @@ gfc_free_statement (gfc_code *p)
case EXEC_OMP_PARALLEL_SECTIONS:
case EXEC_OMP_SECTIONS:
case EXEC_OMP_SINGLE:
+ case EXEC_OMP_TARGET:
case EXEC_OMP_TASK:
case EXEC_OMP_WORKSHARE:
case EXEC_OMP_PARALLEL_WORKSHARE:
@@ -768,7 +768,7 @@ gfc_trans_omp_reduction_list (gfc_namelist *namelist, tree list,
static tree
gfc_trans_omp_map_clause_list (enum omp_clause_map_kind kind,
- gfc_namelist *namelist, tree list)
+ gfc_namelist *namelist, tree list, locus where)
{
for (; namelist != NULL; namelist = namelist->next)
if (namelist->sym->attr.referenced)
@@ -776,7 +776,7 @@ gfc_trans_omp_map_clause_list (enum omp_clause_map_kind kind,
tree t = gfc_trans_omp_variable (namelist->sym);
if (t != error_mark_node)
{
- tree node = build_omp_clause (input_location, OMP_CLAUSE_MAP);
+ tree node = build_omp_clause (where.lb->location, OMP_CLAUSE_MAP);
OMP_CLAUSE_DECL (node) = t;
OMP_CLAUSE_MAP_KIND (node) = kind;
list = gfc_trans_add_clause (node, list);
@@ -791,7 +791,7 @@ gfc_convert_expr_to_tree (stmtblock_t *block, gfc_expr *expr)
gfc_se se;
tree result;
- gfc_init_se (&se, NULL );
+ gfc_init_se (&se, NULL);
gfc_conv_expr (&se, expr);
gfc_add_block_to_block (block, &se.pre);
result = gfc_evaluate_now (se.expr, block);
@@ -801,6 +801,22 @@ gfc_convert_expr_to_tree (stmtblock_t *block, gfc_expr *expr)
}
static tree
+gfc_convert_array_section_to_array_ref (gfc_array_ref ar, gfc_expr *expr,
+ tree t)
+{
+ gfc_se se;
+ int i;
+ for (i = 0; i < ar.dimen; i++)
+ if (ar.start[i] == NULL)
+ ar.start[i] = ar.as->lower[i];
+ ar.type = AR_ELEMENT;
+ gfc_init_se (&se, NULL);
+ se.expr = t;
+ gfc_conv_array_ref (&se, &ar, expr, &expr->where);
+ return se.expr;
+}
+
+static tree
gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
locus where)
{
@@ -910,7 +926,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
default:
gcc_unreachable ();
}
- omp_clauses = gfc_trans_omp_map_clause_list (kind, n, omp_clauses);
+ omp_clauses = gfc_trans_omp_map_clause_list (kind, n, omp_clauses, where);
continue;
}
switch (list)
@@ -987,6 +1003,15 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
omp_clauses = gfc_trans_add_clause (c, omp_clauses);
}
+ if (clauses->device_id)
+ {
+ tree device_var =
+ gfc_convert_expr_to_tree (block, clauses->device_id);
+ c = build_omp_clause (where.lb->location, OMP_CLAUSE_DEVICE);
+ OMP_CLAUSE_DEVICE_ID (c)= device_var;
+ omp_clauses = gfc_trans_add_clause (c, omp_clauses);
+ }
+
if (clauses->num_threads)
{
tree num_threads;
@@ -1062,6 +1087,128 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
omp_clauses = gfc_trans_add_clause (c, omp_clauses);
}
+ for (int kind = OMP_MAP_LIST_ALLOC; kind < OMP_MAP_LIST_LAST; kind++)
+ {
+ enum omp_clause_map_kind type;
+ gfc_expr_list *el = clauses->map_lists[kind];
+
+ if (el == NULL)
+ continue;
+
+ switch (kind)
+ {
+ case OMP_MAP_LIST_ALLOC:
+ type = OMP_CLAUSE_MAP_ALLOC;
+ break;
+ case OMP_MAP_LIST_TO:
+ type = OMP_CLAUSE_MAP_TO;
+ break;
+ case OMP_MAP_LIST_FROM:
+ type = OMP_CLAUSE_MAP_FROM;
+ break;
+ case OMP_MAP_LIST_TOFROM:
+ type = OMP_CLAUSE_MAP_TOFROM;
+ break;
+ default:
+ gcc_unreachable ();
+ }
+ for (; el; el = el->next)
+ {
+ gfc_symbol *sym;
+ tree t, var_decl = NULL_TREE;
+ tree size = NULL_TREE, bias = NULL_TREE;
+
+ gcc_assert (el->expr->expr_type == EXPR_VARIABLE);
+ sym = el->expr->symtree->n.sym;
+
+ if (!sym->attr.referenced)
+ continue;
+
+ t = gfc_trans_omp_variable (sym);
+ if (el->expr->ref)
+ {
+ gfc_ref *ref = el->expr->ref;
+ for (; ref; ref = ref->next)
+ if (ref->type == REF_ARRAY)
+ if (ref->u.ar.type == AR_SECTION)
+ {
+ mpz_t ar_size, ar_kind, ar_bias;
+ bool computable;
+ int i;
+
+ /* In OpenMP implementation array sections are represented
+ as ARRAY_REF tree node with SIZE (in bytes).
+ Also one need to set bias of array section. */
+ var_decl = t;
+ t = gfc_convert_array_section_to_array_ref (ref->u.ar,
+ el->expr, t);
+ computable = gfc_array_size(el->expr, &ar_size);
+ gcc_assert (computable);
+ mpz_init_set_ui (ar_kind, el->expr->ts.kind);
+ mpz_init_set_ui (ar_bias, el->expr->ts.kind);
+ mpz_mul (ar_size, ar_size, ar_kind);
+ for (i = 0; i < ref->u.ar.dimen; i++)
+ {
+ mpz_t start, end, diff;
+ mpz_init (end);
+ mpz_init (diff);
+ mpz_init_set (start,
+ ref->u.ar.as->lower[i]->value.integer);
+ if (i < ref->u.ar.dimen - 1)
+ mpz_set (end, ref->u.ar.as->upper[i]->value.integer);
+ else
+ mpz_set (end, ref->u.ar.start[i]->value.integer);
+ mpz_sub (diff, end, start);
+ if (i < ref->u.ar.dimen - 1)
+ mpz_add_ui (diff, diff, 1);
+ mpz_mul (ar_bias, ar_bias, diff);
+ mpz_clear (start);
+ mpz_clear (end);
+ mpz_clear (diff);
+ }
+ size = gfc_conv_mpz_to_tree (ar_size, el->expr->ts.kind);
+ bias = gfc_conv_mpz_to_tree (ar_bias, el->expr->ts.kind);
+ mpz_clear (ar_size);
+ mpz_clear (ar_kind);
+ mpz_clear (ar_bias);
+ }
+ else if (ref->u.ar.type == AR_ELEMENT)
+ {
+ gfc_init_se (&se, NULL);
+ se.expr = t;
+ gfc_conv_array_ref (&se, &ref->u.ar, el->expr,
+ &el->expr->where);
+ t = se.expr;
+ size = build_int_cst (gfc_array_index_type,
+ gfc_index_integer_kind);
+ }
+ else if (ref->u.ar.type == AR_FULL)
+ ; /* Nothing to do: T already contains necessary data. */
+ else
+ gcc_unreachable ();
+ else
+ gcc_unreachable ();
+ }
+ if (t != error_mark_node)
+ {
+ tree node = build_omp_clause (where.lb->location, OMP_CLAUSE_MAP);
+ OMP_CLAUSE_DECL (node) = t;
+ OMP_CLAUSE_MAP_KIND (node) = type;
+ if (size)
+ OMP_CLAUSE_SIZE (node) = size;
+ omp_clauses = gfc_trans_add_clause (node, omp_clauses);
+ if (bias)
+ {
+ node = build_omp_clause (where.lb->location, OMP_CLAUSE_MAP);
+ OMP_CLAUSE_DECL (node) = var_decl;
+ OMP_CLAUSE_MAP_KIND (node) = OMP_CLAUSE_MAP_POINTER;
+ OMP_CLAUSE_SIZE (node) = bias;
+ omp_clauses = gfc_trans_add_clause (node, omp_clauses);
+ }
+ }
+ }
+ }
+
if (clauses->nowait)
{
c = build_omp_clause (where.lb->location, OMP_CLAUSE_NOWAIT);
@@ -1127,7 +1274,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
tree num_workers_var =
gfc_convert_expr_to_tree (block, clauses->num_workers_expr);
c = build_omp_clause (where.lb->location, OMP_CLAUSE_NUM_WORKERS);
- OMP_CLAUSE_NUM_WORKERS_EXPR (c)= num_workers_var;
+ OMP_CLAUSE_NUM_WORKERS_EXPR (c) = num_workers_var;
omp_clauses = gfc_trans_add_clause (c, omp_clauses);
}
if (clauses->vector_length_expr)
@@ -1135,7 +1282,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
tree vector_length_var =
gfc_convert_expr_to_tree (block, clauses->vector_length_expr);
c = build_omp_clause (where.lb->location, OMP_CLAUSE_VECTOR_LENGTH);
- OMP_CLAUSE_VECTOR_LENGTH_EXPR (c)= vector_length_var;
+ OMP_CLAUSE_VECTOR_LENGTH_EXPR (c) = vector_length_var;
omp_clauses = gfc_trans_add_clause (c, omp_clauses);
}
if (clauses->vector)
@@ -1145,7 +1292,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
tree vector_var =
gfc_convert_expr_to_tree (block, clauses->vector_expr);
c = build_omp_clause (where.lb->location, OMP_CLAUSE_VECTOR);
- OMP_CLAUSE_VECTOR_EXPR (c)= vector_var;
+ OMP_CLAUSE_VECTOR_EXPR (c) = vector_var;
omp_clauses = gfc_trans_add_clause (c, omp_clauses);
}
else
@@ -1161,7 +1308,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
tree worker_var =
gfc_convert_expr_to_tree (block, clauses->worker_expr);
c = build_omp_clause (where.lb->location, OMP_CLAUSE_WORKER);
- OMP_CLAUSE_WORKER_EXPR (c)= worker_var;
+ OMP_CLAUSE_WORKER_EXPR (c) = worker_var;
omp_clauses = gfc_trans_add_clause (c, omp_clauses);
}
else
@@ -1177,7 +1324,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
tree gang_var =
gfc_convert_expr_to_tree (block, clauses->gang_expr);
c = build_omp_clause (where.lb->location, OMP_CLAUSE_GANG);
- OMP_CLAUSE_GANG_EXPR (c)= gang_var;
+ OMP_CLAUSE_GANG_EXPR (c) = gang_var;
omp_clauses = gfc_trans_add_clause (c, omp_clauses);
}
else
@@ -1191,7 +1338,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
tree wait_var =
gfc_convert_expr_to_tree (block, clauses->non_clause_wait_expr);
c = build_omp_clause (where.lb->location, OMP_CLAUSE_WAIT);
- OMP_CLAUSE_WAIT_EXPR (c)= wait_var;
+ OMP_CLAUSE_WAIT_EXPR (c) = wait_var;
omp_clauses = gfc_trans_add_clause (c, omp_clauses);
}
@@ -2047,6 +2194,22 @@ gfc_trans_omp_single (gfc_code *code, gfc_omp_clauses *clauses)
}
static tree
+gfc_trans_omp_target (gfc_code *code)
+{
+ stmtblock_t block;
+ tree stmt, omp_clauses;
+
+ gfc_start_block (&block);
+ omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
+ code->loc);
+ stmt = gfc_trans_omp_code (code->block->next, true);
+ stmt = build2_loc (input_location, OMP_TARGET, void_type_node, stmt,
+ omp_clauses);
+ gfc_add_expr_to_block (&block, stmt);
+ return gfc_finish_block (&block);
+}
+
+static tree
gfc_trans_omp_task (gfc_code *code)
{
stmtblock_t block;
@@ -2302,6 +2465,8 @@ gfc_trans_omp_directive (gfc_code *code)
return gfc_trans_omp_sections (code, code->ext.omp_clauses);
case EXEC_OMP_SINGLE:
return gfc_trans_omp_single (code, code->ext.omp_clauses);
+ case EXEC_OMP_TARGET:
+ return gfc_trans_omp_target (code);
case EXEC_OMP_TASK:
return gfc_trans_omp_task (code);
case EXEC_OMP_TASKWAIT:
@@ -1843,6 +1843,7 @@ trans_code (gfc_code * code, tree cond)
case EXEC_OMP_PARALLEL_WORKSHARE:
case EXEC_OMP_SECTIONS:
case EXEC_OMP_SINGLE:
+ case EXEC_OMP_TARGET:
case EXEC_OMP_TASK:
case EXEC_OMP_TASKWAIT:
case EXEC_OMP_TASKYIELD:
new file mode 100644
@@ -0,0 +1,36 @@
+! { 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(:)) ! { dg-error "Syntax error in variable list" }
+ !$acc parallel copy(a(2:3,2:3)) ! { dg-error "Number of dimensions" }
+ !$acc end parallel
+ ! TODO: there must be warning
+ !$acc parallel copy (a(:11))
+ !$acc end parallel
+ !$acc parallel copy (a(i:))
+ !$acc end parallel
+
+ !$acc parallel copy (a(:b)) ! { dg-error "scalar INTEGER expression" }
+ !$acc end parallel
+
+ !$acc parallel copy (b(1:3,2:4))
+ !$acc end parallel
+ !$acc parallel copy (b(2:3)) ! { dg-error "Number of dimensions" }
+ !$acc end parallel
+ !$acc parallel copy (b(1:, 4:6)) ! { dg-warning "whole dimension" }
+ !$acc end parallel
+
+ ! TODO: there must be warning
+ !$acc parallel copy (c(2:))
+ !$acc end parallel
+end program test
\ No newline at end of file
new file mode 100644
@@ -0,0 +1,101 @@
+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 "Expression in MAP clause 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" }
+ !$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 is not allowed in OpenMP array section" }
+ !$omp end target
+
+ !$omp target map(aas(5:)) ! { dg-error "Rightmost upper bound of assumed size array section not specified" }
+ !$omp end target
+
+ !$omp target map(aas(:)) ! { dg-error "Rightmost upper bound of assumed size array section not specified" }
+ !$omp end target
+
+ !$omp target map(aas) ! { dg-error "The upper bound in the last dimension must appear" }
+ !$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:)) ! { dg-error "Rank mismatch in array reference" }
+ !$omp end target
+
+ !$omp target map(k(5:,:,3)) ! { dg-error "Rank mismatch in array reference" }
+ !$omp end target
+
+ !$omp target map(tt)
+ !$omp end target
+
+ !$omp target map(tt%i) ! { dg-error "must be single array element or array section" }
+ !$omp end target
+
+ !$omp target map(tt%j) ! { dg-error "must be single array element or OpenMP array section" }
+ !$omp end target
+
+ !$omp target map(tt%j(1))
+ !$omp end target
+
+ !$omp target map(tt%j(1:))
+ !$omp end target
+
+ !$omp target map(tp) ! { dg-error "Threadprivate variable" }
+ !$omp end target
+end subroutine test
\ No newline at end of file
new file mode 100644
@@ -0,0 +1,21 @@
+! { dg-additional-options "-fdump-tree-original" }
+
+program test
+ implicit none
+ integer :: i, j(10), k(10), l(10), m(10), n(10)
+ !$omp target if (.true.) device(1+1) map(to:j(1:)) map(from:k(:8)) map(tofrom:l(4:7)) &
+ !$omp& map(alloc:m(1)) map(n(:))
+ i = 1
+ !$omp end target
+end program test
+! { dg-final { scan-tree-dump-times "pragma omp target" 2 "original" } }
+! { dg-final { scan-tree-dump-times "pragma omp target data" 1 "original" } }
+! { dg-final { scan-tree-dump-times "if" 2 "original" } }
+! { dg-final { scan-tree-dump-times "device" 2 "original" } }
+! { dg-final { scan-tree-dump-times "map\\(tofrom:l\\)" 2 "original" } }
+! { dg-final { scan-tree-dump-times "map\\(tofrom:n\\)" 2 "original" } }
+! { dg-final { scan-tree-dump-times "map\\(to:j\\)" 2 "original" } }
+! { dg-final { scan-tree-dump-times "map\\(from:k\\)" 2 "original" } }
+! { dg-final { scan-tree-dump-times "map\\(alloc:m\\)" 2 "original" } }
+
+! { dg-final { cleanup-tree-dump "original" } }
\ No newline at end of file
--
1.8.3.2