This patch adds parsing and libgomp runtime calls for these directives,
sharing the existing implementation with runtime API calls. It also
includes support for the device_type and device_num clauses in the
Fortran front-end.
For the device_type clause, the current implementation limits usage to
accepting only a single clause per directive. While the OpenACC
specification states that device_type should modify the device for
subsequent clauses inside other directives or constructs, supporting
this behavior requires a larger refactoring and may be addressed in
the future.
The set directive does not yet support the default_async clause, as
further discussion is needed to agree on its semantics and libgomp
implementation.
Changes since v1:
- Addressed comments from Thomas Schwinge
- Addressed the note from Thomas Koenig :^)
gcc/ChangeLog:
* builtin-types.def (BT_FN_VOID_INT_INT): New definition.
* omp-builtins.def (BUILT_IN_GOACC_INIT): New builtin for
init directive.
(BUILT_IN_GOACC_SHUTDOWN): New builtin for shutdown directive.
(BUILT_IN_GOACC_SET_DEVICE_TYPE_DEVICE_NUM): New builtin for set
directive.
gcc/fortran/ChangeLog:
* dump-parse-tree.cc (show_omp_clauses): Dump OpenACC DEVICE_TYPE
and DEVICE_NUM clauses.
(show_omp_node): Handle INIT, SHUTDOWN, and SET directives.
(show_code_node): Likewise.
* frontend-passes.cc (gfc_code_walker): Walk device_num_expr for
INIT, SHUTDOWN, and SET directives.
* gfortran.h (enum gfc_statement): Add ST_OACC_INIT,
ST_OACC_SHUTDOWN, and ST_OACC_SET.
(gfc_omp_clauses): Add device_num_expr and oacc_device_type
fields.
(enum gfc_exec_op): Add EXEC_OACC_INIT, EXEC_OACC_SHUTDOWN, and
EXEC_OACC_SET.
* match.h (gfc_match_oacc_init): Declare.
(gfc_match_oacc_shutdown): Likewise.
(gfc_match_oacc_set): Likewise.
* openmp.cc (gfc_free_omp_clauses): Free device_num_expr.
(match_oacc_device_type_kind): New helper to parse OpenACC
device_type arguments.
(match_oacc_device_type): New helper to match the OpenACC
DEVICE_TYPE clause.
(enum omp_mask2): Add OMP_CLAUSE_DEVICE_NUM.
(gfc_match_omp_clauses): Match OpenACC DEVICE_TYPE and
DEVICE_NUM clauses.
(OACC_INIT_CLAUSES): New clause mask.
(OACC_SHUTDOWN_CLAUSES): Likewise.
(OACC_SET_CLAUSES): Likewise.
(gfc_match_oacc_init): New matcher.
(gfc_match_oacc_shutdown): Likewise.
(gfc_match_oacc_set): Likewise.
(resolve_omp_clauses): Resolve DEVICE_NUM; require at least one
of DEVICE_TYPE and DEVICE_NUM on SET.
(oacc_code_to_statement): Map new exec ops to statement codes.
(gfc_resolve_oacc_directive): Resolve INIT, SET, and SHUTDOWN
directives.
* parse.cc (decode_oacc_directive): Recognize init, set, and
shutdown directives.
(next_statement): Treat INIT, SET, and SHUTDOWN as executable
statements.
(gfc_ascii_statement): Add ASCII names for new directives.
(is_oacc): Recognize new exec ops.
* resolve.cc (gfc_resolve_blocks): Resolve INIT, SET, and
SHUTDOWN directives.
* st.cc (gfc_free_statement): Free clauses for new directives.
* trans-openmp.cc (gfc_trans_omp_clauses): Assert that
DEVICE_NUM and DEVICE_TYPE do not appear on construct clauses.
(gfc_trans_oacc_executable_directive): Lower INIT, SHUTDOWN, and
SET to GOACC builtins.
(gfc_trans_oacc_directive): Dispatch new directives.
* trans.cc (trans_code): Dispatch new directives.
* types.def (BT_FN_VOID_INT_INT): New definition.
libgomp/ChangeLog:
* libgomp.map (GOACC_2.5): Export GOACC_init, GOACC_shutdown, and
GOACC_set_device_type_device_num.
* libgomp_g.h (GOACC_init): Declare.
(GOACC_shutdown): Likewise.
(GOACC_set_device_type_device_num): Likewise.
* oacc-init.c (GOACC_DIRECTIVE_DEVICE_MASK): New macro for
supported device types.
(acc_init_1): Accept explicit device number argument.
(acc_shutdown_1): Shut down a single device or all devices of a
type.
(goacc_attach_host_thread_to_device): Whitespace fix.
(GOACC_init): New entry point for init directive.
(GOACC_shutdown): New entry point for shutdown directive.
(GOACC_set_device_type_device_num): New entry point for set
directive.
(acc_init): Pass default device number to acc_init_1.
(acc_shutdown): Pass default device number to acc_shutdown_1.
(acc_set_device_num): Whitespace fix.
(goacc_restore_bind): Whitespace fix.
(goacc_lazy_initialize): Pass default device number to acc_init_1.
* testsuite/libgomp.oacc-fortran/init-1.f90: New test.
* testsuite/libgomp.oacc-fortran/lib-1-directives.f90: New test.
* testsuite/libgomp.oacc-fortran/lib-4-directives.f90: New test.
* testsuite/libgomp.oacc-fortran/lib-5-directives.f90: New test.
* testsuite/libgomp.oacc-fortran/lib-5-init.f90: New test.
* testsuite/libgomp.oacc-fortran/set-1.f90: New test.
* testsuite/libgomp.oacc-fortran/shutdown-1.f90: New test.
gcc/testsuite/ChangeLog:
* gfortran.dg/goacc/acc-init-1.f90: New test.
* gfortran.dg/goacc/acc-init-clauses-1.f90: New test.
* gfortran.dg/goacc/acc-set-1.f90: New test.
* gfortran.dg/goacc/acc-set-clauses-1.f90: New test.
* gfortran.dg/goacc/acc-shutdown-1.f90: New test.
* gfortran.dg/goacc/acc-shutdown-clauses-1.f90: New test.
* gfortran.dg/goacc/uninit-if-clause.f95: Test INIT with
uninitialized IF clause.
* gfortran.dg/goacc/update-if_present-2.f90: Update expected
errors now that INIT and SHUTDOWN are recognized.
Signed-off-by: Sebastian Galindo <[email protected]>
---
gcc/builtin-types.def | 2 +
gcc/fortran/dump-parse-tree.cc | 31 +++
gcc/fortran/frontend-passes.cc | 11 +
gcc/fortran/gfortran.h | 4 +
gcc/fortran/match.h | 3 +
gcc/fortran/openmp.cc | 139 +++++++++++-
gcc/fortran/parse.cc | 20 +-
gcc/fortran/resolve.cc | 6 +
gcc/fortran/st.cc | 3 +
gcc/fortran/trans-openmp.cc | 78 ++++++-
gcc/fortran/trans.cc | 3 +
gcc/fortran/types.def | 1 +
gcc/omp-builtins.def | 11 +
.../gfortran.dg/goacc/acc-init-1.f90 | 47 ++++
.../gfortran.dg/goacc/acc-init-clauses-1.f90 | 28 +++
gcc/testsuite/gfortran.dg/goacc/acc-set-1.f90 | 36 +++
.../gfortran.dg/goacc/acc-set-clauses-1.f90 | 58 +++++
.../gfortran.dg/goacc/acc-shutdown-1.f90 | 47 ++++
.../goacc/acc-shutdown-clauses-1.f90 | 43 ++++
.../gfortran.dg/goacc/uninit-if-clause.f95 | 5 +-
.../gfortran.dg/goacc/update-if_present-2.f90 | 4 +-
libgomp/libgomp.map | 7 +
libgomp/libgomp_g.h | 8 +-
libgomp/oacc-init.c | 205 +++++++++++++++---
.../testsuite/libgomp.oacc-fortran/init-1.f90 | 59 +++++
.../libgomp.oacc-fortran/lib-1-directives.f90 | 17 ++
.../libgomp.oacc-fortran/lib-4-directives.f90 | 37 ++++
.../libgomp.oacc-fortran/lib-5-directives.f90 | 59 +++++
.../libgomp.oacc-fortran/lib-5-init.f90 | 59 +++++
.../testsuite/libgomp.oacc-fortran/set-1.f90 | 82 +++++++
.../libgomp.oacc-fortran/shutdown-1.f90 | 53 +++++
31 files changed, 1130 insertions(+), 36 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/goacc/acc-init-1.f90
create mode 100644 gcc/testsuite/gfortran.dg/goacc/acc-init-clauses-1.f90
create mode 100644 gcc/testsuite/gfortran.dg/goacc/acc-set-1.f90
create mode 100644 gcc/testsuite/gfortran.dg/goacc/acc-set-clauses-1.f90
create mode 100644 gcc/testsuite/gfortran.dg/goacc/acc-shutdown-1.f90
create mode 100644 gcc/testsuite/gfortran.dg/goacc/acc-shutdown-clauses-1.f90
create mode 100644 libgomp/testsuite/libgomp.oacc-fortran/init-1.f90
create mode 100644 libgomp/testsuite/libgomp.oacc-fortran/lib-1-directives.f90
create mode 100644 libgomp/testsuite/libgomp.oacc-fortran/lib-4-directives.f90
create mode 100644 libgomp/testsuite/libgomp.oacc-fortran/lib-5-directives.f90
create mode 100644 libgomp/testsuite/libgomp.oacc-fortran/lib-5-init.f90
create mode 100644 libgomp/testsuite/libgomp.oacc-fortran/set-1.f90
create mode 100644 libgomp/testsuite/libgomp.oacc-fortran/shutdown-1.f90
diff --git a/gcc/builtin-types.def b/gcc/builtin-types.def
index 23bfa76eaa4..1c49624d0bf 100644
--- a/gcc/builtin-types.def
+++ b/gcc/builtin-types.def
@@ -695,6 +695,8 @@ DEF_FUNCTION_TYPE_2 (BT_FN_PTR_CONST_PTR_INT, BT_PTR,
BT_CONST_PTR, BT_INT)
DEF_FUNCTION_TYPE_2 (BT_FN_VOID_ULONGLONG_ULONGLONG,
BT_VOID, BT_ULONGLONG, BT_ULONGLONG)
+DEF_FUNCTION_TYPE_2 (BT_FN_VOID_INT_INT, BT_VOID, BT_INT, BT_INT)
+
DEF_POINTER_TYPE (BT_PTR_FN_VOID_PTR_PTR, BT_FN_VOID_PTR_PTR)
DEF_FUNCTION_TYPE_3 (BT_FN_STRING_STRING_CONST_STRING_SIZE,
diff --git a/gcc/fortran/dump-parse-tree.cc b/gcc/fortran/dump-parse-tree.cc
index 3f1b35b715a..9c4ac6274e1 100644
--- a/gcc/fortran/dump-parse-tree.cc
+++ b/gcc/fortran/dump-parse-tree.cc
@@ -2494,6 +2494,28 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses)
show_expr (omp_clauses->nocontext);
fputc (')', dumpfile);
}
+ if (omp_clauses->oacc_device_type_present)
+ {
+ const char *s;
+ switch (omp_clauses->oacc_device_type)
+ {
+ case GOMP_DEVICE_NONE: s = "all"; break;
+ case GOMP_DEVICE_HOST: s = "host"; break;
+ case GOMP_DEVICE_NVIDIA_PTX: s = "nvidia"; break;
+ case GOMP_DEVICE_GCN: s = "radeon"; break;
+ default:
+ gcc_unreachable ();
+ }
+ fputs (" DEVICE_TYPE(", dumpfile);
+ fputs (s, dumpfile);
+ fputc (')', dumpfile);
+ }
+ if (omp_clauses->device_num_expr)
+ {
+ fputs (" DEVICE_NUM(", dumpfile);
+ show_expr (omp_clauses->device_num_expr);
+ fputc (')', dumpfile);
+ }
}
/* Show a single OpenMP or OpenACC directive node and everything underneath it
@@ -2523,6 +2545,9 @@ show_omp_node (int level, gfc_code *c)
case EXEC_OACC_CACHE: name = "CACHE"; is_oacc = true; break;
case EXEC_OACC_ENTER_DATA: name = "ENTER DATA"; is_oacc = true; break;
case EXEC_OACC_EXIT_DATA: name = "EXIT DATA"; is_oacc = true; break;
+ case EXEC_OACC_INIT: name = "INIT"; is_oacc = true; break;
+ case EXEC_OACC_SHUTDOWN: name = "SHUTDOWN"; is_oacc = true; break;
+ case EXEC_OACC_SET: name = "SET"; is_oacc = true; break;
case EXEC_OMP_ALLOCATE: name = "ALLOCATE"; break;
case EXEC_OMP_ALLOCATORS: name = "ALLOCATORS"; break;
case EXEC_OMP_ASSUME: name = "ASSUME"; break;
@@ -2634,6 +2659,9 @@ show_omp_node (int level, gfc_code *c)
case EXEC_OACC_CACHE:
case EXEC_OACC_ENTER_DATA:
case EXEC_OACC_EXIT_DATA:
+ case EXEC_OACC_INIT:
+ case EXEC_OACC_SHUTDOWN:
+ case EXEC_OACC_SET:
case EXEC_OMP_ALLOCATE:
case EXEC_OMP_ALLOCATORS:
case EXEC_OMP_ASSUME:
@@ -4031,6 +4059,9 @@ show_code_node (int level, gfc_code *c)
case EXEC_OACC_CACHE:
case EXEC_OACC_ENTER_DATA:
case EXEC_OACC_EXIT_DATA:
+ case EXEC_OACC_INIT:
+ case EXEC_OACC_SHUTDOWN:
+ case EXEC_OACC_SET:
case EXEC_OMP_ALLOCATE:
case EXEC_OMP_ALLOCATORS:
case EXEC_OMP_ASSUME:
diff --git a/gcc/fortran/frontend-passes.cc b/gcc/fortran/frontend-passes.cc
index fd34f0c1912..3afccc39f29 100644
--- a/gcc/fortran/frontend-passes.cc
+++ b/gcc/fortran/frontend-passes.cc
@@ -5737,6 +5737,17 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t codefn,
walk_expr_fn_t exprfn,
WALK_SUBEXPR (n->expr);
}
break;
+
+ case EXEC_OACC_INIT:
+ case EXEC_OACC_SHUTDOWN:
+ case EXEC_OACC_SET:
+
+ if (co->ext.omp_clauses)
+ {
+ WALK_SUBEXPR (co->ext.omp_clauses->device_num_expr);
+ }
+
+ break;
default:
break;
}
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 48ddd9a72d5..a5b2e035c84 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -273,6 +273,7 @@ enum gfc_statement
ST_OACC_SERIAL_LOOP, ST_OACC_END_SERIAL_LOOP, ST_OACC_SERIAL,
ST_OACC_END_SERIAL, ST_OACC_ENTER_DATA, ST_OACC_EXIT_DATA, ST_OACC_ROUTINE,
ST_OACC_ATOMIC, ST_OACC_END_ATOMIC,
+ ST_OACC_INIT, ST_OACC_SHUTDOWN, ST_OACC_SET,
ST_OMP_ATOMIC, ST_OMP_BARRIER, ST_OMP_CRITICAL, ST_OMP_END_ATOMIC,
ST_OMP_END_CRITICAL, ST_OMP_END_DO, ST_OMP_END_MASTER, ST_OMP_END_ORDERED,
ST_OMP_END_PARALLEL, ST_OMP_END_PARALLEL_DO, ST_OMP_END_PARALLEL_SECTIONS,
@@ -1770,12 +1771,14 @@ typedef struct gfc_omp_clauses
struct gfc_expr *num_gangs_expr;
struct gfc_expr *num_workers_expr;
struct gfc_expr *vector_length_expr;
+ struct gfc_expr *device_num_expr;
gfc_expr_list *wait_list;
gfc_expr_list *tile_list;
unsigned async:1, gang:1, worker:1, vector:1, seq:1, independent:1;
unsigned par_auto:1, gang_static:1;
unsigned if_present:1, finalize:1;
unsigned nohost:1;
+ unsigned oacc_device_type:4, oacc_device_type_present:1;
locus loc;
}
gfc_omp_clauses;
@@ -3286,6 +3289,7 @@ enum gfc_exec_op
EXEC_OACC_DATA, EXEC_OACC_HOST_DATA, EXEC_OACC_LOOP, EXEC_OACC_UPDATE,
EXEC_OACC_WAIT, EXEC_OACC_CACHE, EXEC_OACC_ENTER_DATA, EXEC_OACC_EXIT_DATA,
EXEC_OACC_ATOMIC, EXEC_OACC_DECLARE,
+ EXEC_OACC_INIT, EXEC_OACC_SHUTDOWN, EXEC_OACC_SET,
EXEC_OMP_CRITICAL, EXEC_OMP_FIRST_OPENMP_EXEC = EXEC_OMP_CRITICAL,
EXEC_OMP_DO, EXEC_OMP_FLUSH, EXEC_OMP_MASTER,
EXEC_OMP_ORDERED, EXEC_OMP_PARALLEL, EXEC_OMP_PARALLEL_DO,
diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h
index 0641e5a434c..43cc804225c 100644
--- a/gcc/fortran/match.h
+++ b/gcc/fortran/match.h
@@ -131,6 +131,9 @@ gfc_common_head *gfc_get_common (const char *, int);
/* OpenACC directive matchers. */
match gfc_match_oacc_atomic (void);
match gfc_match_oacc_cache (void);
+match gfc_match_oacc_init (void);
+match gfc_match_oacc_shutdown (void);
+match gfc_match_oacc_set (void);
match gfc_match_oacc_wait (void);
match gfc_match_oacc_update (void);
match gfc_match_oacc_declare (void);
diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc
index d151aff8a45..fc404994a15 100644
--- a/gcc/fortran/openmp.cc
+++ b/gcc/fortran/openmp.cc
@@ -209,6 +209,7 @@ gfc_free_omp_clauses (gfc_omp_clauses *c)
gfc_free_expr (c->num_gangs_expr);
gfc_free_expr (c->num_workers_expr);
gfc_free_expr (c->vector_length_expr);
+ gfc_free_expr (c->device_num_expr);
for (enum gfc_omp_list_type t = OMP_LIST_FIRST; t < OMP_LIST_NUM;
t = gfc_omp_list_type (t + 1))
gfc_free_omp_namelist (c->lists[t], t);
@@ -832,6 +833,74 @@ cleanup:
return MATCH_ERROR;
}
+static int
+match_oacc_device_type_kind (void)
+{
+
+ char name[GFC_MAX_SYMBOL_LEN + 1];
+
+ /* Since device_type arg accept * as all,
+ we need to check first the case when
+ the user inputs * as the parameter. */
+ gfc_gobble_whitespace ();
+ name[0] = (char) gfc_next_char ();
+
+ if (name[0] == '*')
+ return GOMP_DEVICE_NONE;
+
+ /* If is not *, we try to match the
+ pre-defined names. */
+
+ match m = gfc_match (" %n ", name + 1);
+
+ if (m != MATCH_YES)
+ return -1;
+
+ if (strcmp (name ,"host") == 0)
+ return GOMP_DEVICE_HOST;
+ if (strcmp (name, "nvidia") == 0)
+ return GOMP_DEVICE_NVIDIA_PTX;
+ if (strcmp (name, "radeon") == 0)
+ return GOMP_DEVICE_GCN;
+
+ return -1;
+}
+
+static match
+match_oacc_device_type (gfc_omp_clauses *c)
+{
+ locus old_loc = gfc_current_locus;
+
+ int result = match_oacc_device_type_kind ();
+ match m;
+
+ if (result == -1)
+ goto syntax;
+
+ m = gfc_match_char (')', true);
+
+ if (m != MATCH_YES)
+ goto single_argument;
+
+ c->oacc_device_type = (unsigned) result;
+ c->oacc_device_type_present = 1;
+
+ return MATCH_YES;
+
+single_argument:
+ gfc_error ("OpenACC %<DEVICE_TYPE%> clause only accepts one argument, "
+ "unexpected char at %C");
+ goto cleanup;
+
+syntax:
+ gfc_error ("Syntax error in OpenACC %<DEVICE_TYPE%> argument at %C.
Expected "
+ "host, radeon, nvidia or * as argument.");
+
+cleanup:
+ gfc_current_locus = old_loc;
+ return MATCH_ERROR;
+}
+
static match
match_omp_oacc_expr_list (const char *str, gfc_expr_list **list,
bool allow_asterisk, bool is_omp)
@@ -1182,6 +1251,7 @@ enum omp_mask2
OMP_CLAUSE_INTEROP, /* OpenMP 5.1 */
OMP_CLAUSE_LOCAL, /* OpenMP 6.0 */
OMP_CLAUSE_DYN_GROUPPRIVATE, /* OpenMP 6.1 */
+ OMP_CLAUSE_DEVICE_NUM,
/* This must come last. */
OMP_MASK2_LAST
};
@@ -3156,7 +3226,17 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const
omp_mask mask,
OMP_MAP_FORCE_DEVICEPTR, false,
allow_derived))
continue;
- if ((mask & OMP_CLAUSE_DEVICE_TYPE)
+
+ if ((mask & OMP_CLAUSE_DEVICE_TYPE) && openacc
+ && gfc_match_dupl_check (!c->oacc_device_type_present,
+ "device_type", true)
+ == MATCH_YES
+ && match_oacc_device_type (c) == MATCH_YES)
+ {
+ continue;
+ }
+
+ if ((mask & OMP_CLAUSE_DEVICE_TYPE) && !openacc
&& gfc_match_dupl_check (c->device_type == OMP_DEVICE_TYPE_UNSET,
"device_type", true) == MATCH_YES)
{
@@ -3175,6 +3255,16 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const
omp_mask mask,
break;
continue;
}
+ if ((mask & OMP_CLAUSE_DEVICE_NUM)
+ && (m = gfc_match_dupl_check (!c->device_num_expr, "device_num"))
+ != MATCH_NO)
+ {
+ if (m == MATCH_ERROR)
+ goto error;
+ if (gfc_match ("( %e )", &c->device_num_expr) != MATCH_YES)
+ goto error;
+ continue;
+ }
if ((mask & OMP_CLAUSE_DEVICE_RESIDENT)
&& gfc_match_omp_variable_list
("device_resident (",
@@ -3246,6 +3336,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const
omp_mask mask,
}
continue;
}
+
if ((mask & OMP_CLAUSE_DIST_SCHEDULE)
&& c->dist_sched_kind == OMP_SCHED_NONE
&& gfc_match ("dist_schedule ( static") == MATCH_YES)
@@ -3279,6 +3370,8 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const
omp_mask mask,
goto error;
continue;
}
+
+
break;
case 'e':
if ((mask & OMP_CLAUSE_ENTER))
@@ -5008,6 +5101,14 @@ error:
| OMP_CLAUSE_SEQ \
| OMP_CLAUSE_NOHOST)
+#define OACC_INIT_CLAUSES
\
+ (omp_mask (OMP_CLAUSE_IF) | OMP_CLAUSE_DEVICE_NUM | OMP_CLAUSE_DEVICE_TYPE)
+
+#define OACC_SHUTDOWN_CLAUSES
\
+ (omp_mask (OMP_CLAUSE_IF) | OMP_CLAUSE_DEVICE_NUM | OMP_CLAUSE_DEVICE_TYPE)
+
+#define OACC_SET_CLAUSES
\
+ (omp_mask (OMP_CLAUSE_IF) | OMP_CLAUSE_DEVICE_NUM | OMP_CLAUSE_DEVICE_TYPE)
static match
match_acc (gfc_exec_op op, const omp_mask mask)
@@ -5301,6 +5402,24 @@ gfc_match_oacc_cache (void)
return MATCH_YES;
}
+match
+gfc_match_oacc_init (void)
+{
+ return match_acc (EXEC_OACC_INIT, OACC_INIT_CLAUSES);
+}
+
+match
+gfc_match_oacc_shutdown (void)
+{
+ return match_acc (EXEC_OACC_SHUTDOWN, OACC_SHUTDOWN_CLAUSES);
+}
+
+match
+gfc_match_oacc_set (void)
+{
+ return match_acc (EXEC_OACC_SET, OACC_SET_CLAUSES);
+}
+
/* Determine the OpenACC 'routine' directive's level of parallelism. */
static oacc_routine_lop
@@ -11383,6 +11502,15 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses
*omp_clauses,
if (omp_clauses->async)
if (omp_clauses->async_expr)
resolve_scalar_int_expr (omp_clauses->async_expr, "ASYNC");
+
+ if (omp_clauses->device_num_expr)
+ resolve_scalar_int_expr (omp_clauses->device_num_expr, "DEVICE_NUM");
+
+ if (!omp_clauses->device_num_expr && !omp_clauses->oacc_device_type_present
+ && code->op == EXEC_OACC_SET)
+ gfc_error ("At least one of the clauses %<DEVICE_TYPE%> and %<DEVICE_NUM%>
"
+ "should be present in %<SET%> directive at %L", &code->loc);
+
if (omp_clauses->num_gangs_expr)
resolve_positive_int_expr (omp_clauses->num_gangs_expr, "NUM_GANGS");
if (omp_clauses->num_workers_expr)
@@ -13635,6 +13763,12 @@ oacc_code_to_statement (gfc_code *code)
return ST_OACC_EXIT_DATA;
case EXEC_OACC_DECLARE:
return ST_OACC_DECLARE;
+ case EXEC_OACC_INIT:
+ return ST_OACC_INIT;
+ case EXEC_OACC_SHUTDOWN:
+ return ST_OACC_SHUTDOWN;
+ case EXEC_OACC_SET:
+ return ST_OACC_SET;
default:
gcc_unreachable ();
}
@@ -13968,6 +14102,9 @@ gfc_resolve_oacc_directive (gfc_code *code,
gfc_namespace *ns ATTRIBUTE_UNUSED)
case EXEC_OACC_EXIT_DATA:
case EXEC_OACC_WAIT:
case EXEC_OACC_CACHE:
+ case EXEC_OACC_INIT:
+ case EXEC_OACC_SET:
+ case EXEC_OACC_SHUTDOWN:
resolve_omp_clauses (code, code->ext.omp_clauses, NULL, true);
break;
case EXEC_OACC_PARALLEL_LOOP:
diff --git a/gcc/fortran/parse.cc b/gcc/fortran/parse.cc
index 7b6cf525a80..958099dcdee 100644
--- a/gcc/fortran/parse.cc
+++ b/gcc/fortran/parse.cc
@@ -790,6 +790,9 @@ decode_oacc_directive (void)
case 'h':
matcha ("host_data", gfc_match_oacc_host_data, ST_OACC_HOST_DATA);
break;
+ case 'i':
+ matcha ("init", gfc_match_oacc_init, ST_OACC_INIT);
+ break;
case 'p':
matcha ("parallel loop", gfc_match_oacc_parallel_loop,
ST_OACC_PARALLEL_LOOP);
@@ -806,6 +809,8 @@ decode_oacc_directive (void)
case 's':
matcha ("serial loop", gfc_match_oacc_serial_loop, ST_OACC_SERIAL_LOOP);
matcha ("serial", gfc_match_oacc_serial, ST_OACC_SERIAL);
+ matcha ("set", gfc_match_oacc_set, ST_OACC_SET);
+ matcha ("shutdown", gfc_match_oacc_shutdown, ST_OACC_SHUTDOWN);
break;
case 'u':
matcha ("update", gfc_match_oacc_update, ST_OACC_UPDATE);
@@ -1975,7 +1980,8 @@ next_statement (void)
case ST_FORM_TEAM: case ST_SYNC_TEAM: \
case ST_EVENT_POST: case ST_EVENT_WAIT: case ST_FAIL_IMAGE: \
case ST_OACC_UPDATE: case ST_OACC_WAIT: case ST_OACC_CACHE: \
- case ST_OACC_ENTER_DATA: case ST_OACC_EXIT_DATA
+ case ST_OACC_ENTER_DATA: case ST_OACC_EXIT_DATA: \
+ case ST_OACC_SHUTDOWN: case ST_OACC_SET: case ST_OACC_INIT
/* Statements that mark other executable statements. */
@@ -2692,6 +2698,15 @@ gfc_ascii_statement (gfc_statement st, bool
strip_sentinel)
case ST_OACC_END_ATOMIC:
p = "!$ACC END ATOMIC";
break;
+ case ST_OACC_INIT:
+ p = "!ACC INIT";
+ break;
+ case ST_OACC_SHUTDOWN:
+ p = "!ACC SHUTDOWN";
+ break;
+ case ST_OACC_SET:
+ p = "!ACC SET";
+ break;
case ST_OMP_ALLOCATE:
case ST_OMP_ALLOCATE_EXEC:
p = "!$OMP ALLOCATE";
@@ -8039,6 +8054,9 @@ is_oacc (gfc_state_data *sd)
case EXEC_OACC_EXIT_DATA:
case EXEC_OACC_ATOMIC:
case EXEC_OACC_ROUTINE:
+ case EXEC_OACC_INIT:
+ case EXEC_OACC_SHUTDOWN:
+ case EXEC_OACC_SET:
return true;
default:
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 6dc1b8e315d..86d28cf7375 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -13041,6 +13041,9 @@ gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns)
case EXEC_OACC_ENTER_DATA:
case EXEC_OACC_EXIT_DATA:
case EXEC_OACC_ROUTINE:
+ case EXEC_OACC_INIT:
+ case EXEC_OACC_SHUTDOWN:
+ case EXEC_OACC_SET:
case EXEC_OMP_ALLOCATE:
case EXEC_OMP_ALLOCATORS:
case EXEC_OMP_ASSUME:
@@ -14827,6 +14830,9 @@ start:
case EXEC_OACC_EXIT_DATA:
case EXEC_OACC_ATOMIC:
case EXEC_OACC_DECLARE:
+ case EXEC_OACC_INIT:
+ case EXEC_OACC_SHUTDOWN:
+ case EXEC_OACC_SET:
gfc_resolve_oacc_directive (code, ns);
break;
diff --git a/gcc/fortran/st.cc b/gcc/fortran/st.cc
index 39711e32620..4c7e274b72a 100644
--- a/gcc/fortran/st.cc
+++ b/gcc/fortran/st.cc
@@ -221,6 +221,9 @@ gfc_free_statement (gfc_code *p)
case EXEC_OACC_ENTER_DATA:
case EXEC_OACC_EXIT_DATA:
case EXEC_OACC_ROUTINE:
+ case EXEC_OACC_INIT:
+ case EXEC_OACC_SHUTDOWN:
+ case EXEC_OACC_SET:
case EXEC_OMP_ALLOCATE:
case EXEC_OMP_ALLOCATORS:
case EXEC_OMP_ASSUME:
diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc
index 52b1554ac33..49e08987361 100644
--- a/gcc/fortran/trans-openmp.cc
+++ b/gcc/fortran/trans-openmp.cc
@@ -23,6 +23,7 @@ along with GCC; see the file COPYING3. If not see
#include "system.h"
#include "coretypes.h"
#include "options.h"
+#include "tree-core.h"
#include "tree.h"
#include "gfortran.h"
#include "basic-block.h"
@@ -6421,6 +6422,10 @@ gfc_trans_omp_clauses (stmtblock_t *block,
gfc_omp_clauses *clauses,
/* OpenACC 'nohost' clauses cannot appear here. */
gcc_checking_assert (!clauses->nohost);
+ /* OpenACC 'device_num' and 'device_type' clauses cannot appear here. */
+ gcc_checking_assert (!clauses->device_num_expr
+ && !clauses->oacc_device_type_present);
+
return nreverse (omp_clauses);
}
@@ -6491,7 +6496,7 @@ gfc_trans_oacc_construct (gfc_code *code)
return gfc_finish_block (&block);
}
-/* update, enter_data, exit_data, cache. */
+/* update, enter_data, exit_data, cache, init, set, shutdown. */
static tree
gfc_trans_oacc_executable_directive (gfc_code *code)
{
@@ -6513,6 +6518,10 @@ gfc_trans_oacc_executable_directive (gfc_code *code)
case EXEC_OACC_CACHE:
construct_code = OACC_CACHE;
break;
+ case EXEC_OACC_INIT:
+ case EXEC_OACC_SHUTDOWN:
+ case EXEC_OACC_SET:
+ goto builtin_oacc_exec_directive;
default:
gcc_unreachable ();
}
@@ -6524,6 +6533,69 @@ gfc_trans_oacc_executable_directive (gfc_code *code)
oacc_clauses);
gfc_add_expr_to_block (&block, stmt);
return gfc_finish_block (&block);
+
+builtin_oacc_exec_directive:
+
+ enum built_in_function builtin_code;
+
+ switch (code->op)
+ {
+ case EXEC_OACC_INIT:
+ builtin_code = BUILT_IN_GOACC_INIT;
+ break;
+ case EXEC_OACC_SHUTDOWN:
+ builtin_code = BUILT_IN_GOACC_SHUTDOWN;
+ break;
+ case EXEC_OACC_SET:
+ builtin_code = BUILT_IN_GOACC_SET_DEVICE_TYPE_DEVICE_NUM;
+ break;
+ default:
+ gcc_unreachable ();
+ }
+
+ location_t loc = input_location;
+ gfc_omp_clauses *clauses = code->ext.omp_clauses;
+
+ gfc_start_block (&block);
+
+ tree n_device = NULL;
+ if (clauses->device_num_expr)
+ n_device = gfc_convert_expr_to_tree (&block, clauses->device_num_expr);
+ else
+ /* no 'device_num' clause specified by
+ the user, we don't modify the value of ICV
+ 'acc-current-device-num-var' or we do not
+ take any action in init and shutdown directive
+ using -1 value. */
+ n_device = build_int_cst (integer_type_node, -1);
+
+ /* GOMP_DEVICE_NONE is used to make the operation
+ in all the devices.
+
+ GOMP_DEVICE_DEFAULT is used in set directive
+ to do nothing if the clause do not appear. */
+ int device_type = code->op == EXEC_OACC_SET ?
+ GOMP_DEVICE_DEFAULT :
+ GOMP_DEVICE_NONE;
+
+ if (clauses->oacc_device_type_present)
+ device_type = clauses->oacc_device_type;
+
+ tree d_type = build_int_cst (integer_type_node, device_type);
+
+ stmt = builtin_decl_explicit (builtin_code);
+
+ stmt = build_call_expr_loc (loc, stmt, 2, n_device, d_type);
+
+ if (clauses->if_expr)
+ stmt = build3_loc (input_location, COND_EXPR, void_type_node,
+ gfc_convert_expr_to_tree (&block, clauses->if_expr),
+ stmt, NULL_TREE);
+
+ gfc_add_expr_to_block (&block, stmt);
+
+ return gfc_finish_block (&block);
+
}
static tree
@@ -9867,6 +9939,7 @@ gfc_trans_oacc_declare (gfc_code *code)
return gfc_finish_block (&block);
}
+
tree
gfc_trans_oacc_directive (gfc_code *code)
{
@@ -9889,6 +9962,9 @@ gfc_trans_oacc_directive (gfc_code *code)
case EXEC_OACC_CACHE:
case EXEC_OACC_ENTER_DATA:
case EXEC_OACC_EXIT_DATA:
+ case EXEC_OACC_INIT:
+ case EXEC_OACC_SHUTDOWN:
+ case EXEC_OACC_SET:
return gfc_trans_oacc_executable_directive (code);
case EXEC_OACC_WAIT:
return gfc_trans_oacc_wait_directive (code);
diff --git a/gcc/fortran/trans.cc b/gcc/fortran/trans.cc
index 7418b811a72..cf37261673c 100644
--- a/gcc/fortran/trans.cc
+++ b/gcc/fortran/trans.cc
@@ -2685,6 +2685,9 @@ trans_code (gfc_code * code, tree cond)
case EXEC_OACC_EXIT_DATA:
case EXEC_OACC_ATOMIC:
case EXEC_OACC_DECLARE:
+ case EXEC_OACC_INIT:
+ case EXEC_OACC_SHUTDOWN:
+ case EXEC_OACC_SET:
res = gfc_trans_oacc_directive (code);
break;
diff --git a/gcc/fortran/types.def b/gcc/fortran/types.def
index eb253d8970e..73a1e0cd734 100644
--- a/gcc/fortran/types.def
+++ b/gcc/fortran/types.def
@@ -125,6 +125,7 @@ DEF_FUNCTION_TYPE_2 (BT_FN_VOID_CONST_PTR_SIZE, BT_VOID,
BT_CONST_PTR, BT_SIZE)
DEF_FUNCTION_TYPE_2 (BT_FN_PTR_CONST_PTR_INT, BT_PTR, BT_CONST_PTR, BT_INT)
DEF_FUNCTION_TYPE_2 (BT_FN_VOID_ULONGLONG_ULONGLONG,
BT_VOID, BT_ULONGLONG, BT_ULONGLONG)
+DEF_FUNCTION_TYPE_2 (BT_FN_VOID_INT_INT, BT_VOID, BT_INT, BT_INT)
DEF_POINTER_TYPE (BT_PTR_FN_VOID_PTR_PTR, BT_FN_VOID_PTR_PTR)
diff --git a/gcc/omp-builtins.def b/gcc/omp-builtins.def
index 8e6b6fb3acf..84b3c84db3f 100644
--- a/gcc/omp-builtins.def
+++ b/gcc/omp-builtins.def
@@ -49,6 +49,17 @@ DEF_GOACC_BUILTIN (BUILT_IN_GOACC_UPDATE, "GOACC_update",
DEF_GOACC_BUILTIN (BUILT_IN_GOACC_WAIT, "GOACC_wait",
BT_FN_VOID_INT_INT_VAR,
ATTR_NOTHROW_LIST)
+
+DEF_GOACC_BUILTIN (BUILT_IN_GOACC_INIT, "GOACC_init",
+ BT_FN_VOID_INT_INT, ATTR_NOTHROW_LIST)
+
+DEF_GOACC_BUILTIN (BUILT_IN_GOACC_SHUTDOWN, "GOACC_shutdown",
+ BT_FN_VOID_INT_INT, ATTR_NOTHROW_LIST)
+
+DEF_GOACC_BUILTIN (BUILT_IN_GOACC_SET_DEVICE_TYPE_DEVICE_NUM,
+ "GOACC_set_device_type_device_num",
+ BT_FN_VOID_INT_INT, ATTR_NOTHROW_LIST)
+
DEF_GOACC_BUILTIN (BUILT_IN_GOACC_DECLARE, "GOACC_declare",
BT_FN_VOID_INT_SIZE_PTR_PTR_PTR, ATTR_NOTHROW_LIST)
diff --git a/gcc/testsuite/gfortran.dg/goacc/acc-init-1.f90
b/gcc/testsuite/gfortran.dg/goacc/acc-init-1.f90
new file mode 100644
index 00000000000..931cce7a924
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/acc-init-1.f90
@@ -0,0 +1,47 @@
+! Test parsing and lowering of the OpenACC init directive.
+
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-original" }
+
+subroutine init0
+ implicit none
+ !$acc init
+end subroutine init0
+
+subroutine init1
+ implicit none
+ !$acc init device_type(host)
+end subroutine init1
+
+subroutine init2
+ implicit none
+ !$acc init device_type(nvidia)
+end subroutine init2
+
+subroutine init3
+ implicit none
+ !$acc init device_num(0)
+end subroutine init3
+
+subroutine init4
+ implicit none
+ !$acc init device_type(host) device_num(0)
+end subroutine init4
+
+subroutine init5
+ implicit none
+ !$acc init if(.false.)
+end subroutine init5
+
+subroutine init6(l)
+ implicit none
+ logical, value :: l
+ !$acc init if(l) device_type(radeon) device_num(1)
+end subroutine init6
+
+! { dg-final { scan-tree-dump-times "__builtin_GOACC_init \\(-1, 0\\)" 2
"original" } }
+! { dg-final { scan-tree-dump-times "__builtin_GOACC_init \\(-1, 2\\)" 1
"original" } }
+! { dg-final { scan-tree-dump-times "__builtin_GOACC_init \\(-1, 5\\)" 1
"original" } }
+! { dg-final { scan-tree-dump-times "__builtin_GOACC_init \\(0, 0\\)" 1
"original" } }
+! { dg-final { scan-tree-dump-times "__builtin_GOACC_init \\(0, 2\\)" 1
"original" } }
+! { dg-final { scan-tree-dump-times "__builtin_GOACC_init \\(1, 8\\)" 1
"original" } }
diff --git a/gcc/testsuite/gfortran.dg/goacc/acc-init-clauses-1.f90
b/gcc/testsuite/gfortran.dg/goacc/acc-init-clauses-1.f90
new file mode 100644
index 00000000000..30c86a798ee
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/acc-init-clauses-1.f90
@@ -0,0 +1,28 @@
+! Test invalid clauses on the OpenACC init directive.
+
+! { dg-do compile }
+
+subroutine bad1
+ implicit none
+ !$acc init device_type(doesnt_exist) ! { dg-error "Expected host, radeon,
nvidia or \\\* as argument" }
+end subroutine bad1
+
+subroutine bad2
+ implicit none
+ !$acc init device_type(nvidia, host) ! { dg-error "OpenACC 'DEVICE_TYPE'
clause only accepts one argument" }
+end subroutine bad2
+
+subroutine bad3
+ implicit none
+ !$acc init if_present ! { dg-error "Failed to match clause" }
+end subroutine bad3
+
+subroutine bad4
+ implicit none
+ !$acc init async ! { dg-error "Failed to match clause" }
+end subroutine bad4
+
+subroutine bad5
+ implicit none
+ !$acc init wait ! { dg-error "Failed to match clause" }
+end subroutine bad5
diff --git a/gcc/testsuite/gfortran.dg/goacc/acc-set-1.f90
b/gcc/testsuite/gfortran.dg/goacc/acc-set-1.f90
new file mode 100644
index 00000000000..7ef5c6615f0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/acc-set-1.f90
@@ -0,0 +1,36 @@
+! Test parsing and lowering of the OpenACC set directive.
+
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-original" }
+
+subroutine set0
+ implicit none
+ !$acc set device_type(host)
+end subroutine set0
+
+subroutine set1
+ implicit none
+ !$acc set device_type(nvidia)
+end subroutine set1
+
+subroutine set2
+ implicit none
+ !$acc set device_num(0)
+end subroutine set2
+
+subroutine set3
+ implicit none
+ !$acc set device_type(host) device_num(0)
+end subroutine set3
+
+subroutine set4(l)
+ implicit none
+ logical, value :: l
+ !$acc set if(l) device_type(radeon) device_num(1)
+end subroutine set4
+
+! { dg-final { scan-tree-dump-times
"__builtin_GOACC_set_device_type_device_num \\(-1, 2\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times
"__builtin_GOACC_set_device_type_device_num \\(-1, 5\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times
"__builtin_GOACC_set_device_type_device_num \\(0, 1\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times
"__builtin_GOACC_set_device_type_device_num \\(0, 2\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times
"__builtin_GOACC_set_device_type_device_num \\(1, 8\\)" 1 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/goacc/acc-set-clauses-1.f90
b/gcc/testsuite/gfortran.dg/goacc/acc-set-clauses-1.f90
new file mode 100644
index 00000000000..9ed31a0fea2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/acc-set-clauses-1.f90
@@ -0,0 +1,58 @@
+! Test invalid clauses on the OpenACC set directive.
+
+! { dg-do compile }
+
+subroutine bad1
+ implicit none
+ !$acc set device_type(doesnt_exist) ! { dg-error "Expected host, radeon,
nvidia or \\* as argument" }
+end subroutine bad1
+
+subroutine bad2
+ implicit none
+ !$acc set device_type(nvidia, host) ! { dg-error "OpenACC 'DEVICE_TYPE'
clause only accepts one argument" }
+end subroutine bad2
+
+subroutine bad3
+ implicit none
+ !$acc set ! { dg-error "At least one of the clauses 'DEVICE_TYPE' and
'DEVICE_NUM' should be present in 'SET' directive" }
+end subroutine bad3
+
+subroutine bad4
+ implicit none
+ !$acc set if(.true.) ! { dg-error "At least one of the clauses 'DEVICE_TYPE'
and 'DEVICE_NUM' should be present in 'SET' directive" }
+end subroutine bad4
+
+subroutine bad5
+ implicit none
+ !$acc set default_async(0) ! { dg-error "Failed to match clause" }
+end subroutine bad5
+
+subroutine bad6
+ implicit none
+ !$acc set if_present ! { dg-error "Failed to match clause" }
+end subroutine bad6
+
+subroutine bad7
+ implicit none
+ !$acc set async ! { dg-error "Failed to match clause" }
+end subroutine bad7
+
+subroutine bad8
+ implicit none
+ !$acc set wait ! { dg-error "Failed to match clause" }
+end subroutine bad8
+
+subroutine bad9
+ implicit none
+ !$acc set device_type(host) device_type(nvidia) ! { dg-error "Duplicated
'device_type' clause" }
+end subroutine bad9
+
+subroutine bad10
+ implicit none
+ !$acc set device_num(0) device_num(1) ! { dg-error "Duplicated 'device_num'
clause" }
+end subroutine bad10
+
+subroutine bad11
+ implicit none
+ !$acc set if(.false.) if(.true.) ! { dg-error "Duplicated 'if' clause" }
+end subroutine bad11
diff --git a/gcc/testsuite/gfortran.dg/goacc/acc-shutdown-1.f90
b/gcc/testsuite/gfortran.dg/goacc/acc-shutdown-1.f90
new file mode 100644
index 00000000000..72db24750f1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/acc-shutdown-1.f90
@@ -0,0 +1,47 @@
+! Test parsing and lowering of the OpenACC shutdown directive.
+
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-original" }
+
+subroutine shutdown0
+ implicit none
+ !$acc shutdown
+end subroutine shutdown0
+
+subroutine shutdown1
+ implicit none
+ !$acc shutdown device_type(host)
+end subroutine shutdown1
+
+subroutine shutdown2
+ implicit none
+ !$acc shutdown device_type(nvidia)
+end subroutine shutdown2
+
+subroutine shutdown3
+ implicit none
+ !$acc shutdown device_num(0)
+end subroutine shutdown3
+
+subroutine shutdown4
+ implicit none
+ !$acc shutdown device_type(host) device_num(0)
+end subroutine shutdown4
+
+subroutine shutdown5
+ implicit none
+ !$acc shutdown if(.false.)
+end subroutine shutdown5
+
+subroutine shutdown6(l)
+ implicit none
+ logical, value :: l
+ !$acc shutdown if(l) device_type(radeon) device_num(1)
+end subroutine shutdown6
+
+! { dg-final { scan-tree-dump-times "__builtin_GOACC_shutdown \\(-1, 0\\)" 2
"original" } }
+! { dg-final { scan-tree-dump-times "__builtin_GOACC_shutdown \\(-1, 2\\)" 1
"original" } }
+! { dg-final { scan-tree-dump-times "__builtin_GOACC_shutdown \\(-1, 5\\)" 1
"original" } }
+! { dg-final { scan-tree-dump-times "__builtin_GOACC_shutdown \\(0, 0\\)" 1
"original" } }
+! { dg-final { scan-tree-dump-times "__builtin_GOACC_shutdown \\(0, 2\\)" 1
"original" } }
+! { dg-final { scan-tree-dump-times "__builtin_GOACC_shutdown \\(1, 8\\)" 1
"original" } }
diff --git a/gcc/testsuite/gfortran.dg/goacc/acc-shutdown-clauses-1.f90
b/gcc/testsuite/gfortran.dg/goacc/acc-shutdown-clauses-1.f90
new file mode 100644
index 00000000000..242d05a5e67
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/acc-shutdown-clauses-1.f90
@@ -0,0 +1,43 @@
+! Test invalid clauses on the OpenACC shutdown directive.
+
+! { dg-do compile }
+
+subroutine bad1
+ implicit none
+ !$acc shutdown device_type(doesnt_exist) ! { dg-error "Expected host,
radeon, nvidia or \\* as argument" }
+end subroutine bad1
+
+subroutine bad2
+ implicit none
+ !$acc shutdown device_type(nvidia, host) ! { dg-error "OpenACC 'DEVICE_TYPE'
clause only accepts one argument" }
+end subroutine bad2
+
+subroutine bad3
+ implicit none
+ !$acc shutdown if_present ! { dg-error "Failed to match clause" }
+end subroutine bad3
+
+subroutine bad4
+ implicit none
+ !$acc shutdown async ! { dg-error "Failed to match clause" }
+end subroutine bad4
+
+subroutine bad5
+ implicit none
+ !$acc shutdown wait ! { dg-error "Failed to match clause" }
+end subroutine bad5
+
+subroutine bad6
+ implicit none
+ !$acc shutdown device_type(host) device_type(nvidia) ! { dg-error
"Duplicated 'device_type' clause" }
+end subroutine bad6
+
+subroutine bad7
+ implicit none
+ !$acc shutdown device_num(0) device_num(1) ! { dg-error "Duplicated
'device_num' clause" }
+end subroutine bad7
+
+subroutine bad8
+ implicit none
+ !$acc shutdown if(.false.) if(.true.) ! { dg-error "Duplicated 'if' clause" }
+end subroutine bad8
diff --git a/gcc/testsuite/gfortran.dg/goacc/uninit-if-clause.f95
b/gcc/testsuite/gfortran.dg/goacc/uninit-if-clause.f95
index 940fe841c20..89301af4785 100644
--- a/gcc/testsuite/gfortran.dg/goacc/uninit-if-clause.f95
+++ b/gcc/testsuite/gfortran.dg/goacc/uninit-if-clause.f95
@@ -3,12 +3,13 @@
program test
implicit none
- logical :: b, b2, bs, b3, b4
+ logical :: b, b2, bs, b3, b4, b5
! { dg-note {'b' was declared here} {} { target *-*-* } .-1 }
! { dg-note {'b2' was declared here} {} { target *-*-* } .-2 }
! { dg-note {'bs' was declared here} {} { target *-*-* } .-3 }
! { dg-note {'b3' was declared here} {} { target *-*-* } .-4 }
! { dg-note {'b4' was declared here} {} { target *-*-* } .-5 }
+ ! { dg-note {'b5' was declared here} {} { target *-*-* } .-6 }
integer :: data, data2
!$acc parallel if(b) ! { dg-warning "is used uninitialized" }
@@ -25,4 +26,6 @@ program test
!$acc update if(b4) self(data2) ! { dg-warning "is used uninitialized" }
+ !$acc init if(b5) ! { dg-warning "is used uninitialized" }
+
end program test
diff --git a/gcc/testsuite/gfortran.dg/goacc/update-if_present-2.f90
b/gcc/testsuite/gfortran.dg/goacc/update-if_present-2.f90
index 41c2657b536..9a350a8c845 100644
--- a/gcc/testsuite/gfortran.dg/goacc/update-if_present-2.f90
+++ b/gcc/testsuite/gfortran.dg/goacc/update-if_present-2.f90
@@ -20,8 +20,8 @@ subroutine t1
!$acc declare link(a) if_present ! { dg-error "Unexpected junk after" }
- !$acc init if_present ! { dg-error "Unclassifiable OpenACC directive" }
- !$acc shutdown if_present ! { dg-error "Unclassifiable OpenACC directive" }
+ !$acc init if_present ! { dg-error "Failed to match clause" }
+ !$acc shutdown if_present ! { dg-error "Failed to match clause" }
!$acc update self(a) device_type(nvidia) device(b) if_present ! { dg-error
"Failed to match clause" }
end subroutine t1
diff --git a/libgomp/libgomp.map b/libgomp/libgomp.map
index 8a59d4965b3..5b3a9e3ca7a 100644
--- a/libgomp/libgomp.map
+++ b/libgomp/libgomp.map
@@ -691,6 +691,13 @@ GOACC_2.0.2 {
GOACC_exit_data;
} GOACC_2.0.1;
+GOACC_2.5 {
+ global:
+ GOACC_init;
+ GOACC_shutdown;
+ GOACC_set_device_type_device_num;
+} GOACC_2.0.2;
+
GOMP_PLUGIN_1.0 {
global:
GOMP_PLUGIN_malloc;
diff --git a/libgomp/libgomp_g.h b/libgomp/libgomp_g.h
index f5f1d8e677b..cb2d607aef6 100644
--- a/libgomp/libgomp_g.h
+++ b/libgomp/libgomp_g.h
@@ -26,7 +26,7 @@
/* This file contains prototypes of functions in the external ABI.
This file is included by files in the testsuite. */
-#ifndef LIBGOMP_G_H
+#ifndef LIBGOMP_G_H
#define LIBGOMP_G_H 1
#include <stdbool.h>
@@ -413,6 +413,12 @@ extern void GOMP_error (const char *, size_t);
extern void GOACC_wait (int, int, ...);
+/* oacc-init.c */
+
+extern void GOACC_init (int, int);
+extern void GOACC_shutdown (int, int);
+extern void GOACC_set_device_type_device_num (int, int);
+
/* oacc-mem.c */
extern void GOACC_enter_exit_data (int, size_t, void **, size_t *,
diff --git a/libgomp/oacc-init.c b/libgomp/oacc-init.c
index 70bf10c84d9..5cbe02ba41f 100644
--- a/libgomp/oacc-init.c
+++ b/libgomp/oacc-init.c
@@ -69,6 +69,10 @@ static gomp_mutex_t goacc_thread_lock;
grouped by device in target.c:devices). */
static struct gomp_device_descr *dispatchers[_ACC_device_hwm] = { 0 };
+/* Device types for init and shutdown directives to check all devices. */
+#define GOACC_DIRECTIVE_DEVICE_MASK
\
+ ((1 << acc_device_host) | (1 << acc_device_nvidia) | (1 <<
acc_device_radeon))
+
attribute_hidden void
goacc_register (struct gomp_device_descr *disp)
{
@@ -231,7 +235,8 @@ acc_dev_num_out_of_range (acc_device_t d, int ord, int
ndevs)
held before calling this function. */
static struct gomp_device_descr *
-acc_init_1 (acc_device_t d, acc_construct_t parent_construct, int implicit)
+acc_init_1 (acc_device_t d, acc_construct_t parent_construct, int implicit,
+ int dev_num)
{
gomp_mutex_lock (&acc_init_state_lock);
acc_init_state = initializing;
@@ -304,10 +309,12 @@ acc_init_1 (acc_device_t d, acc_construct_t
parent_construct, int implicit)
ndevs = base_dev->get_num_devices_func (0);
- if (ndevs <= 0 || goacc_device_num >= ndevs)
- acc_dev_num_out_of_range (d, goacc_device_num, ndevs);
+ dev_num = (dev_num == -1 ? goacc_device_num : dev_num);
- acc_dev = &base_dev[goacc_device_num];
+ if (ndevs <= 0 || dev_num >= ndevs)
+ acc_dev_num_out_of_range (d, dev_num, ndevs);
+
+ acc_dev = &base_dev[dev_num];
gomp_mutex_lock (&acc_dev->lock);
if (acc_dev->state == GOMP_DEVICE_INITIALIZED)
@@ -341,7 +348,7 @@ acc_init_1 (acc_device_t d, acc_construct_t
parent_construct, int implicit)
/* ACC_DEVICE_LOCK must be held before calling this function. */
static void
-acc_shutdown_1 (acc_device_t d)
+acc_shutdown_1 (acc_device_t d, int dev_num)
{
struct gomp_device_descr *base_dev;
struct goacc_thread *walk;
@@ -353,21 +360,42 @@ acc_shutdown_1 (acc_device_t d)
ndevs = base_dev->get_num_devices_func (0);
- /* Unload all the devices of this type that have been opened. */
- for (i = 0; i < ndevs; i++)
- {
- struct gomp_device_descr *acc_dev = &base_dev[i];
+ if (dev_num != -1 && ndevs <= dev_num)
+ acc_dev_num_out_of_range (d, dev_num, ndevs);
+ if (dev_num != -1)
+ {
+ struct gomp_device_descr *acc_dev = &base_dev[dev_num];
gomp_mutex_lock (&acc_dev->lock);
gomp_unload_device (acc_dev);
gomp_mutex_unlock (&acc_dev->lock);
}
-
+ else
+ {
+ /* Unload all the devices of this type that have been opened. */
+ for (i = 0; i < ndevs; i++)
+ {
+ struct gomp_device_descr *acc_dev = &base_dev[i];
+
+ gomp_mutex_lock (&acc_dev->lock);
+ gomp_unload_device (acc_dev);
+ gomp_mutex_unlock (&acc_dev->lock);
+ }
+ }
+
gomp_mutex_lock (&goacc_thread_lock);
- /* Free target-specific TLS data and close all devices. */
+ /* Free target-specific TLS data and close devices. */
for (walk = goacc_threads; walk != NULL; walk = walk->next)
{
+ /* These checks are necessary since init supports
+ * multiples devices. */
+ if (walk->base_dev != base_dev)
+ continue;
+
+ if (dev_num != -1 && walk->dev != &base_dev[dev_num])
+ continue;
+
if (walk->target_tls)
base_dev->openacc.destroy_thread_data_func (walk->target_tls);
@@ -409,20 +437,38 @@ acc_shutdown_1 (acc_device_t d)
gomp_mutex_unlock (&goacc_thread_lock);
- /* Close all the devices of this type that have been opened. */
bool ret = true;
- for (i = 0; i < ndevs; i++)
+
+ if (dev_num != -1)
{
- struct gomp_device_descr *acc_dev = &base_dev[i];
+ struct gomp_device_descr *acc_dev = &base_dev[dev_num];
gomp_mutex_lock (&acc_dev->lock);
+
if (acc_dev->state == GOMP_DEVICE_INITIALIZED)
- {
+ {
devices_active = true;
ret &= gomp_fini_device (acc_dev);
acc_dev->state = GOMP_DEVICE_UNINITIALIZED;
}
+
gomp_mutex_unlock (&acc_dev->lock);
}
+ else
+ {
+ /* Close all the devices of this type that have been opened. */
+ for (i = 0; i < ndevs; i++)
+ {
+ struct gomp_device_descr *acc_dev = &base_dev[i];
+ gomp_mutex_lock (&acc_dev->lock);
+ if (acc_dev->state == GOMP_DEVICE_INITIALIZED)
+ {
+ devices_active = true;
+ ret &= gomp_fini_device (acc_dev);
+ acc_dev->state = GOMP_DEVICE_UNINITIALIZED;
+ }
+ gomp_mutex_unlock (&acc_dev->lock);
+ }
+ }
if (!ret)
gomp_fatal ("device finalization failed");
@@ -502,13 +548,13 @@ goacc_attach_host_thread_to_device (int ord)
struct goacc_thread *thr = goacc_thread ();
struct gomp_device_descr *acc_dev = NULL, *base_dev = NULL;
int num_devices;
-
+
if (thr && thr->dev && (thr->dev->target_id == ord || ord < 0))
return;
-
+
if (ord < 0)
ord = goacc_device_num;
-
+
/* Decide which type of device to use. If the current thread has a device
type already (e.g. set by acc_set_device_type), use that, else use the
global default. */
@@ -519,15 +565,15 @@ goacc_attach_host_thread_to_device (int ord)
assert (cached_base_dev);
base_dev = cached_base_dev;
}
-
+
num_devices = base_dev->get_num_devices_func (0);
if (num_devices <= 0 || ord >= num_devices)
acc_dev_num_out_of_range (acc_device_type (base_dev->type), ord,
num_devices);
-
+
if (!thr)
thr = goacc_new_thread ();
-
+
thr->base_dev = base_dev;
thr->dev = acc_dev = &base_dev[ord];
thr->saved_bound_dev = NULL;
@@ -540,10 +586,111 @@ goacc_attach_host_thread_to_device (int ord)
thr->target_tls
= acc_dev->openacc.create_thread_data_func (ord);
}
+void
+GOACC_init (int n_device, int d)
+{
+ /* The OpenACC spec says that if the n_device isn't specified
+ then all the devices available are initializated, but
+ the current acc_init_1 implementation initialize just the
+ goacc_device_num device number. acc_init_1 it's keeped
+ because the profiling dispatch code. */
+
+ gomp_init_targets_once ();
+ /* All the device types. */
+ if ((acc_device_t) d == acc_device_none)
+ {
+ int i;
+ for (i = 0; i < _ACC_device_hwm; i++)
+ {
+ if (!(GOACC_DIRECTIVE_DEVICE_MASK & (1 << i)))
+ continue;
+ gomp_mutex_lock (&acc_device_lock);
+
+ struct gomp_device_descr *dev
+ = resolve_device ((acc_device_t) i, false);
+ if (!dev || dev->get_num_devices_func (0) <= 0)
+ {
+ gomp_debug (0,
+ "init directive: Device type %s isn't available or "
+ "does not have devices.\n",
+ name_of_acc_device_t ((acc_device_t) i));
+ /* if isn't available, just continue. */
+ gomp_mutex_unlock (&acc_device_lock);
+ continue;
+ }
+
+ gomp_debug (0,
+ "init directive: Initializing device type %s and device "
+ "number %d. \n",
+ name_of_acc_device_t ((acc_device_t) i), n_device);
+ cached_base_dev
+ = acc_init_1 ((acc_device_t) i, acc_construct_init, 0, n_device);
+ gomp_mutex_unlock (&acc_device_lock);
+ }
+ }
+ else
+ {
+ gomp_debug (
+ 0, "init directive: Initializing device type %s and device number %d\n",
+ name_of_acc_device_t ((acc_device_t) d), n_device);
+
+ gomp_mutex_lock (&acc_device_lock);
+ cached_base_dev
+ = acc_init_1 ((acc_device_t) d, acc_construct_init, 0, n_device);
+ gomp_mutex_unlock (&acc_device_lock);
+
+ goacc_attach_host_thread_to_device (-1);
+ }
+}
+
+void
+GOACC_shutdown (int n_device, int d)
+{
+ gomp_init_targets_once ();
+
+ if ((acc_device_t) d == acc_device_none)
+ {
+ int i;
+ for (i = 0; i < _ACC_device_hwm; i++)
+ {
+ if (!(GOACC_DIRECTIVE_DEVICE_MASK & (1 << i)))
+ continue;
+
+ gomp_mutex_lock (&acc_device_lock);
+
+ struct gomp_device_descr *dev
+ = resolve_device ((acc_device_t) i, false);
+
+ if (!dev || dev->get_num_devices_func (0) <= 0)
+ {
+ gomp_mutex_unlock (&acc_device_lock);
+ continue;
+ }
+
+ acc_shutdown_1 ((acc_device_t) i, n_device);
+
+ gomp_mutex_unlock (&acc_device_lock);
+ }
+ }
+ else
+ {
+ gomp_mutex_lock (&acc_device_lock);
+
+ acc_shutdown_1 ((acc_device_t) d, n_device);
+
+ gomp_mutex_unlock (&acc_device_lock);
+ }
+}
+
+void
+GOACC_set_device_type_device_num (int n_device, int d)
+{
+ acc_set_device_type ((acc_device_t) d);
+ acc_set_device_num (n_device, (acc_device_t) d);
+}
/* OpenACC 2.0a (3.2.12, 3.2.13) doesn't specify whether the serialization of
init/shutdown is per-process or per-thread. We choose per-process. */
-
void
acc_init (acc_device_t d)
{
@@ -553,9 +700,9 @@ acc_init (acc_device_t d)
gomp_init_targets_once ();
gomp_mutex_lock (&acc_device_lock);
- cached_base_dev = acc_init_1 (d, acc_construct_runtime_api, 0);
+ cached_base_dev = acc_init_1 (d, acc_construct_runtime_api, 0, -1);
gomp_mutex_unlock (&acc_device_lock);
-
+
goacc_attach_host_thread_to_device (-1);
}
@@ -569,7 +716,7 @@ acc_shutdown (acc_device_t d)
gomp_mutex_lock (&acc_device_lock);
- acc_shutdown_1 (d);
+ acc_shutdown_1 (d, -1);
gomp_mutex_unlock (&acc_device_lock);
}
@@ -783,7 +930,7 @@ acc_set_device_num (int ord, acc_device_t d)
goacc_attach_host_thread_to_device (ord);
}
-
+
goacc_device_num = ord;
}
@@ -911,7 +1058,7 @@ goacc_restore_bind (void)
}
/* This is called from any OpenACC support function that may need to implicitly
- initialize the libgomp runtime, either globally or from a new host thread.
+ initialize the libgomp runtime, either globally or from a new host thread.
On exit "goacc_thread" will return a valid & populated thread block. */
attribute_hidden void
@@ -926,8 +1073,8 @@ goacc_lazy_initialize (void)
gomp_mutex_lock (&acc_device_lock);
if (!cached_base_dev)
- cached_base_dev = acc_init_1 (acc_device_default,
- acc_construct_parallel, 1);
+ cached_base_dev
+ = acc_init_1 (acc_device_default, acc_construct_parallel, 1, -1);
gomp_mutex_unlock (&acc_device_lock);
goacc_attach_host_thread_to_device (-1);
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/init-1.f90
b/libgomp/testsuite/libgomp.oacc-fortran/init-1.f90
new file mode 100644
index 00000000000..e33c4cb30ea
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-fortran/init-1.f90
@@ -0,0 +1,59 @@
+! { dg-do run }
+!
+! Test the OpenACC init directive at run time.
+
+use openacc
+
+implicit none
+
+logical :: l
+integer :: n
+
+if (acc_get_num_devices (acc_device_host) .ne. 1) stop 1
+
+!$acc init
+!$acc shutdown
+
+!$acc init device_type(host)
+
+if (acc_get_device_type () .ne. acc_device_host) stop 2
+if (acc_get_device_num (acc_device_host) .ne. 0) stop 3
+
+!$acc shutdown device_type(host)
+
+!$acc init device_type(host) device_num(0)
+
+if (acc_get_device_type () .ne. acc_device_host) stop 4
+if (acc_get_device_num (acc_device_host) .ne. 0) stop 5
+
+!$acc shutdown device_type(host)
+
+l = .true.
+!$acc init if (l) device_type(host)
+
+if (acc_get_device_type () .ne. acc_device_host) stop 6
+
+!$acc shutdown device_type(host)
+
+n = acc_get_num_devices (acc_device_default)
+!$acc init if (.false.) device_num(n)
+
+if (acc_get_num_devices (acc_device_nvidia) .ne. 0) then
+ l = .true.
+ !$acc init if (l) device_type(nvidia)
+ l = .false.
+ !$acc init if (l) device_type(host)
+ if (acc_get_device_type () .ne. acc_device_nvidia) stop 7
+ !$acc shutdown device_type(nvidia)
+end if
+
+if (acc_get_num_devices (acc_device_radeon) .ne. 0) then
+ l = .true.
+ !$acc init if (l) device_type(radeon)
+ l = .false.
+ !$acc init if (l) device_type(host)
+ if (acc_get_device_type () .ne. acc_device_radeon) stop 8
+ !$acc shutdown device_type(radeon)
+end if
+
+end
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/lib-1-directives.f90
b/libgomp/testsuite/libgomp.oacc-fortran/lib-1-directives.f90
new file mode 100644
index 00000000000..182b238f844
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-fortran/lib-1-directives.f90
@@ -0,0 +1,17 @@
+! { dg-do run }
+!
+! Port of lib-1.f90 replacing applicable runtime calls with directives.
+
+use openacc
+
+if (acc_get_num_devices (acc_device_host) .ne. 1) STOP 1
+!$acc set device_type(host)
+if (acc_get_device_type () .ne. acc_device_host) STOP 2
+!$acc set device_type(host) device_num(0)
+if (acc_get_device_num (acc_device_host) .ne. 0) STOP 3
+!$acc shutdown device_type(host)
+
+!$acc init device_type(host)
+!$acc shutdown device_type(host)
+
+end
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/lib-4-directives.f90
b/libgomp/testsuite/libgomp.oacc-fortran/lib-4-directives.f90
new file mode 100644
index 00000000000..b4e8a6e7a54
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-fortran/lib-4-directives.f90
@@ -0,0 +1,37 @@
+! { dg-do run }
+!
+! Port of lib-4.f90 replacing applicable runtime calls with directives.
+
+program main
+ use openacc
+ implicit none
+
+ integer n
+
+ if (acc_get_num_devices (acc_device_host) .ne. 1) STOP 1
+
+ if (acc_get_num_devices (acc_device_none) .ne. 0) STOP 2
+
+ !$acc init device_type(host)
+
+ if (acc_get_device_type () .ne. acc_device_host) STOP 3
+
+ !$acc set device_type(host)
+
+ if (acc_get_device_type () .ne. acc_device_host) STOP 4
+
+ n = 0
+
+ !$acc set device_type(host) device_num(n)
+
+ if (acc_get_device_num (acc_device_host) .ne. 0) STOP 5
+
+ if (.NOT. acc_async_test (n) ) STOP 6
+
+ call acc_wait (n)
+
+ call acc_wait_all ()
+
+ !$acc shutdown device_type(host)
+
+end program
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/lib-5-directives.f90
b/libgomp/testsuite/libgomp.oacc-fortran/lib-5-directives.f90
new file mode 100644
index 00000000000..dde01c28852
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-fortran/lib-5-directives.f90
@@ -0,0 +1,59 @@
+! { dg-do run }
+!
+! Port of lib-5.f90 replacing applicable runtime calls with directives.
+
+program main
+ use openacc
+ implicit none
+
+ integer n
+
+ if (acc_get_num_devices (acc_device_nvidia) .ne. 0) then
+
+ !$acc init device_type(nvidia)
+
+ n = 0
+
+ !$acc set device_type(nvidia) device_num(n)
+
+ if (acc_get_device_num (acc_device_nvidia) .ne. 0) stop 11
+
+ if (acc_get_num_devices (acc_device_nvidia) .gt. 1) then
+
+ n = 1
+
+ !$acc set device_type(nvidia) device_num(n)
+
+ if (acc_get_device_num (acc_device_nvidia) .ne. 1) stop 12
+
+ end if
+
+ !$acc shutdown device_type(nvidia)
+
+ end if
+
+ if (acc_get_num_devices (acc_device_radeon) .ne. 0) then
+
+ !$acc init device_type(radeon)
+
+ n = 0
+
+ !$acc set device_type(radeon) device_num(n)
+
+ if (acc_get_device_num (acc_device_radeon) .ne. 0) stop 21
+
+ if (acc_get_num_devices (acc_device_radeon) .gt. 1) then
+
+ n = 1
+
+ !$acc set device_type(radeon) device_num(n)
+
+ if (acc_get_device_num (acc_device_radeon) .ne. 1) stop 22
+
+ end if
+
+ !$acc shutdown device_type(radeon)
+
+ end if
+
+end program
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/lib-5-init.f90
b/libgomp/testsuite/libgomp.oacc-fortran/lib-5-init.f90
new file mode 100644
index 00000000000..3c50508e733
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-fortran/lib-5-init.f90
@@ -0,0 +1,59 @@
+! { dg-do run }
+!
+! Port of lib-5.f90 using !$acc init instead of call acc_init.
+
+program main
+ use openacc
+ implicit none
+
+ integer n
+
+ if (acc_get_num_devices (acc_device_nvidia) .ne. 0) then
+
+ !$acc init device_type(nvidia)
+
+ n = 0
+
+ call acc_set_device_num (n, acc_device_nvidia)
+
+ if (acc_get_device_num (acc_device_nvidia) .ne. 0) stop 11
+
+ if (acc_get_num_devices (acc_device_nvidia) .gt. 1) then
+
+ n = 1
+
+ call acc_set_device_num (n, acc_device_nvidia)
+
+ if (acc_get_device_num (acc_device_nvidia) .ne. 1) stop 12
+
+ end if
+
+ call acc_shutdown (acc_device_nvidia)
+
+ end if
+
+ if (acc_get_num_devices (acc_device_radeon) .ne. 0) then
+
+ !$acc init device_type(radeon)
+
+ n = 0
+
+ call acc_set_device_num (n, acc_device_radeon)
+
+ if (acc_get_device_num (acc_device_radeon) .ne. 0) stop 21
+
+ if (acc_get_num_devices (acc_device_radeon) .gt. 1) then
+
+ n = 1
+
+ call acc_set_device_num (n, acc_device_radeon)
+
+ if (acc_get_device_num (acc_device_radeon) .ne. 1) stop 22
+
+ end if
+
+ call acc_shutdown (acc_device_radeon)
+
+ end if
+
+end program
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/set-1.f90
b/libgomp/testsuite/libgomp.oacc-fortran/set-1.f90
new file mode 100644
index 00000000000..440c43e1638
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-fortran/set-1.f90
@@ -0,0 +1,82 @@
+! { dg-do run }
+!
+! Test the OpenACC set directive at run time.
+
+use openacc
+
+implicit none
+
+logical :: l
+integer :: n
+
+if (acc_get_num_devices (acc_device_host) .ne. 1) stop 1
+
+call acc_init (acc_device_host)
+
+!$acc set device_type(host)
+
+if (acc_get_device_type () .ne. acc_device_host) stop 2
+
+
+! This set device_num(0) call init all the devices,
+! so we can skip the init call later
+
+!$acc set device_num(0)
+
+if (acc_get_device_num (acc_device_host) .ne. 0) stop 3
+
+!$acc set device_type(host) device_num(0)
+
+if (acc_get_device_type () .ne. acc_device_host) stop 4
+if (acc_get_device_num (acc_device_host) .ne. 0) stop 5
+
+l = .true.
+!$acc set if (l) device_type(host)
+
+if (acc_get_device_type () .ne. acc_device_host) stop 6
+
+l = .false.
+n = 1
+!$acc set if (l) device_num(n)
+
+if (acc_get_device_num (acc_device_host) .ne. 0) stop 7
+
+call acc_shutdown (acc_device_host)
+
+if (acc_get_num_devices (acc_device_nvidia) .ne. 0) then
+
+ !$acc set device_type(nvidia)
+
+ if (acc_get_device_type () .ne. acc_device_nvidia) stop 11
+
+ n = 0
+ !$acc set device_type(nvidia) device_num(n)
+
+ if (acc_get_device_num (acc_device_nvidia) .ne. 0) stop 12
+
+ l = .false.
+ !$acc set if (l) device_type(host)
+ if (acc_get_device_type () .ne. acc_device_nvidia) stop 13
+
+ call acc_shutdown (acc_device_nvidia)
+end if
+
+if (acc_get_num_devices (acc_device_radeon) .ne. 0) then
+
+ !$acc set device_type(radeon)
+
+ if (acc_get_device_type () .ne. acc_device_radeon) stop 21
+
+ n = 0
+ !$acc set device_type(radeon) device_num(n)
+
+ if (acc_get_device_num (acc_device_radeon) .ne. 0) stop 22
+
+ l = .false.
+ !$acc set if (l) device_type(host)
+ if (acc_get_device_type () .ne. acc_device_radeon) stop 23
+
+ call acc_shutdown (acc_device_radeon)
+end if
+
+end
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/shutdown-1.f90
b/libgomp/testsuite/libgomp.oacc-fortran/shutdown-1.f90
new file mode 100644
index 00000000000..6cf06571f2c
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-fortran/shutdown-1.f90
@@ -0,0 +1,53 @@
+! { dg-do run }
+!
+! Test the OpenACC shutdown directive at run time.
+
+use openacc
+
+implicit none
+
+logical :: l
+integer :: n
+
+if (acc_get_num_devices (acc_device_host) .ne. 1) stop 1
+
+!$acc init device_type(host)
+
+if (acc_get_device_type () .ne. acc_device_host) stop 2
+if (acc_get_device_num (acc_device_host) .ne. 0) stop 3
+
+!$acc shutdown device_type(host)
+
+!$acc init device_type(host) device_num(0)
+
+!$acc shutdown device_type(host) device_num(0)
+
+l = .true.
+!$acc init if (l) device_type(host)
+
+if (acc_get_device_type () .ne. acc_device_host) stop 4
+
+!$acc shutdown if (l) device_type(host)
+
+n = acc_get_num_devices (acc_device_default)
+!$acc shutdown if (.false.) device_num(n)
+
+if (acc_get_num_devices (acc_device_nvidia) .ne. 0) then
+ l = .true.
+ !$acc init if (l) device_type(nvidia)
+ if (acc_get_device_type () .ne. acc_device_nvidia) stop 5
+ l = .false.
+ !$acc shutdown if (l) device_type(host)
+ !$acc shutdown device_type(nvidia)
+end if
+
+if (acc_get_num_devices (acc_device_radeon) .ne. 0) then
+ l = .true.
+ !$acc init if (l) device_type(radeon)
+ if (acc_get_device_type () .ne. acc_device_radeon) stop 6
+ l = .false.
+ !$acc shutdown if (l) device_type(host)
+ !$acc shutdown device_type(radeon)
+end if
+
+end
--
2.54.0
