Hi Sebastian!
Great work! Thanks for thoroughly addressing the review comments.
This is now in GCC trunk, commit 0dbe46aeaf5c06cbd3deaa833e5ae2150fe67c56
"Fortran support for init,set,shutdown OpenACC directives". :-)
I've only incorporated some small additional changes; that was easier for
me to just do, instead of describing to you what to do. See the attached
'patch' (on top of your changes), and the following comments:
In the mean time, the 'get_num_devices_func' libgomp plugin function
again lost its 'unsigned int omp_requires_mask' argument, so I've
adjusted the new code for that.
In 'gcc/fortran/openmp.cc:resolve_omp_clauses', in the new checks you've
added, we were ICEing (and therefore a good number of OpenMP test case
regressions). That function gets called with 'code == NULL': via
'gfc_resolve_omp_declare', 'gfc_resolve_omp_udm', so we can't
unconditionally dereference 'code'. I've fixed that as follows:
- if (!omp_clauses->device_num_expr &&
!omp_clauses->oacc_device_type_present
- && code->op == EXEC_OACC_SET)
+ if (code && code->op == EXEC_OACC_SET
+ && !omp_clauses->device_num_expr
+ && !omp_clauses->oacc_device_type_present)
gfc_error ([...]
I've decided to shorten 'GOACC_set_device_type_device_num' into
'GOACC_set_device' (and adjusted the ChangeLog for that).
Otherwise, just some minor reordering/reformatting/whitespace changes, to
make the new code fit into the existing even more naturally.
Grüße
Thomas
On 2026-07-30T10:28:01+0200, I wrote:
> From: Sebastian Galindo <[email protected]>
>
> 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.
>
> 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): 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.
> * libgomp_g.h (GOACC_init): Declare.
> (GOACC_shutdown): Likewise.
> (GOACC_set_device): 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): 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]>
> Co-authored-by: Thomas Schwinge <[email protected]>
> ---
> gcc/builtin-types.def | 1 +
> gcc/fortran/dump-parse-tree.cc | 31 +++
> gcc/fortran/frontend-passes.cc | 8 +
> gcc/fortran/gfortran.h | 4 +
> gcc/fortran/match.h | 3 +
> gcc/fortran/openmp.cc | 126 +++++++++++-
> gcc/fortran/parse.cc | 20 +-
> gcc/fortran/resolve.cc | 6 +
> gcc/fortran/st.cc | 3 +
> gcc/fortran/trans-openmp.cc | 74 ++++++-
> gcc/fortran/trans.cc | 3 +
> gcc/fortran/types.def | 1 +
> gcc/omp-builtins.def | 6 +
> .../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 | 6 +
> libgomp/oacc-init.c | 185 ++++++++++++++++--
> .../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, 1094 insertions(+), 24 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..19da735791e 100644
> --- a/gcc/builtin-types.def
> +++ b/gcc/builtin-types.def
> @@ -694,6 +694,7 @@ DEF_FUNCTION_TYPE_2 (BT_FN_PTR_CONST_PTR_UINT8, BT_PTR,
> BT_CONST_PTR, BT_UINT8)
> 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/fortran/dump-parse-tree.cc b/gcc/fortran/dump-parse-tree.cc
> index 8d13acd8656..da185baecec 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 9bf5d40b9cc..8abe07e8f59 100644
> --- a/gcc/fortran/frontend-passes.cc
> +++ b/gcc/fortran/frontend-passes.cc
> @@ -5740,6 +5740,14 @@ 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 3613dc8bd45..e559a2db0db 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,73 @@ 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 +1250,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 +3225,12 @@ 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 +3249,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 (",
> @@ -5007,6 +5091,12 @@ error:
> (omp_mask (OMP_CLAUSE_GANG) | OMP_CLAUSE_WORKER | OMP_CLAUSE_VECTOR
> \
> | 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
> @@ -5301,6 +5391,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
> @@ -11386,6 +11494,13 @@ 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 (code && code->op == EXEC_OACC_SET
> + && !omp_clauses->device_num_expr
> + && !omp_clauses->oacc_device_type_present)
> + 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)
> @@ -13638,6 +13753,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 ();
> }
> @@ -13971,6 +14092,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_SHUTDOWN:
> + case EXEC_OACC_SET:
> 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..eeb98865513 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_INIT: case ST_OACC_SHUTDOWN: case ST_OACC_SET
>
> /* 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 036da9a939e..389a7451619 100644
> --- a/gcc/fortran/resolve.cc
> +++ b/gcc/fortran/resolve.cc
> @@ -13053,6 +13053,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:
> @@ -14839,6 +14842,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 31a84d51f16..3e4375f6d60 100644
> --- a/gcc/fortran/trans-openmp.cc
> +++ b/gcc/fortran/trans-openmp.cc
> @@ -6412,6 +6412,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);
> }
>
> @@ -6482,7 +6486,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)
> {
> @@ -6504,6 +6508,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 ();
> }
> @@ -6515,6 +6523,67 @@ 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;
> + break;
> + default:
> + gcc_unreachable ();
> + }
> +
> + location_t loc = input_location;
> + gfc_omp_clauses *clauses = code->ext.omp_clauses;
> +
> + gfc_start_block (&block);
> +
> + tree n_device;
> + 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
> @@ -9893,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..500cc32ab4d 100644
> --- a/gcc/omp-builtins.def
> +++ b/gcc/omp-builtins.def
> @@ -51,6 +51,12 @@ DEF_GOACC_BUILTIN (BUILT_IN_GOACC_WAIT, "GOACC_wait",
> ATTR_NOTHROW_LIST)
> DEF_GOACC_BUILTIN (BUILT_IN_GOACC_DECLARE, "GOACC_declare",
> BT_FN_VOID_INT_SIZE_PTR_PTR_PTR, 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, "GOACC_set_device",
> + BT_FN_VOID_INT_INT, ATTR_NOTHROW_LIST)
>
> DEF_GOACC_BUILTIN_COMPILER (BUILT_IN_ACC_ON_DEVICE, "acc_on_device",
> BT_FN_INT_INT, ATTR_CONST_NOTHROW_LEAF_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..013c301c775
> --- /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 \\(-1, 2\\)"
> 1 "original" } }
> +! { dg-final { scan-tree-dump-times "__builtin_GOACC_set_device \\(-1, 5\\)"
> 1 "original" } }
> +! { dg-final { scan-tree-dump-times "__builtin_GOACC_set_device \\(0, 1\\)"
> 1 "original" } }
> +! { dg-final { scan-tree-dump-times "__builtin_GOACC_set_device \\(0, 2\\)"
> 1 "original" } }
> +! { dg-final { scan-tree-dump-times "__builtin_GOACC_set_device \\(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..00e47d65d4c 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;
> +} 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..9caf9c3571b 100644
> --- a/libgomp/libgomp_g.h
> +++ b/libgomp/libgomp_g.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 (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 bfd50bf39a5..b9e6d405b0b 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 ();
>
> - 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 ();
>
> - /* 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. */
> 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");
> @@ -541,6 +587,109 @@ goacc_attach_host_thread_to_device (int ord)
> = 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)
> + {
> + 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)
> + {
> + 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 (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. */
>
> @@ -553,7 +702,7 @@ 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 +718,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);
> }
> @@ -926,8 +1075,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.53.0
diff --git gcc/builtin-types.def gcc/builtin-types.def
index 1c49624d0bf..19da735791e 100644
--- gcc/builtin-types.def
+++ gcc/builtin-types.def
@@ -694,7 +694,6 @@ DEF_FUNCTION_TYPE_2 (BT_FN_PTR_CONST_PTR_UINT8, BT_PTR, BT_CONST_PTR, BT_UINT8)
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 gcc/fortran/frontend-passes.cc gcc/fortran/frontend-passes.cc
index cfcf1bff855..77d0f3bf24b 100644
--- gcc/fortran/frontend-passes.cc
+++ gcc/fortran/frontend-passes.cc
@@ -5730,13 +5730,10 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t codefn, walk_expr_fn_t exprfn,
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);
- }
-
+ WALK_SUBEXPR (co->ext.omp_clauses->device_num_expr);
break;
+
default:
break;
}
diff --git gcc/fortran/openmp.cc gcc/fortran/openmp.cc
index 93b31f11173..e559a2db0db 100644
--- gcc/fortran/openmp.cc
+++ gcc/fortran/openmp.cc
@@ -836,7 +836,6 @@ cleanup:
static int
match_oacc_device_type_kind (void)
{
-
char name[GFC_MAX_SYMBOL_LEN + 1];
/* Since device_type arg accept * as all,
@@ -3226,16 +3225,11 @@ 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) && openacc
&& gfc_match_dupl_check (!c->oacc_device_type_present,
- "device_type", true)
- == MATCH_YES
+ "device_type", true) == MATCH_YES
&& match_oacc_device_type (c) == MATCH_YES)
- {
- continue;
- }
-
+ continue;
if ((mask & OMP_CLAUSE_DEVICE_TYPE) && !openacc
&& gfc_match_dupl_check (c->device_type == OMP_DEVICE_TYPE_UNSET,
"device_type", true) == MATCH_YES)
@@ -3256,8 +3250,8 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
continue;
}
if ((mask & OMP_CLAUSE_DEVICE_NUM)
- && (m = gfc_match_dupl_check (!c->device_num_expr, "device_num"))
- != MATCH_NO)
+ && (m = gfc_match_dupl_check (!c->device_num_expr,
+ "device_num")) != MATCH_NO)
{
if (m == MATCH_ERROR)
goto error;
@@ -5097,16 +5091,14 @@ error:
(omp_mask (OMP_CLAUSE_GANG) | OMP_CLAUSE_WORKER | OMP_CLAUSE_VECTOR \
| 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)
{
@@ -11502,15 +11494,13 @@ 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)
+ if (code && code->op == EXEC_OACC_SET
+ && !omp_clauses->device_num_expr
+ && !omp_clauses->oacc_device_type_present)
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)
@@ -14103,8 +14093,8 @@ gfc_resolve_oacc_directive (gfc_code *code, gfc_namespace *ns ATTRIBUTE_UNUSED)
case EXEC_OACC_WAIT:
case EXEC_OACC_CACHE:
case EXEC_OACC_INIT:
- case EXEC_OACC_SET:
case EXEC_OACC_SHUTDOWN:
+ case EXEC_OACC_SET:
resolve_omp_clauses (code, code->ext.omp_clauses, NULL, true);
break;
case EXEC_OACC_PARALLEL_LOOP:
diff --git gcc/fortran/parse.cc gcc/fortran/parse.cc
index 958099dcdee..eeb98865513 100644
--- gcc/fortran/parse.cc
+++ gcc/fortran/parse.cc
@@ -1981,7 +1981,7 @@ next_statement (void)
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_SHUTDOWN: case ST_OACC_SET: case ST_OACC_INIT
+ case ST_OACC_INIT: case ST_OACC_SHUTDOWN: case ST_OACC_SET
/* Statements that mark other executable statements. */
diff --git gcc/fortran/trans-openmp.cc gcc/fortran/trans-openmp.cc
index a1a1f1103f5..e0af09c9401 100644
--- gcc/fortran/trans-openmp.cc
+++ gcc/fortran/trans-openmp.cc
@@ -6537,7 +6537,7 @@ builtin_oacc_exec_directive:
builtin_code = BUILT_IN_GOACC_SHUTDOWN;
break;
case EXEC_OACC_SET:
- builtin_code = BUILT_IN_GOACC_SET_DEVICE_TYPE_DEVICE_NUM;
+ builtin_code = BUILT_IN_GOACC_SET_DEVICE;
break;
default:
gcc_unreachable ();
@@ -6548,7 +6548,7 @@ builtin_oacc_exec_directive:
gfc_start_block (&block);
- tree n_device = NULL;
+ tree n_device;
if (clauses->device_num_expr)
n_device = gfc_convert_expr_to_tree (&block, clauses->device_num_expr);
else
@@ -6567,7 +6567,6 @@ builtin_oacc_exec_directive:
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;
@@ -6585,7 +6584,6 @@ builtin_oacc_exec_directive:
gfc_add_expr_to_block (&block, stmt);
return gfc_finish_block (&block);
-
}
static tree
diff --git gcc/omp-builtins.def gcc/omp-builtins.def
index 84b3c84db3f..500cc32ab4d 100644
--- gcc/omp-builtins.def
+++ gcc/omp-builtins.def
@@ -49,20 +49,15 @@ 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_DECLARE, "GOACC_declare",
+ BT_FN_VOID_INT_SIZE_PTR_PTR_PTR, 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",
+DEF_GOACC_BUILTIN (BUILT_IN_GOACC_SET_DEVICE, "GOACC_set_device",
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)
-
DEF_GOACC_BUILTIN_COMPILER (BUILT_IN_ACC_ON_DEVICE, "acc_on_device",
BT_FN_INT_INT, ATTR_CONST_NOTHROW_LEAF_LIST)
diff --git gcc/testsuite/gfortran.dg/goacc/acc-set-1.f90 gcc/testsuite/gfortran.dg/goacc/acc-set-1.f90
index 7ef5c6615f0..013c301c775 100644
--- gcc/testsuite/gfortran.dg/goacc/acc-set-1.f90
+++ gcc/testsuite/gfortran.dg/goacc/acc-set-1.f90
@@ -29,8 +29,8 @@ subroutine set4(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" } }
+! { dg-final { scan-tree-dump-times "__builtin_GOACC_set_device \\(-1, 2\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "__builtin_GOACC_set_device \\(-1, 5\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "__builtin_GOACC_set_device \\(0, 1\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "__builtin_GOACC_set_device \\(0, 2\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "__builtin_GOACC_set_device \\(1, 8\\)" 1 "original" } }
diff --git libgomp/libgomp.map libgomp/libgomp.map
index 5b3a9e3ca7a..00e47d65d4c 100644
--- libgomp/libgomp.map
+++ libgomp/libgomp.map
@@ -692,10 +692,10 @@ GOACC_2.0.2 {
} GOACC_2.0.1;
GOACC_2.5 {
- global:
- GOACC_init;
- GOACC_shutdown;
- GOACC_set_device_type_device_num;
+ global:
+ GOACC_init;
+ GOACC_shutdown;
+ GOACC_set_device;
} GOACC_2.0.2;
GOMP_PLUGIN_1.0 {
diff --git libgomp/libgomp_g.h libgomp/libgomp_g.h
index 5d7286b2558..9caf9c3571b 100644
--- libgomp/libgomp_g.h
+++ libgomp/libgomp_g.h
@@ -417,7 +417,7 @@ extern void GOACC_wait (int, int, ...);
extern void GOACC_init (int, int);
extern void GOACC_shutdown (int, int);
-extern void GOACC_set_device_type_device_num (int, int);
+extern void GOACC_set_device (int, int);
/* oacc-mem.c */
diff --git libgomp/oacc-init.c libgomp/oacc-init.c
index fde02a8e441..b9e6d405b0b 100644
--- libgomp/oacc-init.c
+++ libgomp/oacc-init.c
@@ -586,6 +586,7 @@ 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)
{
@@ -608,7 +609,7 @@ GOACC_init (int n_device, int d)
struct gomp_device_descr *dev
= resolve_device ((acc_device_t) i, false);
- if (!dev || dev->get_num_devices_func (0) <= 0)
+ if (!dev || dev->get_num_devices_func () <= 0)
{
gomp_debug (0,
"init directive: Device type %s isn't available or "
@@ -661,7 +662,7 @@ GOACC_shutdown (int n_device, int d)
struct gomp_device_descr *dev
= resolve_device ((acc_device_t) i, false);
- if (!dev || dev->get_num_devices_func (0) <= 0)
+ if (!dev || dev->get_num_devices_func () <= 0)
{
gomp_mutex_unlock (&acc_device_lock);
continue;
@@ -683,7 +684,7 @@ GOACC_shutdown (int n_device, int d)
}
void
-GOACC_set_device_type_device_num (int n_device, int d)
+GOACC_set_device (int n_device, int d)
{
acc_set_device_type ((acc_device_t) d);
acc_set_device_num (n_device, (acc_device_t) d);
