On 16.05.2014 19:44, Ilmir Usmanov wrote:
Hi Thomas!
On 16.05.2014 19:12, Thomas Schwinge wrote:
Hi Ilmir!
You recently indicated that you have already begun implementing OpenACC
subarray specifications in the GCC Fortran front end, but have not
been/are not currently able to complete that. Would you be willing to
share your WIP patch with Cesar, who is now working on this, so that he
doesn't have to duplicate your work?
Sure! I'm glad to know that my work won't go directly to trash.
BTW, another patch is still pending:
http://gcc.gnu.org/ml/gcc-patches/2014-04/msg00027.html
Cesar,
You can find the patch in attachment.
I started to implement sub-arrays in gfortran by implementing OpenMP
4.0 target map clause. This clause was already implemented in C/C++
FEs, so I could check the behavior. I don't know whether it's already
implemented in gfortran or not.
To represent OpenMP array sections (or OpenACC subarrays) I used
gfc_expr.
After implementing OpenMP target map clauses I was going to use it to
represent OpenACC data clauses, just as Thomas recommended in his
mail: http://gcc.gnu.org/ml/gcc-patches/2014-01/msg02040.html
I hope this will be useful for you. If you will have any question feel
free to ask.
Grüße,
Thomas
--
Ilmir.
>From 5ba154b9af6499f567172b92f9abcf362584be58 Mon Sep 17 00:00:00 2001
From: Ilmir Usmanov <i.usma...@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
diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
index b6679ab..bdc30c2 100644
--- a/gcc/fortran/dump-parse-tree.c
+++ b/gcc/fortran/dump-parse-tree.c
@@ -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:
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 69e77b7..0d92f8b 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -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;
diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h
index 80ba44f..6605617 100644
--- a/gcc/fortran/match.h
+++ b/gcc/fortran/match.h
@@ -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);
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 447faf8..fbba82f 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -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);
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index 65613d2..3434ceb 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -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;
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 9277cd4..745ecdc 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -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;
diff --git a/gcc/fortran/st.c b/gcc/fortran/st.c
index b582efe..77d58f1 100644
--- a/gcc/fortran/st.c
+++ b/gcc/fortran/st.c
@@ -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:
diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index 29364f4..0933529 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -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:
diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index 78b48d4..7b2ac43 100644
--- a/gcc/fortran/trans.c
+++ b/gcc/fortran/trans.c
@@ -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:
diff --git a/gcc/testsuite/gfortran.dg/goacc/subarrays.f95 b/gcc/testsuite/gfortran.dg/goacc/subarrays.f95
new file mode 100644
index 0000000..4740dab
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/subarrays.f95
@@ -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
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..bd30ef6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/map-1.f90
@@ -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
diff --git a/gcc/testsuite/gfortran.dg/gomp/target-1.f90 b/gcc/testsuite/gfortran.dg/gomp/target-1.f90
new file mode 100644
index 0000000..7f4439c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/target-1.f90
@@ -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
