diff options
Diffstat (limited to 'gcc/fortran/openmp.c')
| -rw-r--r-- | gcc/fortran/openmp.c | 1670 |
1 files changed, 1403 insertions, 267 deletions
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index 1f1920c..a64b7f5 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -25,8 +25,10 @@ along with GCC; see the file COPYING3. If not see #include "arith.h" #include "match.h" #include "parse.h" +#include "constructor.h" #include "diagnostic.h" #include "gomp-constants.h" +#include "target-memory.h" /* For gfc_encode_character. */ /* Match an end of OpenMP directive. End of OpenMP directive is optional whitespace, followed by '\n' or comment '!'. */ @@ -103,7 +105,8 @@ gfc_free_omp_clauses (gfc_omp_clauses *c) gfc_free_expr (c->num_workers_expr); gfc_free_expr (c->vector_length_expr); for (i = 0; i < OMP_LIST_NUM; i++) - gfc_free_omp_namelist (c->lists[i]); + gfc_free_omp_namelist (c->lists[i], + i == OMP_LIST_AFFINITY || i == OMP_LIST_DEPEND); gfc_free_expr_list (c->wait_list); gfc_free_expr_list (c->tile_list); free (CONST_CAST (char *, c->critical_name)); @@ -261,6 +264,7 @@ gfc_match_omp_variable_list (const char *str, gfc_omp_namelist **list, case MATCH_YES: gfc_expr *expr; expr = NULL; + gfc_gobble_whitespace (); if ((allow_sections && gfc_peek_ascii_char () == '(') || (allow_derived && gfc_peek_ascii_char () == '%')) { @@ -354,7 +358,7 @@ syntax: gfc_error ("Syntax error in OpenMP variable list at %C"); cleanup: - gfc_free_omp_namelist (head); + gfc_free_omp_namelist (head, false); gfc_current_locus = old_loc; return MATCH_ERROR; } @@ -444,7 +448,7 @@ syntax: gfc_error ("Syntax error in OpenMP variable list at %C"); cleanup: - gfc_free_omp_namelist (head); + gfc_free_omp_namelist (head, false); gfc_current_locus = old_loc; return MATCH_ERROR; } @@ -551,7 +555,7 @@ syntax: gfc_error ("Syntax error in OpenMP DEPEND SINK list at %C"); cleanup: - gfc_free_omp_namelist (head); + gfc_free_omp_namelist (head, false); gfc_current_locus = old_loc; return MATCH_ERROR; } @@ -842,6 +846,12 @@ enum omp_mask1 OMP_CLAUSE_CAPTURE, /* OpenMP 5.0. */ OMP_CLAUSE_MEMORDER, /* OpenMP 5.0. */ OMP_CLAUSE_DETACH, /* OpenMP 5.0. */ + OMP_CLAUSE_AFFINITY, /* OpenMP 5.0. */ + OMP_CLAUSE_BIND, /* OpenMP 5.0. */ + OMP_CLAUSE_FILTER, /* OpenMP 5.1. */ + OMP_CLAUSE_AT, /* OpenMP 5.1. */ + OMP_CLAUSE_MESSAGE, /* OpenMP 5.1. */ + OMP_CLAUSE_SEVERITY, /* OpenMP 5.1. */ OMP_CLAUSE_NOWAIT, /* This must come last. */ OMP_MASK1_LAST @@ -875,6 +885,7 @@ enum omp_mask2 OMP_CLAUSE_IF_PRESENT, OMP_CLAUSE_FINALIZE, OMP_CLAUSE_ATTACH, + OMP_CLAUSE_NOHOST, /* This must come last. */ OMP_MASK2_LAST }; @@ -995,6 +1006,132 @@ gfc_match_omp_map_clause (gfc_omp_namelist **list, gfc_omp_map_op map_op, return false; } +static match +gfc_match_iterator (gfc_namespace **ns, bool permit_var) +{ + locus old_loc = gfc_current_locus; + + if (gfc_match ("iterator ( ") != MATCH_YES) + return MATCH_NO; + + gfc_typespec ts; + gfc_symbol *last = NULL; + gfc_expr *begin, *end, *step; + *ns = gfc_build_block_ns (gfc_current_ns); + char name[GFC_MAX_SYMBOL_LEN + 1]; + while (true) + { + locus prev_loc = gfc_current_locus; + if (gfc_match_type_spec (&ts) == MATCH_YES + && gfc_match (" :: ") == MATCH_YES) + { + if (ts.type != BT_INTEGER) + { + gfc_error ("Expected INTEGER type at %L", &prev_loc); + return MATCH_ERROR; + } + permit_var = false; + } + else + { + ts.type = BT_INTEGER; + ts.kind = gfc_default_integer_kind; + gfc_current_locus = prev_loc; + } + prev_loc = gfc_current_locus; + if (gfc_match_name (name) != MATCH_YES) + { + gfc_error ("Expected identifier at %C"); + goto failed; + } + if (gfc_find_symtree ((*ns)->sym_root, name)) + { + gfc_error ("Same identifier %qs specified again at %C", name); + goto failed; + } + + gfc_symbol *sym = gfc_new_symbol (name, *ns); + if (last) + last->tlink = sym; + else + (*ns)->proc_name = sym; + last = sym; + sym->declared_at = prev_loc; + sym->ts = ts; + sym->attr.flavor = FL_VARIABLE; + sym->attr.artificial = 1; + sym->attr.referenced = 1; + sym->refs++; + gfc_symtree *st = gfc_new_symtree (&(*ns)->sym_root, name); + st->n.sym = sym; + + prev_loc = gfc_current_locus; + if (gfc_match (" = ") != MATCH_YES) + goto failed; + permit_var = false; + begin = end = step = NULL; + if (gfc_match ("%e : ", &begin) != MATCH_YES + || gfc_match ("%e ", &end) != MATCH_YES) + { + gfc_error ("Expected range-specification at %C"); + gfc_free_expr (begin); + gfc_free_expr (end); + return MATCH_ERROR; + } + if (':' == gfc_peek_ascii_char ()) + { + step = gfc_get_expr (); + if (gfc_match (": %e ", &step) != MATCH_YES) + { + gfc_free_expr (begin); + gfc_free_expr (end); + gfc_free_expr (step); + goto failed; + } + } + + gfc_expr *e = gfc_get_expr (); + e->where = prev_loc; + e->expr_type = EXPR_ARRAY; + e->ts = ts; + e->rank = 1; + e->shape = gfc_get_shape (1); + mpz_init_set_ui (e->shape[0], step ? 3 : 2); + gfc_constructor_append_expr (&e->value.constructor, begin, &begin->where); + gfc_constructor_append_expr (&e->value.constructor, end, &end->where); + if (step) + gfc_constructor_append_expr (&e->value.constructor, step, &step->where); + sym->value = e; + + if (gfc_match (") ") == MATCH_YES) + break; + if (gfc_match (", ") != MATCH_YES) + goto failed; + } + return MATCH_YES; + +failed: + gfc_namespace *prev_ns = NULL; + for (gfc_namespace *it = gfc_current_ns->contained; it; it = it->sibling) + { + if (it == *ns) + { + if (prev_ns) + prev_ns->sibling = it->sibling; + else + gfc_current_ns->contained = it->sibling; + gfc_free_namespace (it); + break; + } + prev_ns = it; + } + *ns = NULL; + if (!permit_var) + return MATCH_ERROR; + gfc_current_locus = old_loc; + return MATCH_NO; +} + /* reduction ( reduction-modifier, reduction-operator : variable-list ) in_reduction ( reduction-operator : variable-list ) task_reduction ( reduction-operator : variable-list ) */ @@ -1137,7 +1274,7 @@ gfc_match_omp_clause_reduction (char pc, gfc_omp_clauses *c, bool openacc, *head = NULL; gfc_error_now ("!$OMP DECLARE REDUCTION %s not found at %L", buffer, &old_loc); - gfc_free_omp_namelist (n); + gfc_free_omp_namelist (n, false); } else for (n = *head; n; n = n->next) @@ -1145,13 +1282,71 @@ gfc_match_omp_clause_reduction (char pc, gfc_omp_clauses *c, bool openacc, n->u.reduction_op = rop; if (udr) { - n->udr = gfc_get_omp_namelist_udr (); - n->udr->udr = udr; + n->u2.udr = gfc_get_omp_namelist_udr (); + n->u2.udr->udr = udr; } } return MATCH_YES; } + +/* Match with duplicate check. Matches 'name'. If expr != NULL, it + then matches '(expr)', otherwise, if open_parens is true, + it matches a ' ( ' after 'name'. + dupl_message requires '%qs %L' - and is used by + gfc_match_dupl_memorder and gfc_match_dupl_atomic. */ + +static match +gfc_match_dupl_check (bool not_dupl, const char *name, bool open_parens = false, + gfc_expr **expr = NULL, const char *dupl_msg = NULL) +{ + match m; + locus old_loc = gfc_current_locus; + if ((m = gfc_match (name)) != MATCH_YES) + return m; + if (!not_dupl) + { + if (dupl_msg) + gfc_error (dupl_msg, name, &old_loc); + else + gfc_error ("Duplicated %qs clause at %L", name, &old_loc); + return MATCH_ERROR; + } + if (open_parens || expr) + { + if (gfc_match (" ( ") != MATCH_YES) + { + gfc_error ("Expected %<(%> after %qs at %C", name); + return MATCH_ERROR; + } + if (expr) + { + if (gfc_match ("%e )", expr) != MATCH_YES) + { + gfc_error ("Invalid expression after %<%s(%> at %C", name); + return MATCH_ERROR; + } + } + } + return MATCH_YES; +} + +static match +gfc_match_dupl_memorder (bool not_dupl, const char *name) +{ + return gfc_match_dupl_check (not_dupl, name, false, NULL, + "Duplicated memory-order clause: unexpected %s " + "clause at %L"); +} + +static match +gfc_match_dupl_atomic (bool not_dupl, const char *name) +{ + return gfc_match_dupl_check (not_dupl, name, false, NULL, + "Duplicated atomic clause: unexpected %s " + "clause at %L"); +} + /* Match OpenMP and OpenACC directive clauses. MASK is a bitmask of clauses that are allowed for a particular directive. */ @@ -1160,6 +1355,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, bool first = true, bool needs_space = true, bool openacc = false) { + bool error = false; gfc_omp_clauses *c = gfc_get_omp_clauses (); locus old_loc; /* Determine whether we're dealing with an OpenACC directive that permits @@ -1185,6 +1381,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, gfc_omp_namelist **head; old_loc = gfc_current_locus; char pc = gfc_peek_ascii_char (); + match m; switch (pc) { case 'a': @@ -1201,7 +1398,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, if (end_colon && gfc_match (" %e )", &alignment) != MATCH_YES) { - gfc_free_omp_namelist (*head); + gfc_free_omp_namelist (*head, false); gfc_current_locus = old_loc; *head = NULL; break; @@ -1214,27 +1411,82 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, continue; } if ((mask & OMP_CLAUSE_MEMORDER) - && c->memorder == OMP_MEMORDER_UNSET - && gfc_match ("acq_rel") == MATCH_YES) + && (m = gfc_match_dupl_memorder ((c->memorder + == OMP_MEMORDER_UNSET), + "acq_rel")) != MATCH_NO) { + if (m == MATCH_ERROR) + goto error; c->memorder = OMP_MEMORDER_ACQ_REL; needs_space = true; continue; } if ((mask & OMP_CLAUSE_MEMORDER) - && c->memorder == OMP_MEMORDER_UNSET - && gfc_match ("acquire") == MATCH_YES) + && (m = gfc_match_dupl_memorder ((c->memorder + == OMP_MEMORDER_UNSET), + "acquire")) != MATCH_NO) { + if (m == MATCH_ERROR) + goto error; c->memorder = OMP_MEMORDER_ACQUIRE; needs_space = true; continue; } + if ((mask & OMP_CLAUSE_AFFINITY) + && gfc_match ("affinity ( ") == MATCH_YES) + { + gfc_namespace *ns_iter = NULL, *ns_curr = gfc_current_ns; + m = gfc_match_iterator (&ns_iter, true); + if (m == MATCH_ERROR) + break; + if (m == MATCH_YES && gfc_match (" : ") != MATCH_YES) + { + gfc_error ("Expected %<:%> at %C"); + break; + } + if (ns_iter) + gfc_current_ns = ns_iter; + head = NULL; + m = gfc_match_omp_variable_list ("", &c->lists[OMP_LIST_AFFINITY], + false, NULL, &head, true); + gfc_current_ns = ns_curr; + if (m == MATCH_ERROR) + break; + if (ns_iter) + { + for (gfc_omp_namelist *n = *head; n; n = n->next) + { + n->u2.ns = ns_iter; + ns_iter->refs++; + } + } + continue; + } + if ((mask & OMP_CLAUSE_AT) + && (m = gfc_match_dupl_check (c->at == OMP_AT_UNSET, "at", true)) + != MATCH_NO) + { + if (m == MATCH_ERROR) + goto error; + if (gfc_match ("compilation )") == MATCH_YES) + c->at = OMP_AT_COMPILATION; + else if (gfc_match ("execution )") == MATCH_YES) + c->at = OMP_AT_EXECUTION; + else + { + gfc_error ("Expected COMPILATION or EXECUTION in AT clause " + "at %C"); + goto error; + } + continue; + } if ((mask & OMP_CLAUSE_ASYNC) - && !c->async - && gfc_match ("async") == MATCH_YES) + && (m = gfc_match_dupl_check (!c->async, "async")) != MATCH_NO) { + if (m == MATCH_ERROR) + goto error; c->async = true; - match m = gfc_match (" ( %e )", &c->async_expr); + m = gfc_match (" ( %e )", &c->async_expr); if (m == MATCH_ERROR) { gfc_current_locus = old_loc; @@ -1252,9 +1504,11 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, continue; } if ((mask & OMP_CLAUSE_AUTO) - && !c->par_auto - && gfc_match ("auto") == MATCH_YES) + && (m = gfc_match_dupl_check (!c->par_auto, "auto")) + != MATCH_NO) { + if (m == MATCH_ERROR) + goto error; c->par_auto = true; needs_space = true; continue; @@ -1266,36 +1520,60 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, allow_derived)) continue; break; + case 'b': + if ((mask & OMP_CLAUSE_BIND) + && (m = gfc_match_dupl_check (c->bind == OMP_BIND_UNSET, "bind", + true)) != MATCH_NO) + { + if (m == MATCH_ERROR) + goto error; + if (gfc_match ("teams )") == MATCH_YES) + c->bind = OMP_BIND_TEAMS; + else if (gfc_match ("parallel )") == MATCH_YES) + c->bind = OMP_BIND_PARALLEL; + else if (gfc_match ("thread )") == MATCH_YES) + c->bind = OMP_BIND_THREAD; + else + { + gfc_error ("Expected TEAMS, PARALLEL or THREAD as binding in " + "BIND at %C"); + break; + } + continue; + } + break; case 'c': if ((mask & OMP_CLAUSE_CAPTURE) - && !c->capture - && gfc_match ("capture") == MATCH_YES) + && (m = gfc_match_dupl_check (!c->capture, "capture")) + != MATCH_NO) { + if (m == MATCH_ERROR) + goto error; c->capture = true; needs_space = true; continue; } - if ((mask & OMP_CLAUSE_COLLAPSE) - && !c->collapse) + if (mask & OMP_CLAUSE_COLLAPSE) { gfc_expr *cexpr = NULL; - match m = gfc_match ("collapse ( %e )", &cexpr); - - if (m == MATCH_YES) - { - int collapse; - if (gfc_extract_int (cexpr, &collapse, -1)) + if ((m = gfc_match_dupl_check (!c->collapse, "collapse", true, + &cexpr)) != MATCH_NO) + { + int collapse; + if (m == MATCH_ERROR) + goto error; + if (gfc_extract_int (cexpr, &collapse, -1)) + collapse = 1; + else if (collapse <= 0) + { + gfc_error_now ("COLLAPSE clause argument not constant " + "positive integer at %C"); collapse = 1; - else if (collapse <= 0) - { - gfc_error_now ("COLLAPSE clause argument not" - " constant positive integer at %C"); - collapse = 1; - } - c->collapse = collapse; - gfc_free_expr (cexpr); - continue; - } + } + gfc_free_expr (cexpr); + c->collapse = collapse; + continue; + } } if ((mask & OMP_CLAUSE_COPY) && gfc_match ("copy ( ") == MATCH_YES @@ -1335,33 +1613,125 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, continue; break; case 'd': + if ((mask & OMP_CLAUSE_DEFAULTMAP) + && gfc_match ("defaultmap ( ") == MATCH_YES) + { + enum gfc_omp_defaultmap behavior; + gfc_omp_defaultmap_category category + = OMP_DEFAULTMAP_CAT_UNCATEGORIZED; + if (gfc_match ("alloc ") == MATCH_YES) + behavior = OMP_DEFAULTMAP_ALLOC; + else if (gfc_match ("tofrom ") == MATCH_YES) + behavior = OMP_DEFAULTMAP_TOFROM; + else if (gfc_match ("to ") == MATCH_YES) + behavior = OMP_DEFAULTMAP_TO; + else if (gfc_match ("from ") == MATCH_YES) + behavior = OMP_DEFAULTMAP_FROM; + else if (gfc_match ("firstprivate ") == MATCH_YES) + behavior = OMP_DEFAULTMAP_FIRSTPRIVATE; + else if (gfc_match ("none ") == MATCH_YES) + behavior = OMP_DEFAULTMAP_NONE; + else if (gfc_match ("default ") == MATCH_YES) + behavior = OMP_DEFAULTMAP_DEFAULT; + else + { + gfc_error ("Expected ALLOC, TO, FROM, TOFROM, FIRSTPRIVATE, " + "NONE or DEFAULT at %C"); + break; + } + if (')' == gfc_peek_ascii_char ()) + ; + else if (gfc_match (": ") != MATCH_YES) + break; + else + { + if (gfc_match ("scalar ") == MATCH_YES) + category = OMP_DEFAULTMAP_CAT_SCALAR; + else if (gfc_match ("aggregate ") == MATCH_YES) + category = OMP_DEFAULTMAP_CAT_AGGREGATE; + else if (gfc_match ("allocatable ") == MATCH_YES) + category = OMP_DEFAULTMAP_CAT_ALLOCATABLE; + else if (gfc_match ("pointer ") == MATCH_YES) + category = OMP_DEFAULTMAP_CAT_POINTER; + else + { + gfc_error ("Expected SCALAR, AGGREGATE, ALLOCATABLE or " + "POINTER at %C"); + break; + } + } + for (int i = 0; i < OMP_DEFAULTMAP_CAT_NUM; ++i) + { + if (i != category + && category != OMP_DEFAULTMAP_CAT_UNCATEGORIZED) + continue; + if (c->defaultmap[i] != OMP_DEFAULTMAP_UNSET) + { + const char *pcategory = NULL; + switch (i) + { + case OMP_DEFAULTMAP_CAT_UNCATEGORIZED: break; + case OMP_DEFAULTMAP_CAT_SCALAR: pcategory = "SCALAR"; break; + case OMP_DEFAULTMAP_CAT_AGGREGATE: + pcategory = "AGGREGATE"; + break; + case OMP_DEFAULTMAP_CAT_ALLOCATABLE: + pcategory = "ALLOCATABLE"; + break; + case OMP_DEFAULTMAP_CAT_POINTER: + pcategory = "POINTER"; + break; + default: gcc_unreachable (); + } + if (i == OMP_DEFAULTMAP_CAT_UNCATEGORIZED) + gfc_error ("DEFAULTMAP at %C but prior DEFAULTMAP with " + "unspecified category"); + else + gfc_error ("DEFAULTMAP at %C but prior DEFAULTMAP for " + "category %s", pcategory); + goto error; + } + } + c->defaultmap[category] = behavior; + if (gfc_match (")") != MATCH_YES) + break; + continue; + } if ((mask & OMP_CLAUSE_DEFAULT) - && c->default_sharing == OMP_DEFAULT_UNKNOWN) + && (m = gfc_match_dupl_check (c->default_sharing + == OMP_DEFAULT_UNKNOWN, "default", + true)) != MATCH_NO) { - if (gfc_match ("default ( none )") == MATCH_YES) + if (m == MATCH_ERROR) + goto error; + if (gfc_match ("none") == MATCH_YES) c->default_sharing = OMP_DEFAULT_NONE; else if (openacc) { - if (gfc_match ("default ( present )") == MATCH_YES) + if (gfc_match ("present") == MATCH_YES) c->default_sharing = OMP_DEFAULT_PRESENT; } else { - if (gfc_match ("default ( firstprivate )") == MATCH_YES) + if (gfc_match ("firstprivate") == MATCH_YES) c->default_sharing = OMP_DEFAULT_FIRSTPRIVATE; - else if (gfc_match ("default ( private )") == MATCH_YES) + else if (gfc_match ("private") == MATCH_YES) c->default_sharing = OMP_DEFAULT_PRIVATE; - else if (gfc_match ("default ( shared )") == MATCH_YES) + else if (gfc_match ("shared") == MATCH_YES) c->default_sharing = OMP_DEFAULT_SHARED; } - if (c->default_sharing != OMP_DEFAULT_UNKNOWN) - continue; - } - if ((mask & OMP_CLAUSE_DEFAULTMAP) - && !c->defaultmap - && gfc_match ("defaultmap ( tofrom : scalar )") == MATCH_YES) - { - c->defaultmap = true; + if (c->default_sharing == OMP_DEFAULT_UNKNOWN) + { + if (openacc) + gfc_error ("Expected NONE or PRESENT in DEFAULT clause " + "at %C"); + else + gfc_error ("Expected NONE, FIRSTPRIVATE, PRIVATE or SHARED " + "in DEFAULT clause at %C"); + goto error; + } + if (gfc_match (" )") != MATCH_YES) + goto error; continue; } if ((mask & OMP_CLAUSE_DELETE) @@ -1373,7 +1743,13 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, if ((mask & OMP_CLAUSE_DEPEND) && gfc_match ("depend ( ") == MATCH_YES) { - match m = MATCH_YES; + gfc_namespace *ns_iter = NULL, *ns_curr = gfc_current_ns; + match m_it = gfc_match_iterator (&ns_iter, false); + if (m_it == MATCH_ERROR) + break; + if (m_it == MATCH_YES && gfc_match (" , ") != MATCH_YES) + break; + m = MATCH_YES; gfc_omp_depend_op depend_op = OMP_DEPEND_OUT; if (gfc_match ("inout") == MATCH_YES) depend_op = OMP_DEPEND_INOUT; @@ -1381,14 +1757,31 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, depend_op = OMP_DEPEND_IN; else if (gfc_match ("out") == MATCH_YES) depend_op = OMP_DEPEND_OUT; + else if (gfc_match ("mutexinoutset") == MATCH_YES) + depend_op = OMP_DEPEND_MUTEXINOUTSET; + else if (gfc_match ("depobj") == MATCH_YES) + depend_op = OMP_DEPEND_DEPOBJ; else if (!c->depend_source && gfc_match ("source )") == MATCH_YES) { + if (m_it == MATCH_YES) + { + gfc_error ("ITERATOR may not be combined with SOURCE " + "at %C"); + gfc_free_omp_clauses (c); + return MATCH_ERROR; + } c->depend_source = true; continue; } else if (gfc_match ("sink : ") == MATCH_YES) { + if (m_it == MATCH_YES) + { + gfc_error ("ITERATOR may not be combined with SINK " + "at %C"); + break; + } if (gfc_match_omp_depend_sink (&c->lists[OMP_LIST_DEPEND]) == MATCH_YES) continue; @@ -1397,19 +1790,26 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, else m = MATCH_NO; head = NULL; - if (m == MATCH_YES - && gfc_match_omp_variable_list (" : ", - &c->lists[OMP_LIST_DEPEND], - false, NULL, &head, - true) == MATCH_YES) + if (ns_iter) + gfc_current_ns = ns_iter; + if (m == MATCH_YES) + m = gfc_match_omp_variable_list (" : ", + &c->lists[OMP_LIST_DEPEND], + false, NULL, &head, true); + gfc_current_ns = ns_curr; + if (m == MATCH_YES) { gfc_omp_namelist *n; for (n = *head; n; n = n->next) - n->u.depend_op = depend_op; + { + n->u.depend_op = depend_op; + n->u2.ns = ns_iter; + if (ns_iter) + ns_iter->refs++; + } continue; } - else - gfc_current_locus = old_loc; + break; } if ((mask & OMP_CLAUSE_DETACH) && !openacc @@ -1425,9 +1825,56 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, continue; if ((mask & OMP_CLAUSE_DEVICE) && !openacc - && c->device == NULL - && gfc_match ("device ( %e )", &c->device) == MATCH_YES) - continue; + && ((m = gfc_match_dupl_check (!c->device, "device", true)) + != MATCH_NO)) + { + if (m == MATCH_ERROR) + goto error; + c->ancestor = false; + if (gfc_match ("device_num : ") == MATCH_YES) + { + if (gfc_match ("%e )", &c->device) != MATCH_YES) + { + gfc_error ("Expected integer expression at %C"); + break; + } + } + else if (gfc_match ("ancestor : ") == MATCH_YES) + { + c->ancestor = true; + if (!(gfc_current_ns->omp_requires & OMP_REQ_REVERSE_OFFLOAD)) + { + gfc_error ("%<ancestor%> device modifier not " + "preceded by %<requires%> directive " + "with %<reverse_offload%> clause at %C"); + break; + } + locus old_loc2 = gfc_current_locus; + if (gfc_match ("%e )", &c->device) == MATCH_YES) + { + int device = 0; + if (!gfc_extract_int (c->device, &device) && device != 1) + { + gfc_current_locus = old_loc2; + gfc_error ("the %<device%> clause expression must " + "evaluate to %<1%> at %C"); + break; + } + } + else + { + gfc_error ("Expected integer expression at %C"); + break; + } + } + else if (gfc_match ("%e )", &c->device) != MATCH_YES) + { + gfc_error ("Expected integer expression or a single device-" + "modifier %<device_num%> or %<ancestor%> at %C"); + break; + } + continue; + } if ((mask & OMP_CLAUSE_DEVICE) && openacc && gfc_match ("device ( ") == MATCH_YES @@ -1468,7 +1915,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, && c->dist_sched_kind == OMP_SCHED_NONE && gfc_match ("dist_schedule ( static") == MATCH_YES) { - match m = MATCH_NO; + m = MATCH_NO; c->dist_sched_kind = OMP_SCHED_STATIC; m = gfc_match (" , %e )", &c->dist_chunk_size); if (m != MATCH_YES) @@ -1483,14 +1930,28 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, } break; case 'f': + if ((mask & OMP_CLAUSE_FILTER) + && (m = gfc_match_dupl_check (!c->filter, "filter", true, + &c->filter)) != MATCH_NO) + { + if (m == MATCH_ERROR) + goto error; + continue; + } if ((mask & OMP_CLAUSE_FINAL) - && c->final_expr == NULL - && gfc_match ("final ( %e )", &c->final_expr) == MATCH_YES) - continue; + && (m = gfc_match_dupl_check (!c->final_expr, "final", true, + &c->final_expr)) != MATCH_NO) + { + if (m == MATCH_ERROR) + goto error; + continue; + } if ((mask & OMP_CLAUSE_FINALIZE) - && !c->finalize - && gfc_match ("finalize") == MATCH_YES) + && (m = gfc_match_dupl_check (!c->finalize, "finalize")) + != MATCH_NO) { + if (m == MATCH_ERROR) + goto error; c->finalize = true; needs_space = true; continue; @@ -1508,11 +1969,12 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, break; case 'g': if ((mask & OMP_CLAUSE_GANG) - && !c->gang - && gfc_match ("gang") == MATCH_YES) + && (m = gfc_match_dupl_check (!c->gang, "gang")) != MATCH_NO) { + if (m == MATCH_ERROR) + goto error; c->gang = true; - match m = match_oacc_clause_gwv (c, GOMP_DIM_GANG); + m = match_oacc_clause_gwv (c, GOMP_DIM_GANG); if (m == MATCH_ERROR) { gfc_current_locus = old_loc; @@ -1523,15 +1985,27 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, continue; } if ((mask & OMP_CLAUSE_GRAINSIZE) - && c->grainsize == NULL - && gfc_match ("grainsize ( %e )", &c->grainsize) == MATCH_YES) - continue; + && (m = gfc_match_dupl_check (!c->grainsize, "grainsize", true)) + != MATCH_NO) + { + if (m == MATCH_ERROR) + goto error; + if (gfc_match ("strict : ") == MATCH_YES) + c->grainsize_strict = true; + if (gfc_match (" %e )", &c->grainsize) != MATCH_YES) + goto error; + continue; + } break; case 'h': if ((mask & OMP_CLAUSE_HINT) - && c->hint == NULL - && gfc_match ("hint ( %e )", &c->hint) == MATCH_YES) - continue; + && (m = gfc_match_dupl_check (!c->hint, "hint", true, &c->hint)) + != MATCH_NO) + { + if (m == MATCH_ERROR) + goto error; + continue; + } if ((mask & OMP_CLAUSE_HOST_SELF) && gfc_match ("host ( ") == MATCH_YES && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP], @@ -1540,24 +2014,36 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, continue; break; case 'i': + if ((mask & OMP_CLAUSE_IF_PRESENT) + && (m = gfc_match_dupl_check (!c->if_present, "if_present")) + != MATCH_NO) + { + if (m == MATCH_ERROR) + goto error; + c->if_present = true; + needs_space = true; + continue; + } if ((mask & OMP_CLAUSE_IF) - && c->if_expr == NULL - && gfc_match ("if ( ") == MATCH_YES) + && (m = gfc_match_dupl_check (!c->if_expr, "if", true)) + != MATCH_NO) { + if (m == MATCH_ERROR) + goto error; if (!openacc) { /* This should match the enum gfc_omp_if_kind order. */ static const char *ifs[OMP_IF_LAST] = { - " cancel : %e )", - " parallel : %e )", - " simd : %e )", - " task : %e )", - " taskloop : %e )", - " target : %e )", - " target data : %e )", - " target update : %e )", - " target enter data : %e )", - " target exit data : %e )" }; + "cancel : %e )", + "parallel : %e )", + "simd : %e )", + "task : %e )", + "taskloop : %e )", + "target : %e )", + "target data : %e )", + "target update : %e )", + "target enter data : %e )", + "target exit data : %e )" }; int i; for (i = 0; i < OMP_IF_LAST; i++) if (c->if_exprs[i] == NULL @@ -1566,34 +2052,29 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, if (i < OMP_IF_LAST) continue; } - if (gfc_match ("%e )", &c->if_expr) == MATCH_YES) + if (gfc_match (" %e )", &c->if_expr) == MATCH_YES) continue; - gfc_current_locus = old_loc; - } - if ((mask & OMP_CLAUSE_IF_PRESENT) - && !c->if_present - && gfc_match ("if_present") == MATCH_YES) - { - c->if_present = true; - needs_space = true; - continue; + goto error; } if ((mask & OMP_CLAUSE_IN_REDUCTION) && gfc_match_omp_clause_reduction (pc, c, openacc, allow_derived) == MATCH_YES) continue; if ((mask & OMP_CLAUSE_INBRANCH) - && !c->inbranch - && !c->notinbranch - && gfc_match ("inbranch") == MATCH_YES) + && (m = gfc_match_dupl_check (!c->inbranch && !c->notinbranch, + "inbranch")) != MATCH_NO) { + if (m == MATCH_ERROR) + goto error; c->inbranch = needs_space = true; continue; } if ((mask & OMP_CLAUSE_INDEPENDENT) - && !c->independent - && gfc_match ("independent") == MATCH_YES) + && (m = gfc_match_dupl_check (!c->independent, "independent")) + != MATCH_NO) { + if (m == MATCH_ERROR) + goto error; c->independent = true; needs_space = true; continue; @@ -1661,7 +2142,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, end_colon = true; else if (gfc_match (" )") != MATCH_YES) { - gfc_free_omp_namelist (*head); + gfc_free_omp_namelist (*head, false); gfc_current_locus = old_loc; *head = NULL; break; @@ -1669,7 +2150,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, } if (end_colon && gfc_match (" %e )", &step) != MATCH_YES) { - gfc_free_omp_namelist (*head); + gfc_free_omp_namelist (*head, false); gfc_current_locus = old_loc; *head = NULL; break; @@ -1705,27 +2186,62 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, && gfc_match ("map ( ") == MATCH_YES) { locus old_loc2 = gfc_current_locus; - bool always = false; + int always_modifier = 0; + int close_modifier = 0; + locus second_always_locus = old_loc2; + locus second_close_locus = old_loc2; + + for (;;) + { + locus current_locus = gfc_current_locus; + if (gfc_match ("always ") == MATCH_YES) + { + if (always_modifier++ == 1) + second_always_locus = current_locus; + } + else if (gfc_match ("close ") == MATCH_YES) + { + if (close_modifier++ == 1) + second_close_locus = current_locus; + } + else + break; + gfc_match (", "); + } + gfc_omp_map_op map_op = OMP_MAP_TOFROM; - if (gfc_match ("always , ") == MATCH_YES) - always = true; if (gfc_match ("alloc : ") == MATCH_YES) map_op = OMP_MAP_ALLOC; else if (gfc_match ("tofrom : ") == MATCH_YES) - map_op = always ? OMP_MAP_ALWAYS_TOFROM : OMP_MAP_TOFROM; + map_op = always_modifier ? OMP_MAP_ALWAYS_TOFROM : OMP_MAP_TOFROM; else if (gfc_match ("to : ") == MATCH_YES) - map_op = always ? OMP_MAP_ALWAYS_TO : OMP_MAP_TO; + map_op = always_modifier ? OMP_MAP_ALWAYS_TO : OMP_MAP_TO; else if (gfc_match ("from : ") == MATCH_YES) - map_op = always ? OMP_MAP_ALWAYS_FROM : OMP_MAP_FROM; + map_op = always_modifier ? OMP_MAP_ALWAYS_FROM : OMP_MAP_FROM; else if (gfc_match ("release : ") == MATCH_YES) map_op = OMP_MAP_RELEASE; else if (gfc_match ("delete : ") == MATCH_YES) map_op = OMP_MAP_DELETE; - else if (always) + else { gfc_current_locus = old_loc2; - always = false; + always_modifier = 0; + close_modifier = 0; + } + + if (always_modifier > 1) + { + gfc_error ("too many %<always%> modifiers at %L", + &second_always_locus); + break; + } + if (close_modifier > 1) + { + gfc_error ("too many %<close%> modifiers at %L", + &second_close_locus); + break; } + head = NULL; if (gfc_match_omp_variable_list ("", &c->lists[OMP_LIST_MAP], false, NULL, &head, @@ -1736,15 +2252,26 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, n->u.map_op = map_op; continue; } - else - gfc_current_locus = old_loc; + gfc_current_locus = old_loc; + break; } - if ((mask & OMP_CLAUSE_MERGEABLE) && !c->mergeable - && gfc_match ("mergeable") == MATCH_YES) + if ((mask & OMP_CLAUSE_MERGEABLE) + && (m = gfc_match_dupl_check (!c->mergeable, "mergeable")) + != MATCH_NO) { + if (m == MATCH_ERROR) + goto error; c->mergeable = needs_space = true; continue; } + if ((mask & OMP_CLAUSE_MESSAGE) + && (m = gfc_match_dupl_check (!c->message, "message", true, + &c->message)) != MATCH_NO) + { + if (m == MATCH_ERROR) + goto error; + continue; + } break; case 'n': if ((mask & OMP_CLAUSE_NO_CREATE) @@ -1754,55 +2281,91 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, allow_derived)) continue; if ((mask & OMP_CLAUSE_NOGROUP) - && !c->nogroup - && gfc_match ("nogroup") == MATCH_YES) + && (m = gfc_match_dupl_check (!c->nogroup, "nogroup")) + != MATCH_NO) { + if (m == MATCH_ERROR) + goto error; c->nogroup = needs_space = true; continue; } + if ((mask & OMP_CLAUSE_NOHOST) + && (m = gfc_match_dupl_check (!c->nohost, "nohost")) != MATCH_NO) + { + if (m == MATCH_ERROR) + goto error; + c->nohost = needs_space = true; + continue; + } if ((mask & OMP_CLAUSE_NOTEMPORAL) && gfc_match_omp_variable_list ("nontemporal (", &c->lists[OMP_LIST_NONTEMPORAL], true) == MATCH_YES) continue; if ((mask & OMP_CLAUSE_NOTINBRANCH) - && !c->notinbranch - && !c->inbranch - && gfc_match ("notinbranch") == MATCH_YES) + && (m = gfc_match_dupl_check (!c->notinbranch && !c->inbranch, + "notinbranch")) != MATCH_NO) { + if (m == MATCH_ERROR) + goto error; c->notinbranch = needs_space = true; continue; } if ((mask & OMP_CLAUSE_NOWAIT) - && !c->nowait - && gfc_match ("nowait") == MATCH_YES) + && (m = gfc_match_dupl_check (!c->nowait, "nowait")) != MATCH_NO) { + if (m == MATCH_ERROR) + goto error; c->nowait = needs_space = true; continue; } if ((mask & OMP_CLAUSE_NUM_GANGS) - && c->num_gangs_expr == NULL - && gfc_match ("num_gangs ( %e )", - &c->num_gangs_expr) == MATCH_YES) - continue; + && (m = gfc_match_dupl_check (!c->num_gangs_expr, "num_gangs", + true)) != MATCH_NO) + { + if (m == MATCH_ERROR) + goto error; + if (gfc_match (" %e )", &c->num_gangs_expr) != MATCH_YES) + goto error; + continue; + } if ((mask & OMP_CLAUSE_NUM_TASKS) - && c->num_tasks == NULL - && gfc_match ("num_tasks ( %e )", &c->num_tasks) == MATCH_YES) - continue; + && (m = gfc_match_dupl_check (!c->num_tasks, "num_tasks", true)) + != MATCH_NO) + { + if (m == MATCH_ERROR) + goto error; + if (gfc_match ("strict : ") == MATCH_YES) + c->num_tasks_strict = true; + if (gfc_match (" %e )", &c->num_tasks) != MATCH_YES) + goto error; + continue; + } if ((mask & OMP_CLAUSE_NUM_TEAMS) - && c->num_teams == NULL - && gfc_match ("num_teams ( %e )", &c->num_teams) == MATCH_YES) - continue; + && (m = gfc_match_dupl_check (!c->num_teams, "num_teams", true, + &c->num_teams)) != MATCH_NO) + { + if (m == MATCH_ERROR) + goto error; + continue; + } if ((mask & OMP_CLAUSE_NUM_THREADS) - && c->num_threads == NULL - && (gfc_match ("num_threads ( %e )", &c->num_threads) - == MATCH_YES)) - continue; + && (m = gfc_match_dupl_check (!c->num_threads, "num_threads", true, + &c->num_threads)) != MATCH_NO) + { + if (m == MATCH_ERROR) + goto error; + continue; + } if ((mask & OMP_CLAUSE_NUM_WORKERS) - && c->num_workers_expr == NULL - && gfc_match ("num_workers ( %e )", - &c->num_workers_expr) == MATCH_YES) - continue; + && (m = gfc_match_dupl_check (!c->num_workers_expr, "num_workers", + true, &c->num_workers_expr)) + != MATCH_NO) + { + if (m == MATCH_ERROR) + goto error; + continue; + } break; case 'o': if ((mask & OMP_CLAUSE_ORDER) @@ -1813,11 +2376,13 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, continue; } if ((mask & OMP_CLAUSE_ORDERED) - && !c->ordered - && gfc_match ("ordered") == MATCH_YES) + && (m = gfc_match_dupl_check (!c->ordered, "ordered")) + != MATCH_NO) { + if (m == MATCH_ERROR) + goto error; gfc_expr *cexpr = NULL; - match m = gfc_match (" ( %e )", &cexpr); + m = gfc_match (" ( %e )", &cexpr); c->ordered = true; if (m == MATCH_YES) @@ -1889,32 +2454,46 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, OMP_MAP_ALLOC, true, allow_derived)) continue; if ((mask & OMP_CLAUSE_PRIORITY) - && c->priority == NULL - && gfc_match ("priority ( %e )", &c->priority) == MATCH_YES) - continue; + && (m = gfc_match_dupl_check (!c->priority, "priority", true, + &c->priority)) != MATCH_NO) + { + if (m == MATCH_ERROR) + goto error; + continue; + } if ((mask & OMP_CLAUSE_PRIVATE) && gfc_match_omp_variable_list ("private (", &c->lists[OMP_LIST_PRIVATE], true) == MATCH_YES) continue; if ((mask & OMP_CLAUSE_PROC_BIND) - && c->proc_bind == OMP_PROC_BIND_UNKNOWN) + && (m = gfc_match_dupl_check ((c->proc_bind + == OMP_PROC_BIND_UNKNOWN), + "proc_bind", true)) != MATCH_NO) { - if (gfc_match ("proc_bind ( master )") == MATCH_YES) + if (m == MATCH_ERROR) + goto error; + if (gfc_match ("primary )") == MATCH_YES) + c->proc_bind = OMP_PROC_BIND_PRIMARY; + else if (gfc_match ("master )") == MATCH_YES) c->proc_bind = OMP_PROC_BIND_MASTER; - else if (gfc_match ("proc_bind ( spread )") == MATCH_YES) + else if (gfc_match ("spread )") == MATCH_YES) c->proc_bind = OMP_PROC_BIND_SPREAD; - else if (gfc_match ("proc_bind ( close )") == MATCH_YES) + else if (gfc_match ("close )") == MATCH_YES) c->proc_bind = OMP_PROC_BIND_CLOSE; - if (c->proc_bind != OMP_PROC_BIND_UNKNOWN) - continue; + else + goto error; + continue; } break; case 'r': if ((mask & OMP_CLAUSE_ATOMIC) - && c->atomic_op == GFC_OMP_ATOMIC_UNSET - && gfc_match ("read") == MATCH_YES) + && (m = gfc_match_dupl_atomic ((c->atomic_op + == GFC_OMP_ATOMIC_UNSET), + "read")) != MATCH_NO) { + if (m == MATCH_ERROR) + goto error; c->atomic_op = GFC_OMP_ATOMIC_READ; needs_space = true; continue; @@ -1924,33 +2503,23 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, allow_derived) == MATCH_YES) continue; if ((mask & OMP_CLAUSE_MEMORDER) - && c->memorder == OMP_MEMORDER_UNSET - && gfc_match ("relaxed") == MATCH_YES) - { - c->memorder = OMP_MEMORDER_RELAXED; - needs_space = true; - continue; - } - if ((mask & OMP_CLAUSE_MEMORDER) - && c->memorder == OMP_MEMORDER_UNSET - && gfc_match ("release") == MATCH_YES) - { - c->memorder = OMP_MEMORDER_RELEASE; - needs_space = true; - continue; - } - if ((mask & OMP_CLAUSE_MEMORDER) - && c->memorder == OMP_MEMORDER_UNSET - && gfc_match ("relaxed") == MATCH_YES) + && (m = gfc_match_dupl_memorder ((c->memorder + == OMP_MEMORDER_UNSET), + "relaxed")) != MATCH_NO) { + if (m == MATCH_ERROR) + goto error; c->memorder = OMP_MEMORDER_RELAXED; needs_space = true; continue; } if ((mask & OMP_CLAUSE_MEMORDER) - && c->memorder == OMP_MEMORDER_UNSET - && gfc_match ("release") == MATCH_YES) + && (m = gfc_match_dupl_memorder ((c->memorder + == OMP_MEMORDER_UNSET), + "release")) != MATCH_NO) { + if (m == MATCH_ERROR) + goto error; c->memorder = OMP_MEMORDER_RELEASE; needs_space = true; continue; @@ -1958,13 +2527,20 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, break; case 's': if ((mask & OMP_CLAUSE_SAFELEN) - && c->safelen_expr == NULL - && gfc_match ("safelen ( %e )", &c->safelen_expr) == MATCH_YES) - continue; + && (m = gfc_match_dupl_check (!c->safelen_expr, "safelen", + true, &c->safelen_expr)) + != MATCH_NO) + { + if (m == MATCH_ERROR) + goto error; + continue; + } if ((mask & OMP_CLAUSE_SCHEDULE) - && c->sched_kind == OMP_SCHED_NONE - && gfc_match ("schedule ( ") == MATCH_YES) + && (m = gfc_match_dupl_check (c->sched_kind == OMP_SCHED_NONE, + "schedule", true)) != MATCH_NO) { + if (m == MATCH_ERROR) + goto error; int nmodifiers = 0; locus old_loc2 = gfc_current_locus; do @@ -2011,7 +2587,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, c->sched_kind = OMP_SCHED_AUTO; if (c->sched_kind != OMP_SCHED_NONE) { - match m = MATCH_NO; + m = MATCH_NO; if (c->sched_kind != OMP_SCHED_RUNTIME && c->sched_kind != OMP_SCHED_AUTO) m = gfc_match (" , %e )", &c->chunk_size); @@ -2032,17 +2608,21 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, allow_derived)) continue; if ((mask & OMP_CLAUSE_SEQ) - && !c->seq - && gfc_match ("seq") == MATCH_YES) + && (m = gfc_match_dupl_check (!c->seq, "seq")) != MATCH_NO) { + if (m == MATCH_ERROR) + goto error; c->seq = true; needs_space = true; continue; } if ((mask & OMP_CLAUSE_MEMORDER) - && c->memorder == OMP_MEMORDER_UNSET - && gfc_match ("seq_cst") == MATCH_YES) + && (m = gfc_match_dupl_memorder ((c->memorder + == OMP_MEMORDER_UNSET), + "seq_cst")) != MATCH_NO) { + if (m == MATCH_ERROR) + goto error; c->memorder = OMP_MEMORDER_SEQ_CST; needs_space = true; continue; @@ -2053,16 +2633,39 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, true) == MATCH_YES) continue; if ((mask & OMP_CLAUSE_SIMDLEN) - && c->simdlen_expr == NULL - && gfc_match ("simdlen ( %e )", &c->simdlen_expr) == MATCH_YES) - continue; + && (m = gfc_match_dupl_check (!c->simdlen_expr, "simdlen", true, + &c->simdlen_expr)) != MATCH_NO) + { + if (m == MATCH_ERROR) + goto error; + continue; + } if ((mask & OMP_CLAUSE_SIMD) - && !c->simd - && gfc_match ("simd") == MATCH_YES) + && (m = gfc_match_dupl_check (!c->simd, "simd")) != MATCH_NO) { + if (m == MATCH_ERROR) + goto error; c->simd = needs_space = true; continue; } + if ((mask & OMP_CLAUSE_SEVERITY) + && (m = gfc_match_dupl_check (!c->severity, "severity", true)) + != MATCH_NO) + { + if (m == MATCH_ERROR) + goto error; + if (gfc_match ("fatal )") == MATCH_YES) + c->severity = OMP_SEVERITY_FATAL; + else if (gfc_match ("warning )") == MATCH_YES) + c->severity = OMP_SEVERITY_WARNING; + else + { + gfc_error ("Expected FATAL or WARNING in SEVERITY clause " + "at %C"); + goto error; + } + continue; + } break; case 't': if ((mask & OMP_CLAUSE_TASK_REDUCTION) @@ -2070,14 +2673,20 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, allow_derived) == MATCH_YES) continue; if ((mask & OMP_CLAUSE_THREAD_LIMIT) - && c->thread_limit == NULL - && gfc_match ("thread_limit ( %e )", - &c->thread_limit) == MATCH_YES) - continue; + && (m = gfc_match_dupl_check (!c->thread_limit, "thread_limit", + true, &c->thread_limit)) + != MATCH_NO) + { + if (m == MATCH_ERROR) + goto error; + continue; + } if ((mask & OMP_CLAUSE_THREADS) - && !c->threads - && gfc_match ("threads") == MATCH_YES) + && (m = gfc_match_dupl_check (!c->threads, "threads")) + != MATCH_NO) { + if (m == MATCH_ERROR) + goto error; c->threads = needs_space = true; continue; } @@ -2105,16 +2714,20 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, false) == MATCH_YES) continue; if ((mask & OMP_CLAUSE_UNTIED) - && !c->untied - && gfc_match ("untied") == MATCH_YES) + && (m = gfc_match_dupl_check (!c->untied, "untied")) != MATCH_NO) { + if (m == MATCH_ERROR) + goto error; c->untied = needs_space = true; continue; } if ((mask & OMP_CLAUSE_ATOMIC) - && c->atomic_op == GFC_OMP_ATOMIC_UNSET - && gfc_match ("update") == MATCH_YES) + && (m = gfc_match_dupl_atomic ((c->atomic_op + == GFC_OMP_ATOMIC_UNSET), + "update")) != MATCH_NO) { + if (m == MATCH_ERROR) + goto error; c->atomic_op = GFC_OMP_ATOMIC_UPDATE; needs_space = true; continue; @@ -2139,21 +2752,24 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, /* VECTOR_LENGTH must be matched before VECTOR, because the latter doesn't unconditionally match '('. */ if ((mask & OMP_CLAUSE_VECTOR_LENGTH) - && c->vector_length_expr == NULL - && (gfc_match ("vector_length ( %e )", &c->vector_length_expr) - == MATCH_YES)) - continue; + && (m = gfc_match_dupl_check (!c->vector_length_expr, + "vector_length", true, + &c->vector_length_expr)) + != MATCH_NO) + { + if (m == MATCH_ERROR) + goto error; + continue; + } if ((mask & OMP_CLAUSE_VECTOR) - && !c->vector - && gfc_match ("vector") == MATCH_YES) + && (m = gfc_match_dupl_check (!c->vector, "vector")) != MATCH_NO) { + if (m == MATCH_ERROR) + goto error; c->vector = true; - match m = match_oacc_clause_gwv (c, GOMP_DIM_VECTOR); + m = match_oacc_clause_gwv (c, GOMP_DIM_VECTOR); if (m == MATCH_ERROR) - { - gfc_current_locus = old_loc; - break; - } + goto error; if (m == MATCH_NO) needs_space = true; continue; @@ -2163,12 +2779,9 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, if ((mask & OMP_CLAUSE_WAIT) && gfc_match ("wait") == MATCH_YES) { - match m = match_oacc_expr_list (" (", &c->wait_list, false); + m = match_oacc_expr_list (" (", &c->wait_list, false); if (m == MATCH_ERROR) - { - gfc_current_locus = old_loc; - break; - } + goto error; else if (m == MATCH_NO) { gfc_expr *expr @@ -2186,24 +2799,25 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, continue; } if ((mask & OMP_CLAUSE_WORKER) - && !c->worker - && gfc_match ("worker") == MATCH_YES) + && (m = gfc_match_dupl_check (!c->worker, "worker")) != MATCH_NO) { + if (m == MATCH_ERROR) + goto error; c->worker = true; - match m = match_oacc_clause_gwv (c, GOMP_DIM_WORKER); + m = match_oacc_clause_gwv (c, GOMP_DIM_WORKER); if (m == MATCH_ERROR) - { - gfc_current_locus = old_loc; - break; - } + goto error; else if (m == MATCH_NO) needs_space = true; continue; } if ((mask & OMP_CLAUSE_ATOMIC) - && c->atomic_op == GFC_OMP_ATOMIC_UNSET - && gfc_match ("write") == MATCH_YES) + && (m = gfc_match_dupl_atomic ((c->atomic_op + == GFC_OMP_ATOMIC_UNSET), + "write")) != MATCH_NO) { + if (m == MATCH_ERROR) + goto error; c->atomic_op = GFC_OMP_ATOMIC_WRITE; needs_space = true; continue; @@ -2213,7 +2827,8 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, break; } - if (gfc_match_omp_eos () != MATCH_YES) +end: + if (error || gfc_match_omp_eos () != MATCH_YES) { if (!gfc_error_flag_test ()) gfc_error ("Failed to match clause at %C"); @@ -2223,6 +2838,10 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, *cp = c; return MATCH_YES; + +error: + error = true; + goto end; } @@ -2283,7 +2902,8 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, omp_mask (OMP_CLAUSE_ASYNC) #define OACC_ROUTINE_CLAUSES \ (omp_mask (OMP_CLAUSE_GANG) | OMP_CLAUSE_WORKER | OMP_CLAUSE_VECTOR \ - | OMP_CLAUSE_SEQ) + | OMP_CLAUSE_SEQ \ + | OMP_CLAUSE_NOHOST) static match @@ -2612,6 +3232,7 @@ gfc_match_oacc_routine (void) gfc_omp_clauses *c = NULL; gfc_oacc_routine_name *n = NULL; oacc_routine_lop lop = OACC_ROUTINE_LOP_NONE; + bool nohost; old_loc = gfc_current_locus; @@ -2688,6 +3309,7 @@ gfc_match_oacc_routine (void) gfc_error ("Multiple loop axes specified for routine at %C"); goto cleanup; } + nohost = c ? c->nohost : false; if (isym != NULL) { @@ -2700,6 +3322,13 @@ gfc_match_oacc_routine (void) " clause"); goto cleanup; } + /* ..., and no 'nohost' clause. */ + if (nohost) + { + gfc_error ("Intrinsic symbol specified in !$ACC ROUTINE ( NAME )" + " at %C marked with incompatible NOHOST clause"); + goto cleanup; + } } else if (sym != NULL) { @@ -2713,7 +3342,9 @@ gfc_match_oacc_routine (void) if (n_p->sym == sym) { add = false; - if (lop != gfc_oacc_routine_lop (n_p->clauses)) + bool nohost_p = n_p->clauses ? n_p->clauses->nohost : false; + if (lop != gfc_oacc_routine_lop (n_p->clauses) + || nohost != nohost_p) { gfc_error ("!$ACC ROUTINE already applied at %C"); goto cleanup; @@ -2723,6 +3354,7 @@ gfc_match_oacc_routine (void) if (add) { sym->attr.oacc_routine_lop = lop; + sym->attr.oacc_routine_nohost = nohost; n = gfc_get_oacc_routine_name (); n->sym = sym; @@ -2737,8 +3369,10 @@ gfc_match_oacc_routine (void) /* For a repeated OpenACC 'routine' directive, diagnose if it doesn't match the first one. */ oacc_routine_lop lop_p = gfc_current_ns->proc_name->attr.oacc_routine_lop; + bool nohost_p = gfc_current_ns->proc_name->attr.oacc_routine_nohost; if (lop_p != OACC_ROUTINE_LOP_NONE - && lop != lop_p) + && (lop != lop_p + || nohost != nohost_p)) { gfc_error ("!$ACC ROUTINE already applied at %C"); goto cleanup; @@ -2749,6 +3383,7 @@ gfc_match_oacc_routine (void) &old_loc)) goto cleanup; gfc_current_ns->proc_name->attr.oacc_routine_lop = lop; + gfc_current_ns->proc_name->attr.oacc_routine_nohost = nohost; } else /* Something has gone wrong, possibly a syntax error. */ @@ -2791,6 +3426,11 @@ cleanup: | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION \ | OMP_CLAUSE_SCHEDULE | OMP_CLAUSE_ORDERED | OMP_CLAUSE_COLLAPSE \ | OMP_CLAUSE_LINEAR | OMP_CLAUSE_ORDER) +#define OMP_LOOP_CLAUSES \ + (omp_mask (OMP_CLAUSE_BIND) | OMP_CLAUSE_COLLAPSE | OMP_CLAUSE_ORDER \ + | OMP_CLAUSE_PRIVATE | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION) +#define OMP_SCOPE_CLAUSES \ + (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_REDUCTION) #define OMP_SECTIONS_CLAUSES \ (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE \ | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION) @@ -2804,7 +3444,7 @@ cleanup: | OMP_CLAUSE_SHARED | OMP_CLAUSE_IF | OMP_CLAUSE_DEFAULT \ | OMP_CLAUSE_UNTIED | OMP_CLAUSE_FINAL | OMP_CLAUSE_MERGEABLE \ | OMP_CLAUSE_DEPEND | OMP_CLAUSE_PRIORITY | OMP_CLAUSE_IN_REDUCTION \ - | OMP_CLAUSE_DETACH) + | OMP_CLAUSE_DETACH | OMP_CLAUSE_AFFINITY) #define OMP_TASKLOOP_CLAUSES \ (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE \ | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_SHARED | OMP_CLAUSE_IF \ @@ -2845,6 +3485,11 @@ cleanup: #define OMP_ATOMIC_CLAUSES \ (omp_mask (OMP_CLAUSE_ATOMIC) | OMP_CLAUSE_CAPTURE | OMP_CLAUSE_HINT \ | OMP_CLAUSE_MEMORDER) +#define OMP_MASKED_CLAUSES \ + (omp_mask (OMP_CLAUSE_FILTER)) +#define OMP_ERROR_CLAUSES \ + (omp_mask (OMP_CLAUSE_AT) | OMP_CLAUSE_MESSAGE | OMP_CLAUSE_SEVERITY) + static match @@ -2898,6 +3543,86 @@ gfc_match_omp_end_critical (void) return MATCH_YES; } +/* depobj(depobj) depend(dep-type:loc)|destroy|update(dep-type) + dep-type = in/out/inout/mutexinoutset/depobj/source/sink + depend: !source, !sink + update: !source, !sink, !depobj + locator = exactly one list item .*/ +match +gfc_match_omp_depobj (void) +{ + gfc_omp_clauses *c = NULL; + gfc_expr *depobj; + + if (gfc_match (" ( %v ) ", &depobj) != MATCH_YES) + { + gfc_error ("Expected %<( depobj )%> at %C"); + return MATCH_ERROR; + } + if (gfc_match ("update ( ") == MATCH_YES) + { + c = gfc_get_omp_clauses (); + if (gfc_match ("inout )") == MATCH_YES) + c->depobj_update = OMP_DEPEND_INOUT; + else if (gfc_match ("in )") == MATCH_YES) + c->depobj_update = OMP_DEPEND_IN; + else if (gfc_match ("out )") == MATCH_YES) + c->depobj_update = OMP_DEPEND_OUT; + else if (gfc_match ("mutexinoutset )") == MATCH_YES) + c->depobj_update = OMP_DEPEND_MUTEXINOUTSET; + else + { + gfc_error ("Expected IN, OUT, INOUT, MUTEXINOUTSET followed by " + "%<)%> at %C"); + goto error; + } + } + else if (gfc_match ("destroy") == MATCH_YES) + { + c = gfc_get_omp_clauses (); + c->destroy = true; + } + else if (gfc_match_omp_clauses (&c, omp_mask (OMP_CLAUSE_DEPEND), true, false) + != MATCH_YES) + goto error; + + if (c->depobj_update == OMP_DEPEND_UNSET && !c->destroy) + { + if (!c->depend_source && !c->lists[OMP_LIST_DEPEND]) + { + gfc_error ("Expected DEPEND, UPDATE, or DESTROY clause at %C"); + goto error; + } + if (c->depend_source + || c->lists[OMP_LIST_DEPEND]->u.depend_op == OMP_DEPEND_SINK_FIRST + || c->lists[OMP_LIST_DEPEND]->u.depend_op == OMP_DEPEND_SINK + || c->lists[OMP_LIST_DEPEND]->u.depend_op == OMP_DEPEND_DEPOBJ) + { + gfc_error ("DEPEND clause at %L of OMP DEPOBJ construct shall not " + "have dependence-type SOURCE, SINK or DEPOBJ", + c->lists[OMP_LIST_DEPEND] + ? &c->lists[OMP_LIST_DEPEND]->where : &gfc_current_locus); + goto error; + } + if (c->lists[OMP_LIST_DEPEND]->next) + { + gfc_error ("DEPEND clause at %L of OMP DEPOBJ construct shall have " + "only a single locator", + &c->lists[OMP_LIST_DEPEND]->next->where); + goto error; + } + } + + c->depobj = depobj; + new_st.op = EXEC_OMP_DEPOBJ; + new_st.ext.omp_clauses = c; + return MATCH_YES; + +error: + gfc_free_expr (depobj); + gfc_free_omp_clauses (c); + return MATCH_ERROR; +} match gfc_match_omp_distribute (void) @@ -2950,6 +3675,105 @@ gfc_match_omp_do_simd (void) match +gfc_match_omp_loop (void) +{ + return match_omp (EXEC_OMP_LOOP, OMP_LOOP_CLAUSES); +} + + +match +gfc_match_omp_teams_loop (void) +{ + return match_omp (EXEC_OMP_TEAMS_LOOP, OMP_TEAMS_CLAUSES | OMP_LOOP_CLAUSES); +} + + +match +gfc_match_omp_target_teams_loop (void) +{ + return match_omp (EXEC_OMP_TARGET_TEAMS_LOOP, + OMP_TARGET_CLAUSES | OMP_TEAMS_CLAUSES | OMP_LOOP_CLAUSES); +} + + +match +gfc_match_omp_parallel_loop (void) +{ + return match_omp (EXEC_OMP_PARALLEL_LOOP, + OMP_PARALLEL_CLAUSES | OMP_LOOP_CLAUSES); +} + + +match +gfc_match_omp_target_parallel_loop (void) +{ + return match_omp (EXEC_OMP_TARGET_PARALLEL_LOOP, + (OMP_TARGET_CLAUSES | OMP_PARALLEL_CLAUSES + | OMP_LOOP_CLAUSES)); +} + + +match +gfc_match_omp_error (void) +{ + locus loc = gfc_current_locus; + match m = match_omp (EXEC_OMP_ERROR, OMP_ERROR_CLAUSES); + if (m != MATCH_YES) + return m; + + gfc_omp_clauses *c = new_st.ext.omp_clauses; + if (c->severity == OMP_SEVERITY_UNSET) + c->severity = OMP_SEVERITY_FATAL; + if (new_st.ext.omp_clauses->at == OMP_AT_EXECUTION) + return MATCH_YES; + if (c->message + && (!gfc_resolve_expr (c->message) + || c->message->ts.type != BT_CHARACTER + || c->message->ts.kind != gfc_default_character_kind + || c->message->rank != 0)) + { + gfc_error ("MESSAGE clause at %L requires a scalar default-kind " + "CHARACTER expression", + &new_st.ext.omp_clauses->message->where); + return MATCH_ERROR; + } + if (c->message && !gfc_is_constant_expr (c->message)) + { + gfc_error ("Constant character expression required in MESSAGE clause " + "at %L", &new_st.ext.omp_clauses->message->where); + return MATCH_ERROR; + } + if (c->message) + { + const char *msg = G_("$OMP ERROR encountered at %L: %s"); + gcc_assert (c->message->expr_type == EXPR_CONSTANT); + gfc_charlen_t slen = c->message->value.character.length; + int i = gfc_validate_kind (BT_CHARACTER, gfc_default_character_kind, + false); + size_t size = slen * gfc_character_kinds[i].bit_size / 8; + unsigned char *s = XCNEWVAR (unsigned char, size + 1); + gfc_encode_character (gfc_default_character_kind, slen, + c->message->value.character.string, + (unsigned char *) s, size); + s[size] = '\0'; + if (c->severity == OMP_SEVERITY_WARNING) + gfc_warning_now (0, msg, &loc, s); + else + gfc_error_now (msg, &loc, s); + free (s); + } + else + { + const char *msg = G_("$OMP ERROR encountered at %L"); + if (c->severity == OMP_SEVERITY_WARNING) + gfc_warning_now (0, msg, &loc); + else + gfc_error_now (msg, &loc); + } + return MATCH_YES; +} + +match gfc_match_omp_flush (void) { gfc_omp_namelist *list = NULL; @@ -2958,7 +3782,9 @@ gfc_match_omp_flush (void) enum gfc_omp_memorder mo = OMP_MEMORDER_UNSET; if (gfc_match_omp_eos () == MATCH_NO && gfc_peek_ascii_char () != '(') { - if (gfc_match ("acq_rel") == MATCH_YES) + if (gfc_match ("seq_cst") == MATCH_YES) + mo = OMP_MEMORDER_SEQ_CST; + else if (gfc_match ("acq_rel") == MATCH_YES) mo = OMP_MEMORDER_ACQ_REL; else if (gfc_match ("release") == MATCH_YES) mo = OMP_MEMORDER_RELEASE; @@ -2966,7 +3792,7 @@ gfc_match_omp_flush (void) mo = OMP_MEMORDER_ACQUIRE; else { - gfc_error ("Expected AQC_REL, RELEASE, or ACQUIRE at %C"); + gfc_error ("Expected SEQ_CST, AQC_REL, RELEASE, or ACQUIRE at %C"); return MATCH_ERROR; } c = gfc_get_omp_clauses (); @@ -2977,14 +3803,14 @@ gfc_match_omp_flush (void) { gfc_error ("List specified together with memory order clause in FLUSH " "directive at %C"); - gfc_free_omp_namelist (list); + gfc_free_omp_namelist (list, false); gfc_free_omp_clauses (c); return MATCH_ERROR; } if (gfc_match_omp_eos () != MATCH_YES) { gfc_error ("Unexpected junk after $OMP FLUSH statement at %C"); - gfc_free_omp_namelist (list); + gfc_free_omp_namelist (list, false); gfc_free_omp_clauses (c); return MATCH_ERROR; } @@ -3685,6 +4511,54 @@ gfc_match_omp_parallel_do_simd (void) match +gfc_match_omp_parallel_masked (void) +{ + return match_omp (EXEC_OMP_PARALLEL_MASKED, + OMP_PARALLEL_CLAUSES | OMP_MASKED_CLAUSES); +} + +match +gfc_match_omp_parallel_masked_taskloop (void) +{ + return match_omp (EXEC_OMP_PARALLEL_MASKED_TASKLOOP, + (OMP_PARALLEL_CLAUSES | OMP_MASKED_CLAUSES + | OMP_TASKLOOP_CLAUSES) + & ~(omp_mask (OMP_CLAUSE_IN_REDUCTION))); +} + +match +gfc_match_omp_parallel_masked_taskloop_simd (void) +{ + return match_omp (EXEC_OMP_PARALLEL_MASKED_TASKLOOP_SIMD, + (OMP_PARALLEL_CLAUSES | OMP_MASKED_CLAUSES + | OMP_TASKLOOP_CLAUSES | OMP_SIMD_CLAUSES) + & ~(omp_mask (OMP_CLAUSE_IN_REDUCTION))); +} + +match +gfc_match_omp_parallel_master (void) +{ + return match_omp (EXEC_OMP_PARALLEL_MASTER, OMP_PARALLEL_CLAUSES); +} + +match +gfc_match_omp_parallel_master_taskloop (void) +{ + return match_omp (EXEC_OMP_PARALLEL_MASTER_TASKLOOP, + (OMP_PARALLEL_CLAUSES | OMP_TASKLOOP_CLAUSES) + & ~(omp_mask (OMP_CLAUSE_IN_REDUCTION))); +} + +match +gfc_match_omp_parallel_master_taskloop_simd (void) +{ + return match_omp (EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD, + (OMP_PARALLEL_CLAUSES | OMP_TASKLOOP_CLAUSES + | OMP_SIMD_CLAUSES) + & ~(omp_mask (OMP_CLAUSE_IN_REDUCTION))); +} + +match gfc_match_omp_parallel_sections (void) { return match_omp (EXEC_OMP_PARALLEL_SECTIONS, @@ -3960,6 +4834,13 @@ gfc_match_omp_scan (void) match +gfc_match_omp_scope (void) +{ + return match_omp (EXEC_OMP_SCOPE, OMP_SCOPE_CLAUSES); +} + + +match gfc_match_omp_sections (void) { return match_omp (EXEC_OMP_SECTIONS, OMP_SECTIONS_CLAUSES); @@ -4117,22 +4998,20 @@ match gfc_match_omp_taskloop_simd (void) { return match_omp (EXEC_OMP_TASKLOOP_SIMD, - (OMP_TASKLOOP_CLAUSES | OMP_SIMD_CLAUSES) - & ~(omp_mask (OMP_CLAUSE_REDUCTION))); + OMP_TASKLOOP_CLAUSES | OMP_SIMD_CLAUSES); } match gfc_match_omp_taskwait (void) { - if (gfc_match_omp_eos () != MATCH_YES) + if (gfc_match_omp_eos () == MATCH_YES) { - gfc_error ("Unexpected junk after TASKWAIT clause at %C"); - return MATCH_ERROR; + new_st.op = EXEC_OMP_TASKWAIT; + new_st.ext.omp_clauses = NULL; + return MATCH_YES; } - new_st.op = EXEC_OMP_TASKWAIT; - new_st.ext.omp_clauses = NULL; - return MATCH_YES; + return match_omp (EXEC_OMP_TASKWAIT, omp_mask (OMP_CLAUSE_DEPEND)); } @@ -4210,6 +5089,27 @@ gfc_match_omp_workshare (void) match +gfc_match_omp_masked (void) +{ + return match_omp (EXEC_OMP_MASKED, OMP_MASKED_CLAUSES); +} + +match +gfc_match_omp_masked_taskloop (void) +{ + return match_omp (EXEC_OMP_MASKED_TASKLOOP, + OMP_MASKED_CLAUSES | OMP_TASKLOOP_CLAUSES); +} + +match +gfc_match_omp_masked_taskloop_simd (void) +{ + return match_omp (EXEC_OMP_MASKED_TASKLOOP_SIMD, + (OMP_MASKED_CLAUSES | OMP_TASKLOOP_CLAUSES + | OMP_SIMD_CLAUSES)); +} + +match gfc_match_omp_master (void) { if (gfc_match_omp_eos () != MATCH_YES) @@ -4222,6 +5122,18 @@ gfc_match_omp_master (void) return MATCH_YES; } +match +gfc_match_omp_master_taskloop (void) +{ + return match_omp (EXEC_OMP_MASTER_TASKLOOP, OMP_TASKLOOP_CLAUSES); +} + +match +gfc_match_omp_master_taskloop_simd (void) +{ + return match_omp (EXEC_OMP_MASTER_TASKLOOP_SIMD, + OMP_TASKLOOP_CLAUSES | OMP_SIMD_CLAUSES); +} match gfc_match_omp_ordered (void) @@ -4229,6 +5141,17 @@ gfc_match_omp_ordered (void) return match_omp (EXEC_OMP_ORDERED, OMP_ORDERED_CLAUSES); } +match +gfc_match_omp_nothing (void) +{ + if (gfc_match_omp_eos () != MATCH_YES) + { + gfc_error ("Unexpected junk after $OMP NOTHING statement at %C"); + return MATCH_ERROR; + } + /* Will use ST_NONE; therefore, no EXEC_OMP_ is needed. */ + return MATCH_YES; +} match gfc_match_omp_ordered_depend (void) @@ -4416,7 +5339,11 @@ gfc_match_omp_cancellation_point (void) gfc_omp_clauses *c; enum gfc_omp_cancel_kind kind = gfc_match_omp_cancel_kind (); if (kind == OMP_CANCEL_UNKNOWN) - return MATCH_ERROR; + { + gfc_error ("Expected construct-type PARALLEL, SECTIONS, DO or TASKGROUP " + "in $OMP CANCELLATION POINT statement at %C"); + return MATCH_ERROR; + } if (gfc_match_omp_eos () != MATCH_YES) { gfc_error ("Unexpected junk after $OMP CANCELLATION POINT statement " @@ -4439,7 +5366,10 @@ gfc_match_omp_end_nowait (void) nowait = true; if (gfc_match_omp_eos () != MATCH_YES) { - gfc_error ("Unexpected junk after NOWAIT clause at %C"); + if (nowait) + gfc_error ("Unexpected junk after NOWAIT clause at %C"); + else + gfc_error ("Unexpected junk at %C"); return MATCH_ERROR; } new_st.op = EXEC_OMP_END_NOWAIT; @@ -4698,7 +5628,7 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, gfc_omp_linear_op linear_op = OMP_LINEAR_DEFAULT; static const char *clause_names[] = { "PRIVATE", "FIRSTPRIVATE", "LASTPRIVATE", "COPYPRIVATE", "SHARED", - "COPYIN", "UNIFORM", "ALIGNED", "LINEAR", "DEPEND", "MAP", + "COPYIN", "UNIFORM", "AFFINITY", "ALIGNED", "LINEAR", "DEPEND", "MAP", "TO", "FROM", "INCLUSIVE", "EXCLUSIVE", "REDUCTION", "REDUCTION" /*inscan*/, "REDUCTION" /*task*/, "IN_REDUCTION", "TASK_REDUCTION", @@ -4748,6 +5678,8 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, case EXEC_OMP_PARALLEL: case EXEC_OMP_PARALLEL_DO: + case EXEC_OMP_PARALLEL_MASKED: + case EXEC_OMP_PARALLEL_MASTER: case EXEC_OMP_PARALLEL_SECTIONS: case EXEC_OMP_PARALLEL_WORKSHARE: case EXEC_OMP_DISTRIBUTE_PARALLEL_DO: @@ -4761,6 +5693,18 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, ok = ifc == OMP_IF_PARALLEL || ifc == OMP_IF_SIMD; break; + case EXEC_OMP_PARALLEL_MASKED_TASKLOOP: + case EXEC_OMP_PARALLEL_MASTER_TASKLOOP: + ok = ifc == OMP_IF_PARALLEL || ifc == OMP_IF_TASKLOOP; + break; + + case EXEC_OMP_PARALLEL_MASKED_TASKLOOP_SIMD: + case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD: + ok = (ifc == OMP_IF_PARALLEL + || ifc == OMP_IF_TASKLOOP + || ifc == OMP_IF_SIMD); + break; + case EXEC_OMP_SIMD: case EXEC_OMP_DO_SIMD: case EXEC_OMP_DISTRIBUTE_SIMD: @@ -4773,10 +5717,14 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, break; case EXEC_OMP_TASKLOOP: + case EXEC_OMP_MASKED_TASKLOOP: + case EXEC_OMP_MASTER_TASKLOOP: ok = ifc == OMP_IF_TASKLOOP; break; case EXEC_OMP_TASKLOOP_SIMD: + case EXEC_OMP_MASKED_TASKLOOP_SIMD: + case EXEC_OMP_MASTER_TASKLOOP_SIMD: ok = ifc == OMP_IF_TASKLOOP || ifc == OMP_IF_SIMD; break; @@ -4877,6 +5825,14 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, "clause at %L", &code->loc); } + if (omp_clauses->depobj + && (!gfc_resolve_expr (omp_clauses->depobj) + || omp_clauses->depobj->ts.type != BT_INTEGER + || omp_clauses->depobj->ts.kind != 2 * gfc_index_integer_kind + || omp_clauses->depobj->rank != 0)) + gfc_error ("DEPOBJ in DEPOBJ construct at %L shall be a scalar integer " + "of OMP_DEPEND_KIND kind", &omp_clauses->depobj->where); + /* Check that no symbol appears on multiple clauses, except that a symbol can appear on both firstprivate and lastprivate. */ for (list = 0; list < OMP_LIST_NUM; list++) @@ -5137,6 +6093,7 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, } } break; + case OMP_LIST_AFFINITY: case OMP_LIST_DEPEND: case OMP_LIST_MAP: case OMP_LIST_TO: @@ -5144,6 +6101,40 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, case OMP_LIST_CACHE: for (; n != NULL; n = n->next) { + if ((list == OMP_LIST_DEPEND || list == OMP_LIST_AFFINITY) + && n->u2.ns && !n->u2.ns->resolved) + { + n->u2.ns->resolved = 1; + for (gfc_symbol *sym = n->u2.ns->proc_name; sym; + sym = sym->tlink) + { + gfc_constructor *c; + c = gfc_constructor_first (sym->value->value.constructor); + if (!gfc_resolve_expr (c->expr) + || c->expr->ts.type != BT_INTEGER + || c->expr->rank != 0) + gfc_error ("Scalar integer expression for range begin" + " expected at %L", &c->expr->where); + c = gfc_constructor_next (c); + if (!gfc_resolve_expr (c->expr) + || c->expr->ts.type != BT_INTEGER + || c->expr->rank != 0) + gfc_error ("Scalar integer expression for range end " + "expected at %L", &c->expr->where); + c = gfc_constructor_next (c); + if (c && (!gfc_resolve_expr (c->expr) + || c->expr->ts.type != BT_INTEGER + || c->expr->rank != 0)) + gfc_error ("Scalar integer expression for range step " + "expected at %L", &c->expr->where); + else if (c + && c->expr->expr_type == EXPR_CONSTANT + && mpz_cmp_si (c->expr->value.integer, 0) == 0) + gfc_error ("Nonzero range step expected at %L", + &c->expr->where); + } + } + if (list == OMP_LIST_DEPEND) { if (n->u.depend_op == OMP_DEPEND_SINK_FIRST @@ -5173,6 +6164,26 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, gfc_error ("Only SOURCE or SINK dependence types " "are allowed on ORDERED directive at %L", &n->where); + else if (n->u.depend_op == OMP_DEPEND_DEPOBJ + && !n->expr + && (n->sym->ts.type != BT_INTEGER + || n->sym->ts.kind + != 2 * gfc_index_integer_kind + || n->sym->attr.dimension)) + gfc_error ("Locator %qs at %L in DEPEND clause of depobj " + "type shall be a scalar integer of " + "OMP_DEPEND_KIND kind", n->sym->name, + &n->where); + else if (n->u.depend_op == OMP_DEPEND_DEPOBJ + && n->expr + && (!gfc_resolve_expr (n->expr) + || n->expr->ts.type != BT_INTEGER + || n->expr->ts.kind + != 2 * gfc_index_integer_kind + || n->expr->rank != 0)) + gfc_error ("Locator at %L in DEPEND clause of depobj " + "type shall be a scalar integer of " + "OMP_DEPEND_KIND kind", &n->expr->where); } gfc_ref *lastref = NULL, *lastslice = NULL; bool resolved = false; @@ -5265,7 +6276,8 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, n->sym->name, name, &n->where); break; } - else if (list == OMP_LIST_DEPEND + else if ((list == OMP_LIST_DEPEND + || list == OMP_LIST_AFFINITY) && ar->start[i] && ar->start[i]->expr_type == EXPR_CONSTANT && ar->end[i] @@ -5273,9 +6285,11 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, && mpz_cmp (ar->start[i]->value.integer, ar->end[i]->value.integer) > 0) { - gfc_error ("%qs in DEPEND clause at %L is a " + gfc_error ("%qs in %s clause at %L is a " "zero size array section", - n->sym->name, &n->where); + n->sym->name, + list == OMP_LIST_DEPEND + ? "DEPEND" : "AFFINITY", &n->where); break; } } @@ -5470,11 +6484,25 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, n->sym->name, name, &n->where); switch (list) { - case OMP_LIST_REDUCTION_INSCAN: case OMP_LIST_REDUCTION_TASK: - if (code && (code->op == EXEC_OMP_TASKLOOP - || code->op == EXEC_OMP_TEAMS - || code->op == EXEC_OMP_TEAMS_DISTRIBUTE)) + if (code + && (code->op == EXEC_OMP_LOOP + || code->op == EXEC_OMP_TASKLOOP + || code->op == EXEC_OMP_TASKLOOP_SIMD + || code->op == EXEC_OMP_MASKED_TASKLOOP + || code->op == EXEC_OMP_MASKED_TASKLOOP_SIMD + || code->op == EXEC_OMP_MASTER_TASKLOOP + || code->op == EXEC_OMP_MASTER_TASKLOOP_SIMD + || code->op == EXEC_OMP_PARALLEL_LOOP + || code->op == EXEC_OMP_PARALLEL_MASKED_TASKLOOP + || code->op == EXEC_OMP_PARALLEL_MASKED_TASKLOOP_SIMD + || code->op == EXEC_OMP_PARALLEL_MASTER_TASKLOOP + || code->op == EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD + || code->op == EXEC_OMP_TARGET_PARALLEL_LOOP + || code->op == EXEC_OMP_TARGET_TEAMS_LOOP + || code->op == EXEC_OMP_TEAMS + || code->op == EXEC_OMP_TEAMS_DISTRIBUTE + || code->op == EXEC_OMP_TEAMS_LOOP)) { gfc_error ("Only DEFAULT permitted as reduction-" "modifier in REDUCTION clause at %L", @@ -5485,6 +6513,7 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, case OMP_LIST_REDUCTION: case OMP_LIST_IN_REDUCTION: case OMP_LIST_TASK_REDUCTION: + case OMP_LIST_REDUCTION_INSCAN: switch (n->u.reduction_op) { case OMP_REDUCTION_PLUS: @@ -5519,23 +6548,23 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, break; } if (!bad) - n->udr = NULL; + n->u2.udr = NULL; else { const char *udr_name = NULL; - if (n->udr) + if (n->u2.udr) { - udr_name = n->udr->udr->name; - n->udr->udr + udr_name = n->u2.udr->udr->name; + n->u2.udr->udr = gfc_find_omp_udr (NULL, udr_name, &n->sym->ts); - if (n->udr->udr == NULL) + if (n->u2.udr->udr == NULL) { - free (n->udr); - n->udr = NULL; + free (n->u2.udr); + n->u2.udr = NULL; } } - if (n->udr == NULL) + if (n->u2.udr == NULL) { if (udr_name == NULL) switch (n->u.reduction_op) @@ -5574,14 +6603,14 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, } else { - gfc_omp_udr *udr = n->udr->udr; + gfc_omp_udr *udr = n->u2.udr->udr; n->u.reduction_op = OMP_REDUCTION_USER; - n->udr->combiner + n->u2.udr->combiner = resolve_omp_udr_clause (n, udr->combiner_ns, udr->omp_out, udr->omp_in); if (udr->initializer_ns) - n->udr->initializer + n->u2.udr->initializer = resolve_omp_udr_clause (n, udr->initializer_ns, udr->omp_priv, @@ -5726,6 +6755,8 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, resolve_positive_int_expr (omp_clauses->num_teams, "NUM_TEAMS"); if (omp_clauses->device) resolve_nonnegative_int_expr (omp_clauses->device, "DEVICE"); + if (omp_clauses->filter) + resolve_nonnegative_int_expr (omp_clauses->filter, "FILTER"); if (omp_clauses->hint) { resolve_scalar_int_expr (omp_clauses->hint, "HINT"); @@ -5776,6 +6807,15 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, if (omp_clauses->depend_source && code->op != EXEC_OMP_ORDERED) gfc_error ("SOURCE dependence type only allowed " "on ORDERED directive at %L", &code->loc); + if (omp_clauses->message) + { + gfc_expr *expr = omp_clauses->message; + if (!gfc_resolve_expr (expr) + || expr->ts.kind != gfc_default_character_kind + || expr->ts.type != BT_CHARACTER || expr->rank != 0) + gfc_error ("MESSAGE clause at %L requires a scalar default-kind " + "CHARACTER expression", &expr->where); + } if (!openacc && code && omp_clauses->lists[OMP_LIST_MAP] == NULL @@ -6388,6 +7428,14 @@ gfc_resolve_omp_parallel_blocks (gfc_code *code, gfc_namespace *ns) case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD: case EXEC_OMP_PARALLEL_DO: case EXEC_OMP_PARALLEL_DO_SIMD: + case EXEC_OMP_PARALLEL_MASKED_TASKLOOP: + case EXEC_OMP_PARALLEL_MASKED_TASKLOOP_SIMD: + case EXEC_OMP_PARALLEL_MASTER_TASKLOOP: + case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD: + case EXEC_OMP_MASKED_TASKLOOP: + case EXEC_OMP_MASKED_TASKLOOP_SIMD: + case EXEC_OMP_MASTER_TASKLOOP: + case EXEC_OMP_MASTER_TASKLOOP_SIMD: case EXEC_OMP_TARGET_PARALLEL_DO: case EXEC_OMP_TARGET_PARALLEL_DO_SIMD: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE: @@ -6526,17 +7574,46 @@ resolve_omp_do (gfc_code *code) break; case EXEC_OMP_DO: name = "!$OMP DO"; break; case EXEC_OMP_DO_SIMD: name = "!$OMP DO SIMD"; is_simd = true; break; + case EXEC_OMP_LOOP: name = "!$OMP LOOP"; break; case EXEC_OMP_PARALLEL_DO: name = "!$OMP PARALLEL DO"; break; case EXEC_OMP_PARALLEL_DO_SIMD: name = "!$OMP PARALLEL DO SIMD"; is_simd = true; break; + case EXEC_OMP_PARALLEL_LOOP: name = "!$OMP PARALLEL LOOP"; break; + case EXEC_OMP_PARALLEL_MASKED_TASKLOOP: + name = "!$OMP PARALLEL MASKED TASKLOOP"; + break; + case EXEC_OMP_PARALLEL_MASKED_TASKLOOP_SIMD: + name = "!$OMP PARALLEL MASKED TASKLOOP SIMD"; + is_simd = true; + break; + case EXEC_OMP_PARALLEL_MASTER_TASKLOOP: + name = "!$OMP PARALLEL MASTER TASKLOOP"; + break; + case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD: + name = "!$OMP PARALLEL MASTER TASKLOOP SIMD"; + is_simd = true; + break; + case EXEC_OMP_MASKED_TASKLOOP: name = "!$OMP MASKED TASKLOOP"; break; + case EXEC_OMP_MASKED_TASKLOOP_SIMD: + name = "!$OMP MASKED TASKLOOP SIMD"; + is_simd = true; + break; + case EXEC_OMP_MASTER_TASKLOOP: name = "!$OMP MASTER TASKLOOP"; break; + case EXEC_OMP_MASTER_TASKLOOP_SIMD: + name = "!$OMP MASTER TASKLOOP SIMD"; + is_simd = true; + break; case EXEC_OMP_SIMD: name = "!$OMP SIMD"; is_simd = true; break; case EXEC_OMP_TARGET_PARALLEL_DO: name = "!$OMP TARGET PARALLEL DO"; break; case EXEC_OMP_TARGET_PARALLEL_DO_SIMD: name = "!$OMP TARGET PARALLEL DO SIMD"; is_simd = true; break; + case EXEC_OMP_TARGET_PARALLEL_LOOP: + name = "!$OMP TARGET PARALLEL LOOP"; + break; case EXEC_OMP_TARGET_SIMD: name = "!$OMP TARGET SIMD"; is_simd = true; @@ -6555,6 +7632,7 @@ resolve_omp_do (gfc_code *code) name = "!$OMP TARGET TEAMS DISTRIBUTE SIMD"; is_simd = true; break; + case EXEC_OMP_TARGET_TEAMS_LOOP: name = "!$OMP TARGET TEAMS LOOP"; break; case EXEC_OMP_TASKLOOP: name = "!$OMP TASKLOOP"; break; case EXEC_OMP_TASKLOOP_SIMD: name = "!$OMP TASKLOOP SIMD"; @@ -6572,6 +7650,7 @@ resolve_omp_do (gfc_code *code) name = "!$OMP TEAMS DISTRIBUTE SIMD"; is_simd = true; break; + case EXEC_OMP_TEAMS_LOOP: name = "!$OMP TEAMS LOOP"; break; default: gcc_unreachable (); } @@ -6683,6 +7762,18 @@ omp_code_to_statement (gfc_code *code) { case EXEC_OMP_PARALLEL: return ST_OMP_PARALLEL; + case EXEC_OMP_PARALLEL_MASKED: + return ST_OMP_PARALLEL_MASKED; + case EXEC_OMP_PARALLEL_MASKED_TASKLOOP: + return ST_OMP_PARALLEL_MASKED_TASKLOOP; + case EXEC_OMP_PARALLEL_MASKED_TASKLOOP_SIMD: + return ST_OMP_PARALLEL_MASKED_TASKLOOP_SIMD; + case EXEC_OMP_PARALLEL_MASTER: + return ST_OMP_PARALLEL_MASTER; + case EXEC_OMP_PARALLEL_MASTER_TASKLOOP: + return ST_OMP_PARALLEL_MASTER_TASKLOOP; + case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD: + return ST_OMP_PARALLEL_MASTER_TASKLOOP_SIMD; case EXEC_OMP_PARALLEL_SECTIONS: return ST_OMP_PARALLEL_SECTIONS; case EXEC_OMP_SECTIONS: @@ -6691,8 +7782,18 @@ omp_code_to_statement (gfc_code *code) return ST_OMP_ORDERED; case EXEC_OMP_CRITICAL: return ST_OMP_CRITICAL; + case EXEC_OMP_MASKED: + return ST_OMP_MASKED; + case EXEC_OMP_MASKED_TASKLOOP: + return ST_OMP_MASKED_TASKLOOP; + case EXEC_OMP_MASKED_TASKLOOP_SIMD: + return ST_OMP_MASKED_TASKLOOP_SIMD; case EXEC_OMP_MASTER: return ST_OMP_MASTER; + case EXEC_OMP_MASTER_TASKLOOP: + return ST_OMP_MASTER_TASKLOOP; + case EXEC_OMP_MASTER_TASKLOOP_SIMD: + return ST_OMP_MASTER_TASKLOOP_SIMD; case EXEC_OMP_SINGLE: return ST_OMP_SINGLE; case EXEC_OMP_TASK: @@ -6703,6 +7804,8 @@ omp_code_to_statement (gfc_code *code) return ST_OMP_PARALLEL_WORKSHARE; case EXEC_OMP_DO: return ST_OMP_DO; + case EXEC_OMP_LOOP: + return ST_OMP_LOOP; case EXEC_OMP_ATOMIC: return ST_OMP_ATOMIC; case EXEC_OMP_BARRIER: @@ -6711,6 +7814,8 @@ omp_code_to_statement (gfc_code *code) return ST_OMP_CANCEL; case EXEC_OMP_CANCELLATION_POINT: return ST_OMP_CANCELLATION_POINT; + case EXEC_OMP_ERROR: + return ST_OMP_ERROR; case EXEC_OMP_FLUSH: return ST_OMP_FLUSH; case EXEC_OMP_DISTRIBUTE: @@ -6725,6 +7830,8 @@ omp_code_to_statement (gfc_code *code) return ST_OMP_DO_SIMD; case EXEC_OMP_SCAN: return ST_OMP_SCAN; + case EXEC_OMP_SCOPE: + return ST_OMP_SCOPE; case EXEC_OMP_SIMD: return ST_OMP_SIMD; case EXEC_OMP_TARGET: @@ -6741,6 +7848,8 @@ omp_code_to_statement (gfc_code *code) return ST_OMP_TARGET_PARALLEL_DO; case EXEC_OMP_TARGET_PARALLEL_DO_SIMD: return ST_OMP_TARGET_PARALLEL_DO_SIMD; + case EXEC_OMP_TARGET_PARALLEL_LOOP: + return ST_OMP_TARGET_PARALLEL_LOOP; case EXEC_OMP_TARGET_SIMD: return ST_OMP_TARGET_SIMD; case EXEC_OMP_TARGET_TEAMS: @@ -6753,6 +7862,8 @@ omp_code_to_statement (gfc_code *code) return ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD; case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: return ST_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD; + case EXEC_OMP_TARGET_TEAMS_LOOP: + return ST_OMP_TARGET_TEAMS_LOOP; case EXEC_OMP_TARGET_UPDATE: return ST_OMP_TARGET_UPDATE; case EXEC_OMP_TASKGROUP: @@ -6775,11 +7886,16 @@ omp_code_to_statement (gfc_code *code) return ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD; case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD: return ST_OMP_TEAMS_DISTRIBUTE_SIMD; + case EXEC_OMP_TEAMS_LOOP: + return ST_OMP_TEAMS_LOOP; case EXEC_OMP_PARALLEL_DO: return ST_OMP_PARALLEL_DO; case EXEC_OMP_PARALLEL_DO_SIMD: return ST_OMP_PARALLEL_DO_SIMD; - + case EXEC_OMP_PARALLEL_LOOP: + return ST_OMP_PARALLEL_LOOP; + case EXEC_OMP_DEPOBJ: + return ST_OMP_DEPOBJ; default: gcc_unreachable (); } @@ -7178,28 +8294,46 @@ gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns) case EXEC_OMP_DISTRIBUTE_SIMD: case EXEC_OMP_DO: case EXEC_OMP_DO_SIMD: + case EXEC_OMP_LOOP: case EXEC_OMP_PARALLEL_DO: case EXEC_OMP_PARALLEL_DO_SIMD: + case EXEC_OMP_PARALLEL_LOOP: + case EXEC_OMP_PARALLEL_MASKED_TASKLOOP: + case EXEC_OMP_PARALLEL_MASKED_TASKLOOP_SIMD: + case EXEC_OMP_PARALLEL_MASTER_TASKLOOP: + case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD: + case EXEC_OMP_MASKED_TASKLOOP: + case EXEC_OMP_MASKED_TASKLOOP_SIMD: + case EXEC_OMP_MASTER_TASKLOOP: + case EXEC_OMP_MASTER_TASKLOOP_SIMD: case EXEC_OMP_SIMD: case EXEC_OMP_TARGET_PARALLEL_DO: case EXEC_OMP_TARGET_PARALLEL_DO_SIMD: + case EXEC_OMP_TARGET_PARALLEL_LOOP: case EXEC_OMP_TARGET_SIMD: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: + case EXEC_OMP_TARGET_TEAMS_LOOP: case EXEC_OMP_TASKLOOP: case EXEC_OMP_TASKLOOP_SIMD: case EXEC_OMP_TEAMS_DISTRIBUTE: case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD: + case EXEC_OMP_TEAMS_LOOP: resolve_omp_do (code); break; case EXEC_OMP_CANCEL: + case EXEC_OMP_ERROR: + case EXEC_OMP_MASKED: case EXEC_OMP_PARALLEL_WORKSHARE: case EXEC_OMP_PARALLEL: + case EXEC_OMP_PARALLEL_MASKED: + case EXEC_OMP_PARALLEL_MASTER: case EXEC_OMP_PARALLEL_SECTIONS: + case EXEC_OMP_SCOPE: case EXEC_OMP_SECTIONS: case EXEC_OMP_SINGLE: case EXEC_OMP_TARGET: @@ -7209,8 +8343,10 @@ gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns) case EXEC_OMP_TARGET_PARALLEL: case EXEC_OMP_TARGET_TEAMS: case EXEC_OMP_TASK: + case EXEC_OMP_TASKWAIT: case EXEC_OMP_TEAMS: case EXEC_OMP_WORKSHARE: + case EXEC_OMP_DEPOBJ: if (code->ext.omp_clauses) resolve_omp_clauses (code, code->ext.omp_clauses, NULL); break; |