From a61c4964cd71446232d62ec9b10a7d45b440dd9f Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Wed, 21 Apr 2021 10:58:29 +0200 Subject: Fortran/OpenMP: Add 'omp depobj' and 'depend(mutexinoutset:' gcc/fortran/ChangeLog: * dump-parse-tree.c (show_omp_namelist): Handle depobj + mutexinoutset in the depend clause. (show_omp_clauses, show_omp_node, show_code_node): Handle depobj. * gfortran.h (enum gfc_statement): Add ST_OMP_DEPOBJ. (enum gfc_omp_depend_op): Add OMP_DEPEND_UNSET, OMP_DEPEND_MUTEXINOUTSET and OMP_DEPEND_DEPOBJ. (gfc_omp_clauses): Add destroy, depobj_update and depobj. (enum gfc_exec_op): Add EXEC_OMP_DEPOBJ * match.h (gfc_match_omp_depobj): Match 'omp depobj'. * openmp.c (gfc_match_omp_clauses): Add depobj + mutexinoutset to depend clause. (gfc_match_omp_depobj, resolve_omp_clauses, gfc_resolve_omp_directive): Handle 'omp depobj'. * parse.c (decode_omp_directive, next_statement, gfc_ascii_statement): Likewise. * resolve.c (gfc_resolve_code): Likewise. * st.c (gfc_free_statement): Likewise. * trans-openmp.c (gfc_trans_omp_clauses): Handle depobj + mutexinoutset in the depend clause. (gfc_trans_omp_depobj, gfc_trans_omp_directive): Handle EXEC_OMP_DEPOBJ. * trans.c (trans_code): Likewise. libgomp/ChangeLog: * testsuite/libgomp.fortran/depobj-1.f90: New test. gcc/testsuite/ChangeLog: * gfortran.dg/gomp/depobj-1.f90: New test. * gfortran.dg/gomp/depobj-2.f90: New test. --- gcc/fortran/openmp.c | 113 +++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 113 insertions(+) (limited to 'gcc/fortran/openmp.c') diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index 1f1920c..a1b0572 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -1381,6 +1381,10 @@ 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) { @@ -2898,6 +2902,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) @@ -4877,6 +4961,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++) @@ -5173,6 +5265,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; @@ -7211,6 +7323,7 @@ gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns) case EXEC_OMP_TASK: 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; -- cgit v1.1 From e4aefface2a0e34d84b85844b11652eb28f2cf0c Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Wed, 28 Apr 2021 22:35:06 +0200 Subject: Fortran/OpenMP: Fix var-list expr parsing with array/dt gcc/fortran/ChangeLog: * openmp.c (gfc_match_omp_variable_list): Gobble whitespace before checking whether a '%' or parenthesis-open follows as next character. gcc/testsuite/ChangeLog: * gfortran.dg/gomp/map-5.f90: New test. --- gcc/fortran/openmp.c | 1 + 1 file changed, 1 insertion(+) (limited to 'gcc/fortran/openmp.c') diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index a1b0572..7eeabff 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -261,6 +261,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 () == '%')) { -- cgit v1.1 From 0e3702f8daeec5897982d185650b78a5c1c53c25 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Fri, 14 May 2021 19:21:47 +0200 Subject: Fortran/OpenMP: Support 'omp parallel master' gcc/fortran/ChangeLog: * dump-parse-tree.c (show_omp_node, show_code_node): Handle EXEC_OMP_PARALLEL_MASTER. * frontend-passes.c (gfc_code_walker): Likewise. * gfortran.h (enum gfc_statement): Add ST_OMP_PARALLEL_MASTER and ST_OMP_END_PARALLEL_MASTER. (enum gfc_exec_op): Add EXEC_OMP_PARALLEL_MASTER.. * match.h (gfc_match_omp_parallel_master): Handle it. * openmp.c (gfc_match_omp_parallel_master, resolve_omp_clauses, omp_code_to_statement, gfc_resolve_omp_directive): Likewise. * parse.c (decode_omp_directive, case_exec_markers, gfc_ascii_statement, parse_omp_structured_block, parse_executable): Likewise. * resolve.c (gfc_resolve_blocks, gfc_resolve_code): Likewise. * st.c (gfc_free_statement): Likewise. * trans-openmp.c (gfc_trans_omp_parallel_master, gfc_trans_omp_workshare, gfc_trans_omp_directive): Likewise. * trans.c (trans_code): Likewise. libgomp/ChangeLog: * testsuite/libgomp.fortran/parallel-master.f90: New test. gcc/testsuite/ChangeLog: * gfortran.dg/gomp/parallel-master-1.f90: New test. * gfortran.dg/gomp/parallel-master-2.f90: New test. --- gcc/fortran/openmp.c | 11 +++++++++++ 1 file changed, 11 insertions(+) (limited to 'gcc/fortran/openmp.c') diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index 7eeabff..294b6d0 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -3770,6 +3770,13 @@ gfc_match_omp_parallel_do_simd (void) match +gfc_match_omp_parallel_master (void) +{ + return match_omp (EXEC_OMP_PARALLEL_MASTER, OMP_PARALLEL_CLAUSES); +} + + +match gfc_match_omp_parallel_sections (void) { return match_omp (EXEC_OMP_PARALLEL_SECTIONS, @@ -4833,6 +4840,7 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, case EXEC_OMP_PARALLEL: case EXEC_OMP_PARALLEL_DO: + case EXEC_OMP_PARALLEL_MASTER: case EXEC_OMP_PARALLEL_SECTIONS: case EXEC_OMP_PARALLEL_WORKSHARE: case EXEC_OMP_DISTRIBUTE_PARALLEL_DO: @@ -6796,6 +6804,8 @@ omp_code_to_statement (gfc_code *code) { case EXEC_OMP_PARALLEL: return ST_OMP_PARALLEL; + case EXEC_OMP_PARALLEL_MASTER: + return ST_OMP_PARALLEL_MASTER; case EXEC_OMP_PARALLEL_SECTIONS: return ST_OMP_PARALLEL_SECTIONS; case EXEC_OMP_SECTIONS: @@ -7312,6 +7322,7 @@ gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns) case EXEC_OMP_CANCEL: case EXEC_OMP_PARALLEL_WORKSHARE: case EXEC_OMP_PARALLEL: + case EXEC_OMP_PARALLEL_MASTER: case EXEC_OMP_PARALLEL_SECTIONS: case EXEC_OMP_SECTIONS: case EXEC_OMP_SINGLE: -- cgit v1.1 From cc193ac840d58ee0ffb57b14b542706cde3db0e7 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Tue, 18 May 2021 16:40:45 +0200 Subject: Fortran/OpenMP: Add missing EXEC_OMP_DEPOBJ case val [PR100642] PR fortran/100642 gcc/fortran/ChangeLog: * openmp.c (omp_code_to_statement): Add missing EXEC_OMP_DEPOBJ. gcc/testsuite/ChangeLog: * gfortran.dg/goacc-gomp/depobj.f90: New test. --- gcc/fortran/openmp.c | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'gcc/fortran/openmp.c') diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index 294b6d0..005b6c1 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -6902,7 +6902,8 @@ omp_code_to_statement (gfc_code *code) return ST_OMP_PARALLEL_DO; case EXEC_OMP_PARALLEL_DO_SIMD: return ST_OMP_PARALLEL_DO_SIMD; - + case EXEC_OMP_DEPOBJ: + return ST_OMP_DEPOBJ; default: gcc_unreachable (); } -- cgit v1.1 From cdcec2f8505ea12c2236cf0184d77dd2f5de4832 Mon Sep 17 00:00:00 2001 From: Marcel Vollweiler Date: Thu, 20 May 2021 08:52:34 -0700 Subject: Fortran/OpenMP: Add support for 'close' in map clause gcc/fortran/ChangeLog: * openmp.c (gfc_match_omp_clauses): Support map-type-modifier 'close'. gcc/testsuite/ChangeLog: * gfortran.dg/gomp/map-6.f90: New test. * gfortran.dg/gomp/map-7.f90: New test. * gfortran.dg/gomp/map-8.f90: New test. --- gcc/fortran/openmp.c | 55 ++++++++++++++++++++++++++++++++++++++++++---------- 1 file changed, 45 insertions(+), 10 deletions(-) (limited to 'gcc/fortran/openmp.c') diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index 005b6c1..cf4d7ba 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -1710,27 +1710,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 % modifiers at %L", + &second_always_locus); + break; + } + if (close_modifier > 1) + { + gfc_error ("too many % modifiers at %L", + &second_close_locus); + break; + } + head = NULL; if (gfc_match_omp_variable_list ("", &c->lists[OMP_LIST_MAP], false, NULL, &head, @@ -1741,8 +1776,8 @@ 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) -- cgit v1.1 From 9a5de4d5af1c10a8c097de30ee4c71457216e975 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Fri, 28 May 2021 10:01:19 +0200 Subject: OpenMP: Add iterator support to Fortran's depend; add affinity clause gcc/c-family/ChangeLog: * c-pragma.h (enum pragma_omp_clause): Add PRAGMA_OMP_CLAUSE_AFFINITY. gcc/c/ChangeLog: * c-parser.c (c_parser_omp_clause_affinity): New. (c_parser_omp_clause_name, c_parser_omp_variable_list, c_parser_omp_all_clauses, OMP_TASK_CLAUSE_MASK): Handle affinity clause. * c-typeck.c (handle_omp_array_sections_1, handle_omp_array_sections, c_finish_omp_clauses): Likewise. gcc/cp/ChangeLog: * parser.c (cp_parser_omp_clause_affinity): New. (cp_parser_omp_clause_name, cp_parser_omp_var_list_no_open, cp_parser_omp_all_clauses, OMP_TASK_CLAUSE_MASK): Handle affinity clause. * semantics.c (handle_omp_array_sections_1, handle_omp_array_sections, finish_omp_clauses): Likewise. gcc/fortran/ChangeLog: * dump-parse-tree.c (show_iterator): New. (show_omp_namelist): Handle iterators. (show_omp_clauses): Handle affinity. * gfortran.h (gfc_free_omp_namelist): New union with 'udr' and new 'ns'. * match.c (gfc_free_omp_namelist): Add are to choose union element. * openmp.c (gfc_free_omp_clauses, gfc_match_omp_detach, gfc_match_omp_clause_reduction, gfc_match_omp_flush): Update call to gfc_free_omp_namelist. (gfc_match_omp_variable_list): Likewise; permit preceeding whitespace. (enum omp_mask1): Add OMP_CLAUSE_AFFINITY. (gfc_match_iterator): New. (gfc_match_omp_clauses): Use it; update call to gfc_free_omp_namelist. (OMP_TASK_CLAUSES): Add OMP_CLAUSE_AFFINITY. (gfc_match_omp_taskwait): Match depend clause. (resolve_omp_clauses): Handle affinity; update for udr/union change. (gfc_resolve_omp_directive): Resolve clauses of taskwait. * st.c (gfc_free_statement): Update gfc_free_omp_namelist call. * trans-openmp.c (gfc_trans_omp_array_reduction_or_udr): Likewise (handle_iterator): New. (gfc_trans_omp_clauses): Handle iterators for depend/affinity clause. (gfc_trans_omp_taskwait): Handle depend clause. (gfc_trans_omp_directive): Update call. gcc/ChangeLog: * gimplify.c (gimplify_omp_affinity): New. (gimplify_scan_omp_clauses): Call it; remove affinity clause afterwards. * tree-core.h (enum omp_clause_code): Add OMP_CLAUSE_AFFINITY. * tree-pretty-print.c (dump_omp_clause): Handle OMP_CLAUSE_AFFINITY. * tree.c (omp_clause_num_ops, omp_clause_code_name): Add clause. (walk_tree_1): Handle OMP_CLAUSE_AFFINITY. libgomp/ChangeLog: * testsuite/libgomp.fortran/depend-iterator-2.f90: New test. gcc/testsuite/ChangeLog: * c-c++-common/gomp/affinity-1.c: New test. * c-c++-common/gomp/affinity-2.c: New test. * c-c++-common/gomp/affinity-3.c: New test. * c-c++-common/gomp/affinity-4.c: New test. * c-c++-common/gomp/affinity-5.c: New test. * c-c++-common/gomp/affinity-6.c: New test. * c-c++-common/gomp/affinity-7.c: New test. * gfortran.dg/gomp/affinity-clause-1.f90: New test. * gfortran.dg/gomp/affinity-clause-2.f90: New test. * gfortran.dg/gomp/affinity-clause-3.f90: New test. * gfortran.dg/gomp/affinity-clause-4.f90: New test. * gfortran.dg/gomp/affinity-clause-5.f90: New test. * gfortran.dg/gomp/affinity-clause-6.f90: New test. * gfortran.dg/gomp/depend-iterator-1.f90: New test. * gfortran.dg/gomp/depend-iterator-2.f90: New test. * gfortran.dg/gomp/depend-iterator-3.f90: New test. * gfortran.dg/gomp/taskwait.f90: New test. --- gcc/fortran/openmp.c | 307 ++++++++++++++++++++++++++++++++++++++++++++------- 1 file changed, 265 insertions(+), 42 deletions(-) (limited to 'gcc/fortran/openmp.c') diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index cf4d7ba..4ed6a0d 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -25,6 +25,7 @@ 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" @@ -103,7 +104,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)); @@ -355,7 +357,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; } @@ -445,7 +447,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; } @@ -552,7 +554,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; } @@ -843,6 +845,7 @@ 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_NOWAIT, /* This must come last. */ OMP_MASK1_LAST @@ -996,6 +999,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 ) */ @@ -1138,7 +1267,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) @@ -1146,8 +1275,8 @@ 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; @@ -1202,7 +1331,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; @@ -1230,6 +1359,36 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, needs_space = true; continue; } + if ((mask & OMP_CLAUSE_AFFINITY) + && gfc_match ("affinity ( ") == MATCH_YES) + { + gfc_namespace *ns_iter = NULL, *ns_curr = gfc_current_ns; + match 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_ASYNC) && !c->async && gfc_match ("async") == MATCH_YES) @@ -1374,6 +1533,12 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, if ((mask & OMP_CLAUSE_DEPEND) && gfc_match ("depend ( ") == 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; match m = MATCH_YES; gfc_omp_depend_op depend_op = OMP_DEPEND_OUT; if (gfc_match ("inout") == MATCH_YES) @@ -1389,11 +1554,24 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, 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; @@ -1402,19 +1580,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 @@ -1666,7 +1851,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; @@ -1674,7 +1859,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; @@ -2844,7 +3029,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 \ @@ -3097,14 +3282,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; } @@ -4252,14 +4437,13 @@ gfc_match_omp_taskloop_simd (void) 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)); } @@ -4825,7 +5009,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", @@ -5273,6 +5457,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: @@ -5280,6 +5465,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 @@ -5421,7 +5640,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] @@ -5429,9 +5649,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; } } @@ -5675,23 +5897,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) @@ -5730,14 +5952,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, @@ -7369,6 +7591,7 @@ 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: -- cgit v1.1 From f6bf436d9ab907d090823895abb7a2d5ba7ff50c Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Tue, 1 Jun 2021 12:46:37 +0200 Subject: Fortran/OpenMP: Support (parallel) master taskloop (simd) [PR99928] PR middle-end/99928 gcc/fortran/ChangeLog: * dump-parse-tree.c (show_omp_node, show_code_node): Handle (parallel) master taskloop (simd). * frontend-passes.c (gfc_code_walker): Set in_omp_workshare to false for parallel master taskloop (simd). * gfortran.h (enum gfc_statement): Add ST_OMP_(END_)(PARALLEL_)MASTER_TASKLOOP(_SIMD). (enum gfc_exec_op): EXEC_OMP_(PARALLEL_)MASTER_TASKLOOP(_SIMD). * match.h (gfc_match_omp_master_taskloop, gfc_match_omp_master_taskloop_simd, gfc_match_omp_parallel_master_taskloop, gfc_match_omp_parallel_master_taskloop_simd): New prototype. * openmp.c (gfc_match_omp_parallel_master_taskloop, gfc_match_omp_parallel_master_taskloop_simd, gfc_match_omp_master_taskloop, gfc_match_omp_master_taskloop_simd): New. (gfc_match_omp_taskloop_simd): Permit 'reduction' clause. (resolve_omp_clauses): Handle new combined directives; remove inscan-reduction check to reduce multiple errors; add task-reduction error for 'taskloop simd'. (gfc_resolve_omp_parallel_blocks, resolve_omp_do, omp_code_to_statement, gfc_resolve_omp_directive): Handle new combined constructs. * parse.c (decode_omp_directive, next_statement, gfc_ascii_statement, parse_omp_do, parse_omp_structured_block, parse_executable): Likewise. * resolve.c (gfc_resolve_blocks, gfc_resolve_code): Likewise. * st.c (gfc_free_statement): Likewise. * trans.c (trans_code): Likewise. * trans-openmp.c (gfc_split_omp_clauses, gfc_trans_omp_directive): Likewise. (gfc_trans_omp_parallel_master): Move after gfc_trans_omp_master_taskloop; handle parallel master taskloop (simd) as well. (gfc_trans_omp_taskloop): Take gfc_exec_op as arg. (gfc_trans_omp_master_taskloop): New. gcc/testsuite/ChangeLog: * gfortran.dg/gomp/reduction5.f90: Remove dg-error; the issue is now diagnosed with less error output. * gfortran.dg/gomp/scan-1.f90: Likewise. * gfortran.dg/gomp/pr99928-3.f90: New test. * gfortran.dg/gomp/taskloop-1.f90: New test. --- gcc/fortran/openmp.c | 85 ++++++++++++++++++++++++++++++++++++++++++++++++---- 1 file changed, 79 insertions(+), 6 deletions(-) (limited to 'gcc/fortran/openmp.c') diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index 4ed6a0d..9dba165 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -3995,6 +3995,22 @@ 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) @@ -4429,8 +4445,7 @@ 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); } @@ -4533,6 +4548,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) @@ -5073,6 +5100,16 @@ 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_MASTER_TASKLOOP: + ok = ifc == OMP_IF_PARALLEL || ifc == OMP_IF_TASKLOOP; + break; + + 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: @@ -5085,10 +5122,12 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, break; case EXEC_OMP_TASKLOOP: + case EXEC_OMP_MASTER_TASKLOOP: ok = ifc == OMP_IF_TASKLOOP; break; case EXEC_OMP_TASKLOOP_SIMD: + case EXEC_OMP_MASTER_TASKLOOP_SIMD: ok = ifc == OMP_IF_TASKLOOP || ifc == OMP_IF_SIMD; break; @@ -5848,11 +5887,16 @@ 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_TASKLOOP + || code->op == EXEC_OMP_TASKLOOP_SIMD + || code->op == EXEC_OMP_MASTER_TASKLOOP + || code->op == EXEC_OMP_MASTER_TASKLOOP_SIMD + || code->op == EXEC_OMP_PARALLEL_MASTER_TASKLOOP + || code->op == EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD + || code->op == EXEC_OMP_TEAMS + || code->op == EXEC_OMP_TEAMS_DISTRIBUTE)) { gfc_error ("Only DEFAULT permitted as reduction-" "modifier in REDUCTION clause at %L", @@ -5863,6 +5907,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: @@ -6766,6 +6811,10 @@ 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_MASTER_TASKLOOP: + case EXEC_OMP_PARALLEL_MASTER_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: @@ -6909,6 +6958,18 @@ resolve_omp_do (gfc_code *code) name = "!$OMP PARALLEL DO 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_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: @@ -7063,6 +7124,10 @@ omp_code_to_statement (gfc_code *code) return ST_OMP_PARALLEL; 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: @@ -7073,6 +7138,10 @@ omp_code_to_statement (gfc_code *code) return ST_OMP_CRITICAL; 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: @@ -7561,6 +7630,10 @@ gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns) case EXEC_OMP_DO_SIMD: case EXEC_OMP_PARALLEL_DO: case EXEC_OMP_PARALLEL_DO_SIMD: + case EXEC_OMP_PARALLEL_MASTER_TASKLOOP: + case EXEC_OMP_PARALLEL_MASTER_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: -- cgit v1.1 From 178191e1dfafd8db149edcdef7a39e9e2c00f216 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Fri, 4 Jun 2021 12:06:59 +0200 Subject: Fortran/OpenMP: Add omp loop [PR99928] PR middle-end/99928 gcc/fortran/ChangeLog: * dump-parse-tree.c (show_omp_clauses): Handle bind clause. (show_omp_node): Handle loop directive. * frontend-passes.c (gfc_code_walker): Likewise. * gfortran.h (enum gfc_statement): Add ST_OMP_(END_)(TARGET_)(|PARALLEL_|TEAMS_)LOOP. (enum gfc_omp_bind_type): New. (gfc_omp_clauses): Use it. (enum gfc_exec_op): Add EXEC_OMP_(TARGET_)(|PARALLEL_|TEAMS_)LOOP. * match.h (gfc_match_omp_loop, gfc_match_omp_parallel_loop, gfc_match_omp_target_parallel_loop, gfc_match_omp_target_teams_loop, gfc_match_omp_teams_loop): New. * openmp.c (enum omp_mask1): Add OMP_CLAUSE_BIND. (gfc_match_omp_clauses): Handle it. (OMP_LOOP_CLAUSES, gfc_match_omp_loop, gfc_match_omp_teams_loop, gfc_match_omp_target_teams_loop, gfc_match_omp_parallel_loop, gfc_match_omp_target_parallel_loop): New. (resolve_omp_clauses, resolve_omp_do, omp_code_to_statement, gfc_resolve_omp_directive): Handle omp loop. * parse.c (decode_omp_directive case_exec_markers, gfc_ascii_statement, parse_omp_do, parse_executable): Likewise. (parse_omp_structured_block): Remove ST_ which use parse_omp_do. * resolve.c (gfc_resolve_blocks): Add omp loop. * st.c (gfc_free_statement): Likewise. * trans-openmp.c (gfc_trans_omp_clauses): Handle bind clause. (gfc_trans_omp_do, gfc_trans_omp_parallel_do, gfc_trans_omp_distribute, gfc_trans_omp_teams, gfc_trans_omp_target, gfc_trans_omp_directive): Handle loop directive. (gfc_split_omp_clauses): Likewise; fix firstprivate/lastprivate and (in_)reduction for taskloop. * trans.c (trans_code): Handle omp loop directive. gcc/testsuite/ChangeLog: * gfortran.dg/gomp/pr99928-3.f90: Add 'default(none)', following C/C++ version of the patch. * gfortran.dg/gomp/loop-1.f90: New test. * gfortran.dg/gomp/loop-2.f90: New test. * gfortran.dg/gomp/pr99928-1.f90: New test; based on C/C++ test. * gfortran.dg/gomp/pr99928-11.f90: Likewise. * gfortran.dg/gomp/pr99928-2.f90: Likewise. * gfortran.dg/gomp/pr99928-4.f90: Likewise. * gfortran.dg/gomp/pr99928-5.f90: Likewise. * gfortran.dg/gomp/pr99928-6.f90: Likewise. * gfortran.dg/gomp/pr99928-8.f90: Likewise. * gfortran.dg/goacc/omp.f95: Use 'acc kernels loops' instead of 'acc loops' to hide unrelated bug for now. * gfortran.dg/goacc/omp-fixed.f: Likewise --- gcc/fortran/openmp.c | 94 ++++++++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 92 insertions(+), 2 deletions(-) (limited to 'gcc/fortran/openmp.c') diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index 9dba165..d7136b1 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -846,6 +846,7 @@ enum omp_mask1 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_NOWAIT, /* This must come last. */ OMP_MASK1_LAST @@ -1426,6 +1427,26 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, allow_derived)) continue; break; + case 'b': + if ((mask & OMP_CLAUSE_BIND) + && c->bind == OMP_BIND_UNSET + && gfc_match ("bind ( ") == MATCH_YES) + { + 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 THEAD as binding in " + "BIND at %C"); + break; + } + continue; + } + break; case 'c': if ((mask & OMP_CLAUSE_CAPTURE) && !c->capture @@ -3016,6 +3037,9 @@ 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_SECTIONS_CLAUSES \ (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE \ | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION) @@ -3255,6 +3279,45 @@ 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_flush (void) { gfc_omp_namelist *list = NULL; @@ -5889,14 +5952,19 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, { case OMP_LIST_REDUCTION_TASK: if (code - && (code->op == EXEC_OMP_TASKLOOP + && (code->op == EXEC_OMP_LOOP + || code->op == EXEC_OMP_TASKLOOP || code->op == EXEC_OMP_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_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_DISTRIBUTE + || code->op == EXEC_OMP_TEAMS_LOOP)) { gfc_error ("Only DEFAULT permitted as reduction-" "modifier in REDUCTION clause at %L", @@ -6953,11 +7021,13 @@ 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_MASTER_TASKLOOP: name = "!$OMP PARALLEL MASTER TASKLOOP"; break; @@ -6976,6 +7046,9 @@ resolve_omp_do (gfc_code *code) 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; @@ -6994,6 +7067,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"; @@ -7011,6 +7085,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 (); } @@ -7152,6 +7227,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: @@ -7190,6 +7267,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: @@ -7202,6 +7281,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: @@ -7224,10 +7305,14 @@ 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: @@ -7628,8 +7713,10 @@ 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_MASTER_TASKLOOP: case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD: case EXEC_OMP_MASTER_TASKLOOP: @@ -7637,17 +7724,20 @@ gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns) 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: -- cgit v1.1 From 848a36032c8876ee45d5c81efeddb1bc657ac95c Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Fri, 4 Jun 2021 12:14:14 +0200 Subject: Fortran/OpenMP: omp loop's BIND clause - fix typo Missed a 'git add' after fixing this typo pointed out during review. PR middle-end/99928 gcc/fortran/ChangeLog: * openmp.c (gfc_match_omp_clauses): Fix typo in error message. gcc/testsuite/ChangeLog: * gfortran.dg/gomp/loop-2.f90: Update for typo fix. --- gcc/fortran/openmp.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'gcc/fortran/openmp.c') diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index d7136b1..638a823 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -1440,7 +1440,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, c->bind = OMP_BIND_THREAD; else { - gfc_error ("Expected TEAMS, PARALLEL or THEAD as binding in " + gfc_error ("Expected TEAMS, PARALLEL or THREAD as binding in " "BIND at %C"); break; } -- cgit v1.1 From 1de31913d20a467b78904c0e96efd5fbd6facd2c Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Tue, 15 Jun 2021 16:06:38 +0200 Subject: Fortran/OpenMP: Extend defaultmap clause for OpenMP 5 [PR92568] PR fortran/92568 gcc/fortran/ChangeLog: * dump-parse-tree.c (show_omp_clauses): Update for defaultmap. * f95-lang.c (LANG_HOOKS_OMP_ALLOCATABLE_P, LANG_HOOKS_OMP_SCALAR_TARGET_P): New. * gfortran.h (enum gfc_omp_defaultmap, enum gfc_omp_defaultmap_category): New. * openmp.c (gfc_match_omp_clauses): Update defaultmap matching. * trans-decl.c (gfc_finish_decl_attrs): Set GFC_DECL_SCALAR_TARGET. * trans-openmp.c (gfc_omp_allocatable_p, gfc_omp_scalar_target_p): New. (gfc_omp_scalar_p): Take 'ptr_alloc_ok' argument. (gfc_trans_omp_clauses, gfc_split_omp_clauses): Update for defaultmap changes. * trans.h (gfc_omp_scalar_p): Update prototype. (gfc_omp_allocatable_p, gfc_omp_scalar_target_p): New. (struct lang_decl): Add scalar_target. (GFC_DECL_SCALAR_TARGET, GFC_DECL_GET_SCALAR_TARGET): New. gcc/ChangeLog: * gimplify.c (enum gimplify_defaultmap_kind): Add GDMK_SCALAR_TARGET. (struct gimplify_omp_ctx): Extend defaultmap array by one. (new_omp_context): Init defaultmap[GDMK_SCALAR_TARGET]. (omp_notice_variable): Update type classification for Fortran. (gimplify_scan_omp_clauses): Update calls for new argument; handle GDMK_SCALAR_TARGET; for Fortran, GDMK_POINTER avoid GOVD_MAP_0LEN_ARRAY. * langhooks-def.h (lhd_omp_scalar_p): Add 'ptr_ok' argument. * langhooks.c (lhd_omp_scalar_p): Likewise. (LANG_HOOKS_OMP_ALLOCATABLE_P, LANG_HOOKS_OMP_SCALAR_TARGET_P): New. (LANG_HOOKS_DECLS): Add them. * langhooks.h (struct lang_hooks_for_decls): Add new hooks, update omp_scalar_p pointer type to include the new bool argument. libgomp/ChangeLog: * testsuite/libgomp.fortran/defaultmap-8.f90: New test. gcc/testsuite/ChangeLog: * gfortran.dg/gomp/pr99928-1.f90: Uncomment 'defaultmap(none)'. * gfortran.dg/gomp/pr99928-2.f90: Uncomment 'defaultmap(none)'. * gfortran.dg/gomp/pr99928-3.f90: Uncomment 'defaultmap(none)'. * gfortran.dg/gomp/pr99928-4.f90: Uncomment 'defaultmap(none)'. * gfortran.dg/gomp/pr99928-5.f90: Uncomment 'defaultmap(none)'. * gfortran.dg/gomp/pr99928-6.f90: Uncomment 'defaultmap(none)'. * gfortran.dg/gomp/pr99928-8.f90: Uncomment 'defaultmap(none)'. * gfortran.dg/gomp/defaultmap-1.f90: New test. * gfortran.dg/gomp/defaultmap-2.f90: New test. * gfortran.dg/gomp/defaultmap-3.f90: New test. * gfortran.dg/gomp/defaultmap-4.f90: New test. * gfortran.dg/gomp/defaultmap-5.f90: New test. * gfortran.dg/gomp/defaultmap-6.f90: New test. * gfortran.dg/gomp/defaultmap-7.f90: New test. --- gcc/fortran/openmp.c | 84 ++++++++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 81 insertions(+), 3 deletions(-) (limited to 'gcc/fortran/openmp.c') diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index 638a823..357a1e1 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -1539,10 +1539,87 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, continue; } if ((mask & OMP_CLAUSE_DEFAULTMAP) - && !c->defaultmap - && gfc_match ("defaultmap ( tofrom : scalar )") == MATCH_YES) + && gfc_match ("defaultmap ( ") == MATCH_YES) { - c->defaultmap = true; + 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 end; + } + } + c->defaultmap[category] = behavior; + if (gfc_match (")") != MATCH_YES) + break; continue; } if ((mask & OMP_CLAUSE_DELETE) @@ -2459,6 +2536,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, break; } +end: if (gfc_match_omp_eos () != MATCH_YES) { if (!gfc_error_flag_test ()) -- cgit v1.1 From a61f6afbee370785cf091fe46e2e022748528307 Mon Sep 17 00:00:00 2001 From: Thomas Schwinge Date: Wed, 21 Jul 2021 18:30:00 +0200 Subject: OpenACC 'nohost' clause Do not "compile a version of this procedure for the host". gcc/ * tree-core.h (omp_clause_code): Add 'OMP_CLAUSE_NOHOST'. * tree.c (omp_clause_num_ops, omp_clause_code_name, walk_tree_1): Handle it. * tree-pretty-print.c (dump_omp_clause): Likewise. * omp-general.c (oacc_verify_routine_clauses): Likewise. * gimplify.c (gimplify_scan_omp_clauses) (gimplify_adjust_omp_clauses): Likewise. * tree-nested.c (convert_nonlocal_omp_clauses) (convert_local_omp_clauses): Likewise. * omp-low.c (scan_sharing_clauses): Likewise. * omp-offload.c (execute_oacc_device_lower): Update. gcc/c-family/ * c-pragma.h (pragma_omp_clause): Add 'PRAGMA_OACC_CLAUSE_NOHOST'. gcc/c/ * c-parser.c (c_parser_omp_clause_name): Handle 'nohost'. (c_parser_oacc_all_clauses): Handle 'PRAGMA_OACC_CLAUSE_NOHOST'. (OACC_ROUTINE_CLAUSE_MASK): Add 'PRAGMA_OACC_CLAUSE_NOHOST'. * c-typeck.c (c_finish_omp_clauses): Handle 'OMP_CLAUSE_NOHOST'. gcc/cp/ * parser.c (cp_parser_omp_clause_name): Handle 'nohost'. (cp_parser_oacc_all_clauses): Handle 'PRAGMA_OACC_CLAUSE_NOHOST'. (OACC_ROUTINE_CLAUSE_MASK): Add 'PRAGMA_OACC_CLAUSE_NOHOST'. * pt.c (tsubst_omp_clauses): Handle 'OMP_CLAUSE_NOHOST'. * semantics.c (finish_omp_clauses): Likewise. gcc/fortran/ * dump-parse-tree.c (show_attr): Update. * gfortran.h (symbol_attribute): Add 'oacc_routine_nohost' member. (gfc_omp_clauses): Add 'nohost' member. * module.c (ab_attribute): Add 'AB_OACC_ROUTINE_NOHOST'. (attr_bits, mio_symbol_attribute): Update. * openmp.c (omp_mask2): Add 'OMP_CLAUSE_NOHOST'. (gfc_match_omp_clauses): Handle 'OMP_CLAUSE_NOHOST'. (OACC_ROUTINE_CLAUSES): Add 'OMP_CLAUSE_NOHOST'. (gfc_match_oacc_routine): Update. * trans-decl.c (add_attributes_to_decl): Update. * trans-openmp.c (gfc_trans_omp_clauses): Likewise. gcc/testsuite/ * c-c++-common/goacc/classify-routine-nohost.c: New file. * c-c++-common/goacc/classify-routine.c: Update. * c-c++-common/goacc/routine-2.c: Likewise. * c-c++-common/goacc/routine-nohost-1.c: New file. * c-c++-common/goacc/routine-nohost-2.c: Likewise. * g++.dg/goacc/template.C: Update. * gfortran.dg/goacc/classify-routine-nohost.f95: New file. * gfortran.dg/goacc/classify-routine.f95: Update. * gfortran.dg/goacc/pure-elemental-procedures-2.f90: Likewise. * gfortran.dg/goacc/routine-6.f90: Likewise. * gfortran.dg/goacc/routine-intrinsic-2.f: Likewise. * gfortran.dg/goacc/routine-module-1.f90: Likewise. * gfortran.dg/goacc/routine-module-2.f90: Likewise. * gfortran.dg/goacc/routine-module-3.f90: Likewise. * gfortran.dg/goacc/routine-module-mod-1.f90: Likewise. * gfortran.dg/goacc/routine-multiple-directives-1.f90: Likewise. * gfortran.dg/goacc/routine-multiple-directives-2.f90: Likewise. libgomp/ * testsuite/libgomp.oacc-c-c++-common/routine-nohost-1.c: New file. * testsuite/libgomp.oacc-c-c++-common/routine-nohost-2.c: Likewise. * testsuite/libgomp.oacc-c-c++-common/routine-nohost-2_2.c: Likewise. * testsuite/libgomp.oacc-fortran/routine-nohost-1.f90: Likewise. Co-Authored-By: Joseph Myers Co-Authored-By: Cesar Philippidis --- gcc/fortran/openmp.c | 30 +++++++++++++++++++++++++++--- 1 file changed, 27 insertions(+), 3 deletions(-) (limited to 'gcc/fortran/openmp.c') diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index 357a1e1..520a435 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -880,6 +880,7 @@ enum omp_mask2 OMP_CLAUSE_IF_PRESENT, OMP_CLAUSE_FINALIZE, OMP_CLAUSE_ATTACH, + OMP_CLAUSE_NOHOST, /* This must come last. */ OMP_MASK2_LAST }; @@ -2083,6 +2084,13 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, c->nogroup = needs_space = true; continue; } + if ((mask & OMP_CLAUSE_NOHOST) + && !c->nohost + && gfc_match ("nohost") == MATCH_YES) + { + c->nohost = needs_space = true; + continue; + } if ((mask & OMP_CLAUSE_NOTEMPORAL) && gfc_match_omp_variable_list ("nontemporal (", &c->lists[OMP_LIST_NONTEMPORAL], @@ -2607,7 +2615,8 @@ end: 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 @@ -2936,6 +2945,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; @@ -3012,6 +3022,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) { @@ -3024,6 +3035,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) { @@ -3037,7 +3055,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; @@ -3047,6 +3067,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; @@ -3061,8 +3082,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; @@ -3073,6 +3096,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. */ -- cgit v1.1 From 432de08498142d2266c0fb05f2c555a7f1e10ddd Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Thu, 12 Aug 2021 15:48:28 +0200 Subject: OpenMP 5.1: Add proc-bind 'primary' support In OpenMP 5.1 "master thread" was changed to "primary thread" and the proc_bind clause and the OMP_PROC_BIND environment variable now take 'primary' as argument as alias for 'master', while the latter is deprecated. This commit accepts 'primary' and adds the named constant omp_proc_bind_primary and changes 'master thread' in the documentation; however, given that not even OpenMP 5.0 is fully supported, omp_display_env and the dumps currently still output 'master' and there is no deprecation warning when using the 'master' in the proc_bind clause. gcc/c/ChangeLog: * c-parser.c (c_parser_omp_clause_proc_bind): Accept 'primary' as alias for 'master'. gcc/cp/ChangeLog: * parser.c (cp_parser_omp_clause_proc_bind): Accept 'primary' as alias for 'master'. gcc/fortran/ChangeLog: * gfortran.h (gfc_omp_proc_bind_kind): Add OMP_PROC_BIND_PRIMARY. * dump-parse-tree.c (show_omp_clauses): Add TODO comment to change 'master' to 'primary' in proc_bind for OpenMP 5.1. * intrinsic.texi (OMP_LIB): Mention OpenMP 5.1; add omp_proc_bind_primary. * openmp.c (gfc_match_omp_clauses): Accept 'primary' as alias for 'master'. * trans-openmp.c (gfc_trans_omp_clauses): Handle OMP_PROC_BIND_PRIMARY. gcc/ChangeLog: * tree-core.h (omp_clause_proc_bind_kind): Add OMP_CLAUSE_PROC_BIND_PRIMARY. * tree-pretty-print.c (dump_omp_clause): Add TODO comment to change 'master' to 'primary' in proc_bind for OpenMP 5.1. libgomp/ChangeLog: * env.c (parse_bind_var): Accept 'primary' as alias for 'master'. (omp_display_env): Add TODO comment to change 'master' to 'primary' in proc_bind for OpenMP 5.1. * libgomp.texi: Change 'master thread' to 'primary thread' in line with OpenMP 5.1. (omp_get_proc_bind): Add omp_proc_bind_primary and note that omp_proc_bind_master is an alias of it. (OMP_PROC_BIND): Mention 'PRIMARY'. * omp.h.in (__GOMP_DEPRECATED_5_1): Define. (omp_proc_bind_primary): Add. (omp_proc_bind_master): Deprecate for OpenMP 5.1. * omp_lib.f90.in (omp_proc_bind_primary): Add. (omp_proc_bind_master): Deprecate for OpenMP 5.1. * omp_lib.h.in (omp_proc_bind_primary): Add. * testsuite/libgomp.c/affinity-1.c: Check that 'primary' works and is identical to 'master'. gcc/testsuite/ChangeLog: * c-c++-common/gomp/pr61486-2.c: Duplicate one proc_bind(master) testcase and test proc_bind(primary) instead. * gfortran.dg/gomp/affinity-1.f90: Likewise. --- gcc/fortran/openmp.c | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) (limited to 'gcc/fortran/openmp.c') diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index 520a435..ec55865 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -2231,7 +2231,10 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, if ((mask & OMP_CLAUSE_PROC_BIND) && c->proc_bind == OMP_PROC_BIND_UNKNOWN) { - if (gfc_match ("proc_bind ( master )") == MATCH_YES) + /* Primary is new and master is deprecated in OpenMP 5.1. */ + if (gfc_match ("proc_bind ( primary )") == MATCH_YES) + c->proc_bind = OMP_PROC_BIND_MASTER; + else if (gfc_match ("proc_bind ( master )") == MATCH_YES) c->proc_bind = OMP_PROC_BIND_MASTER; else if (gfc_match ("proc_bind ( spread )") == MATCH_YES) c->proc_bind = OMP_PROC_BIND_SPREAD; -- cgit v1.1 From 53d5b59cb3b417ab8293702aacc75a9bbb3ead78 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Mon, 16 Aug 2021 09:26:26 +0200 Subject: Fortran/OpenMP: Add support for OpenMP 5.1 masked construct Commit r12-2891-gd0befed793b94f3f407be44e6f69f81a02f5f073 added C/C++ support for the masked construct. This patch extends it to Fortran. gcc/fortran/ChangeLog: * dump-parse-tree.c (show_omp_clauses): Handle 'filter' clause. (show_omp_node, show_code_node): Handle (combined) omp masked construct. * frontend-passes.c (gfc_code_walker): Likewise. * gfortran.h (enum gfc_statement): Add ST_OMP_*_MASKED*. (enum gfc_exec_op): Add EXEC_OMP_*_MASKED*. * match.h (gfc_match_omp_masked, gfc_match_omp_masked_taskloop, gfc_match_omp_masked_taskloop_simd, gfc_match_omp_parallel_masked, gfc_match_omp_parallel_masked_taskloop, gfc_match_omp_parallel_masked_taskloop_simd): New prototypes. * openmp.c (enum omp_mask1): Add OMP_CLAUSE_FILTER. (gfc_match_omp_clauses): Match it. (OMP_MASKED_CLAUSES, gfc_match_omp_parallel_masked, gfc_match_omp_parallel_masked_taskloop, gfc_match_omp_parallel_masked_taskloop_simd, gfc_match_omp_masked, gfc_match_omp_masked_taskloop, gfc_match_omp_masked_taskloop_simd): New. (resolve_omp_clauses): Resolve filter clause. (gfc_resolve_omp_parallel_blocks, resolve_omp_do, omp_code_to_statement, gfc_resolve_omp_directive): Handle omp masked constructs. * parse.c (decode_omp_directive, case_exec_markers, gfc_ascii_statement, parse_omp_do, parse_omp_structured_block, parse_executable): Likewise. * resolve.c (gfc_resolve_blocks, gfc_resolve_code): Likewise. * st.c (gfc_free_statement): Likewise. * trans-openmp.c (gfc_trans_omp_clauses): Handle filter clause. (GFC_OMP_SPLIT_MASKED, GFC_OMP_MASK_MASKED): New enum values. (gfc_trans_omp_masked): New. (gfc_split_omp_clauses): Handle combined masked directives. (gfc_trans_omp_master_taskloop): Rename to ... (gfc_trans_omp_master_masked_taskloop): ... this; handle also combined masked directives. (gfc_trans_omp_parallel_master): Rename to ... (gfc_trans_omp_parallel_master_masked): ... this; handle combined masked directives. (gfc_trans_omp_directive): Handle EXEC_OMP_*_MASKED*. * trans.c (trans_code): Likewise. libgomp/ChangeLog: * testsuite/libgomp.fortran/masked-1.f90: New test. gcc/testsuite/ChangeLog: * gfortran.dg/gomp/masked-1.f90: New test. * gfortran.dg/gomp/masked-2.f90: New test. * gfortran.dg/gomp/masked-3.f90: New test. * gfortran.dg/gomp/masked-combined-1.f90: New test. * gfortran.dg/gomp/masked-combined-2.f90: New test. --- gcc/fortran/openmp.c | 98 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 98 insertions(+) (limited to 'gcc/fortran/openmp.c') diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index ec55865..1bce43c 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -847,6 +847,7 @@ enum omp_mask1 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_NOWAIT, /* This must come last. */ OMP_MASK1_LAST @@ -1772,6 +1773,10 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, } break; case 'f': + if ((mask & OMP_CLAUSE_FILTER) + && c->filter == NULL + && gfc_match ("filter ( %e )", &c->filter) == MATCH_YES) + continue; if ((mask & OMP_CLAUSE_FINAL) && c->final_expr == NULL && gfc_match ("final ( %e )", &c->final_expr) == MATCH_YES) @@ -3199,6 +3204,8 @@ 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)) static match @@ -4158,6 +4165,31 @@ 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); @@ -4704,6 +4736,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) @@ -5254,6 +5307,7 @@ 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: @@ -5268,10 +5322,12 @@ 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 @@ -5290,11 +5346,13 @@ 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; @@ -6060,9 +6118,13 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, && (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 @@ -6322,6 +6384,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"); @@ -6984,8 +7048,12 @@ 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: @@ -7133,6 +7201,13 @@ resolve_omp_do (gfc_code *code) 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; @@ -7140,6 +7215,11 @@ resolve_omp_do (gfc_code *code) 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"; @@ -7302,6 +7382,12 @@ 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: @@ -7316,6 +7402,12 @@ 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: @@ -7822,8 +7914,12 @@ gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns) 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: @@ -7846,8 +7942,10 @@ gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns) resolve_omp_do (code); break; case EXEC_OMP_CANCEL: + 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_SECTIONS: -- cgit v1.1 From f8d535f3fec81c1cc84e22df5500e693544ec65b Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Tue, 17 Aug 2021 15:50:11 +0200 Subject: Fortran: Implement OpenMP 5.1 scope construct Fortran version to commit e45483c7c4badc4bf2d6ced22360ce1ab172967f, which implemented OpenMP's scope construct for C and C++. Most testcases are based on the C testcases; it also contains some testcases which existed previously but had no Fortran equivalent. gcc/fortran/ChangeLog: * dump-parse-tree.c (show_omp_node, show_code_node): Handle EXEC_OMP_SCOPE. * gfortran.h (enum gfc_statement): Add ST_OMP_(END_)SCOPE. (enum gfc_exec_op): Add EXEC_OMP_SCOPE. * match.h (gfc_match_omp_scope): New. * openmp.c (OMP_SCOPE_CLAUSES): Define (gfc_match_omp_scope): New. (gfc_match_omp_cancellation_point, gfc_match_omp_end_nowait): Improve error diagnostic. (omp_code_to_statement): Handle ST_OMP_SCOPE. (gfc_resolve_omp_directive): Handle EXEC_OMP_SCOPE. * parse.c (decode_omp_directive, next_statement, gfc_ascii_statement, parse_omp_structured_block, parse_executable): Handle OpenMP's scope construct. * resolve.c (gfc_resolve_blocks): Likewise * st.c (gfc_free_statement): Likewise * trans-openmp.c (gfc_trans_omp_scope): New. (gfc_trans_omp_directive): Call it. * trans.c (trans_code): handle EXEC_OMP_SCOPE. libgomp/ChangeLog: * testsuite/libgomp.fortran/scope-1.f90: New test. * testsuite/libgomp.fortran/task-reduction-16.f90: New test. gcc/testsuite/ChangeLog: * gfortran.dg/gomp/scan-1.f90: * gfortran.dg/gomp/cancel-1.f90: New test. * gfortran.dg/gomp/cancel-4.f90: New test. * gfortran.dg/gomp/loop-4.f90: New test. * gfortran.dg/gomp/nesting-1.f90: New test. * gfortran.dg/gomp/nesting-2.f90: New test. * gfortran.dg/gomp/nesting-3.f90: New test. * gfortran.dg/gomp/nowait-1.f90: New test. * gfortran.dg/gomp/reduction-task-1.f90: New test. * gfortran.dg/gomp/reduction-task-2.f90: New test. * gfortran.dg/gomp/reduction-task-2a.f90: New test. * gfortran.dg/gomp/reduction-task-3.f90: New test. * gfortran.dg/gomp/scope-1.f90: New test. * gfortran.dg/gomp/scope-2.f90: New test. --- gcc/fortran/openmp.c | 23 +++++++++++++++++++++-- 1 file changed, 21 insertions(+), 2 deletions(-) (limited to 'gcc/fortran/openmp.c') diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index 1bce43c..9675b65 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -3150,6 +3150,8 @@ cleanup: #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) @@ -4488,6 +4490,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); @@ -4975,7 +4984,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 " @@ -4998,7 +5011,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; @@ -7448,6 +7464,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: @@ -7948,6 +7966,7 @@ gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns) 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: -- cgit v1.1 From f74433e70ae94a3b5291e45fea488b1cfdee4a34 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Wed, 18 Aug 2021 15:21:18 +0200 Subject: Fortran: Add OpenMP's nothing directive support Fortran version of commit 5079b7781a2c506dcdfb241347d74c7891268225 gcc/fortran/ChangeLog: * match.h (gfc_match_omp_nothing): New. * openmp.c (gfc_match_omp_nothing): New. * parse.c (decode_omp_directive): Match 'nothing' directive. gcc/testsuite/ChangeLog: * gfortran.dg/nothing-1.f90: New test. * gfortran.dg/nothing-2.f90: New test. --- gcc/fortran/openmp.c | 11 +++++++++++ 1 file changed, 11 insertions(+) (limited to 'gcc/fortran/openmp.c') diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index 9675b65..fd219dc 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -4797,6 +4797,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) -- cgit v1.1 From 77167196fe8cf840a69913e7739d39ae0df2b074 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Fri, 20 Aug 2021 12:12:51 +0200 Subject: Fortran: Add OpenMP's error directive Fortran part to the C/C++ implementation of commit r12-3040-g0d973c0a0d90a0a302e7eda1a4d9709be3c5b102 gcc/fortran/ChangeLog: * dump-parse-tree.c (show_omp_clauses): Handle 'at', 'severity' and 'message' clauses. (show_omp_node, show_code_node): Handle EXEC_OMP_ERROR. * gfortran.h (gfc_statement): Add ST_OMP_ERROR. (gfc_omp_severity_type, gfc_omp_at_type): New. (gfc_omp_clauses): Add 'at', 'severity' and 'message' clause; use more bitfields + ENUM_BITFIELD. (gfc_exec_op): Add EXEC_OMP_ERROR. * match.h (gfc_match_omp_error): New. * openmp.c (enum omp_mask1): Add OMP_CLAUSE_(AT,SEVERITY,MESSAGE). (gfc_match_omp_clauses): Handle new clauses. (OMP_ERROR_CLAUSES, gfc_match_omp_error): New. (resolve_omp_clauses): Resolve new clauses. (omp_code_to_statement, gfc_resolve_omp_directive): Handle EXEC_OMP_ERROR. * parse.c (decode_omp_directive, next_statement, gfc_ascii_statement): Handle 'omp error'. * resolve.c (gfc_resolve_blocks): Likewise. * st.c (gfc_free_statement): Likewise. * trans-openmp.c (gfc_trans_omp_error): Likewise. (gfc_trans_omp_directive): Likewise. * trans.c (trans_code): Likewise. libgomp/ChangeLog: * testsuite/libgomp.fortran/error-1.f90: New test. gcc/testsuite/ChangeLog: * gfortran.dg/gomp/error-1.f90: New test. * gfortran.dg/gomp/error-2.f90: New test. * gfortran.dg/gomp/error-3.f90: New test. --- gcc/fortran/openmp.c | 124 ++++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 122 insertions(+), 2 deletions(-) (limited to 'gcc/fortran/openmp.c') diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index fd219dc..2380866 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -28,6 +28,7 @@ along with GCC; see the file COPYING3. If not see #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 '!'. */ @@ -848,6 +849,9 @@ enum omp_mask1 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 @@ -1293,6 +1297,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 @@ -1392,6 +1397,22 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, } continue; } + if ((mask & OMP_CLAUSE_AT) + && c->at == OMP_AT_UNSET + && gfc_match ("at ( ") == MATCH_YES) + { + 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) @@ -1616,7 +1637,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, else gfc_error ("DEFAULTMAP at %C but prior DEFAULTMAP for " "category %s", pcategory); - goto end; + goto error; } } c->defaultmap[category] = behavior; @@ -2074,6 +2095,10 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, c->mergeable = needs_space = true; continue; } + if ((mask & OMP_CLAUSE_MESSAGE) + && !c->message + && gfc_match ("message ( %e )", &c->message) == MATCH_YES) + continue; break; case 'n': if ((mask & OMP_CLAUSE_NO_CREATE) @@ -2402,6 +2427,22 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, c->simd = needs_space = true; continue; } + if ((mask & OMP_CLAUSE_SEVERITY) + && c->severity == OMP_SEVERITY_UNSET + && gfc_match ("severity ( ") == MATCH_YES) + { + 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) @@ -2553,7 +2594,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, } end: - if (gfc_match_omp_eos () != MATCH_YES) + if (error || gfc_match_omp_eos () != MATCH_YES) { if (!gfc_error_flag_test ()) gfc_error ("Failed to match clause at %C"); @@ -2563,6 +2604,10 @@ end: *cp = c; return MATCH_YES; + +error: + error = true; + goto end; } @@ -3208,6 +3253,9 @@ cleanup: | 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 @@ -3432,6 +3480,66 @@ gfc_match_omp_target_parallel_loop (void) 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; @@ -6463,6 +6571,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 @@ -7461,6 +7578,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: @@ -7971,6 +8090,7 @@ gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns) 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: -- cgit v1.1 From d4de7e32eff0a6363defa50b052d7a30548b6552 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Mon, 23 Aug 2021 15:13:30 +0200 Subject: Fortran/OpenMP: strict modifier on grainsize/num_tasks This patch adds support for the 'strict' modifier on grainsize/num_tasks clauses, an OpenMP 5.1 feature supported in C/C++ since commit r12-3066-g3bc75533d1f87f0617be6c1af98804f9127ec637 gcc/fortran/ChangeLog: * dump-parse-tree.c (show_omp_clauses): Handle 'strict' modifier on grainsize/num_tasks * gfortran.h (gfc_omp_clauses): Add grainsize_strict and num_tasks_strict. * trans-openmp.c (gfc_trans_omp_clauses, gfc_split_omp_clauses): Handle 'strict' modifier on grainsize/num_tasks. * openmp.c (gfc_match_omp_clauses): Likewise. libgomp/ChangeLog: * testsuite/libgomp.fortran/taskloop-4-a.f90: New test. * testsuite/libgomp.fortran/taskloop-4.f90: New test. * testsuite/libgomp.fortran/taskloop-5-a.f90: New test. * testsuite/libgomp.fortran/taskloop-5.f90: New test. --- gcc/fortran/openmp.c | 20 ++++++++++++++++---- 1 file changed, 16 insertions(+), 4 deletions(-) (limited to 'gcc/fortran/openmp.c') diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index 2380866..1aae35a 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -1839,8 +1839,14 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, } if ((mask & OMP_CLAUSE_GRAINSIZE) && c->grainsize == NULL - && gfc_match ("grainsize ( %e )", &c->grainsize) == MATCH_YES) - continue; + && gfc_match ("grainsize ( ") == MATCH_YES) + { + 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) @@ -2148,8 +2154,14 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, continue; if ((mask & OMP_CLAUSE_NUM_TASKS) && c->num_tasks == NULL - && gfc_match ("num_tasks ( %e )", &c->num_tasks) == MATCH_YES) - continue; + && gfc_match ("num_tasks ( ") == MATCH_YES) + { + 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) -- cgit v1.1 From 57a9e63c96fca56299d7a52f6712e2d9290c197e Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Mon, 23 Aug 2021 15:18:37 +0200 Subject: Fortran/OpenMP: Improve duplicate errors gcc/fortran/ChangeLog: * openmp.c (gfc_match_dupl_check, gfc_match_dupl_memorder, gfc_match_dupl_atomic): New. (gfc_match_omp_clauses): Use them; remove duplicate 'release'/'relaxed' clause matching; improve error dignostic for 'default'. gcc/testsuite/ChangeLog: * gfortran.dg/goacc/asyncwait-1.f95: Update dg-error. * gfortran.dg/goacc/default-2.f: Update dg-error. * gfortran.dg/goacc/enter-exit-data.f95: Update dg-error. * gfortran.dg/goacc/if.f95: Update dg-error. * gfortran.dg/goacc/parallel-kernels-clauses.f95: Update dg-error. * gfortran.dg/goacc/routine-6.f90: Update dg-error. * gfortran.dg/goacc/sie.f95: Update dg-error. * gfortran.dg/goacc/update-if_present-2.f90: Update dg-error. * gfortran.dg/gomp/cancel-2.f90: Update dg-error. * gfortran.dg/gomp/declare-simd-1.f90: Update dg-error. * gfortran.dg/gomp/error-3.f90: Update dg-error. * gfortran.dg/gomp/loop-2.f90: Update dg-error. * gfortran.dg/gomp/masked-2.f90: Update dg-error. --- gcc/fortran/openmp.c | 627 +++++++++++++++++++++++++++++++++------------------ 1 file changed, 403 insertions(+), 224 deletions(-) (limited to 'gcc/fortran/openmp.c') diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index 1aae35a..715fd32 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -1289,6 +1289,64 @@ gfc_match_omp_clause_reduction (char pc, gfc_omp_clauses *c, bool openacc, 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. */ @@ -1323,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': @@ -1352,17 +1411,23 @@ 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; @@ -1371,7 +1436,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, && gfc_match ("affinity ( ") == MATCH_YES) { gfc_namespace *ns_iter = NULL, *ns_curr = gfc_current_ns; - match m = gfc_match_iterator (&ns_iter, true); + m = gfc_match_iterator (&ns_iter, true); if (m == MATCH_ERROR) break; if (m == MATCH_YES && gfc_match (" : ") != MATCH_YES) @@ -1398,9 +1463,11 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, continue; } if ((mask & OMP_CLAUSE_AT) - && c->at == OMP_AT_UNSET - && gfc_match ("at ( ") == MATCH_YES) + && (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) @@ -1414,11 +1481,12 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, 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; @@ -1436,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; @@ -1452,9 +1522,11 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, break; case 'b': if ((mask & OMP_CLAUSE_BIND) - && c->bind == OMP_BIND_UNSET - && gfc_match ("bind ( ") == MATCH_YES) + && (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) @@ -1472,34 +1544,36 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, 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 @@ -1539,28 +1613,6 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, continue; break; case 'd': - if ((mask & OMP_CLAUSE_DEFAULT) - && c->default_sharing == OMP_DEFAULT_UNKNOWN) - { - if (gfc_match ("default ( none )") == MATCH_YES) - c->default_sharing = OMP_DEFAULT_NONE; - else if (openacc) - { - if (gfc_match ("default ( present )") == MATCH_YES) - c->default_sharing = OMP_DEFAULT_PRESENT; - } - else - { - if (gfc_match ("default ( firstprivate )") == MATCH_YES) - c->default_sharing = OMP_DEFAULT_FIRSTPRIVATE; - else if (gfc_match ("default ( private )") == MATCH_YES) - c->default_sharing = OMP_DEFAULT_PRIVATE; - else if (gfc_match ("default ( shared )") == MATCH_YES) - c->default_sharing = OMP_DEFAULT_SHARED; - } - if (c->default_sharing != OMP_DEFAULT_UNKNOWN) - continue; - } if ((mask & OMP_CLAUSE_DEFAULTMAP) && gfc_match ("defaultmap ( ") == MATCH_YES) { @@ -1645,6 +1697,43 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, break; continue; } + if ((mask & OMP_CLAUSE_DEFAULT) + && (m = gfc_match_dupl_check (c->default_sharing + == OMP_DEFAULT_UNKNOWN, "default", + true)) != MATCH_NO) + { + if (m == MATCH_ERROR) + goto error; + if (gfc_match ("none") == MATCH_YES) + c->default_sharing = OMP_DEFAULT_NONE; + else if (openacc) + { + if (gfc_match ("present") == MATCH_YES) + c->default_sharing = OMP_DEFAULT_PRESENT; + } + else + { + if (gfc_match ("firstprivate") == MATCH_YES) + c->default_sharing = OMP_DEFAULT_FIRSTPRIVATE; + else if (gfc_match ("private") == MATCH_YES) + c->default_sharing = OMP_DEFAULT_PRIVATE; + else if (gfc_match ("shared") == MATCH_YES) + c->default_sharing = OMP_DEFAULT_SHARED; + } + 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) && gfc_match ("delete ( ") == MATCH_YES && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP], @@ -1660,7 +1749,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, break; if (m_it == MATCH_YES && gfc_match (" , ") != MATCH_YES) break; - match m = MATCH_YES; + m = MATCH_YES; gfc_omp_depend_op depend_op = OMP_DEPEND_OUT; if (gfc_match ("inout") == MATCH_YES) depend_op = OMP_DEPEND_INOUT; @@ -1736,9 +1825,13 @@ 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, + &c->device)) != MATCH_NO) + { + if (m == MATCH_ERROR) + goto error; + continue; + } if ((mask & OMP_CLAUSE_DEVICE) && openacc && gfc_match ("device ( ") == MATCH_YES @@ -1779,7 +1872,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) @@ -1795,17 +1888,27 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, break; case 'f': if ((mask & OMP_CLAUSE_FILTER) - && c->filter == NULL - && gfc_match ("filter ( %e )", &c->filter) == MATCH_YES) - continue; + && (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; @@ -1823,11 +1926,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; @@ -1838,9 +1942,11 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, continue; } if ((mask & OMP_CLAUSE_GRAINSIZE) - && c->grainsize == NULL - && gfc_match ("grainsize ( ") == MATCH_YES) + && (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) @@ -1850,9 +1956,13 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, 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], @@ -1861,24 +1971,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 @@ -1887,34 +2009,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; @@ -2095,16 +2212,23 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, 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) - && !c->message - && gfc_match ("message ( %e )", &c->message) == MATCH_YES) - continue; + && (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) @@ -2114,16 +2238,19 @@ 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) - && !c->nohost - && gfc_match ("nohost") == MATCH_YES) + && (m = gfc_match_dupl_check (!c->nohost, "nohost")) != MATCH_NO) { + if (m == MATCH_ERROR) + goto error; c->nohost = needs_space = true; continue; } @@ -2133,29 +2260,38 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, 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 ( ") == MATCH_YES) + && (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) @@ -2163,19 +2299,30 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, 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) @@ -2186,11 +2333,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) @@ -2262,35 +2411,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) { - /* Primary is new and master is deprecated in OpenMP 5.1. */ - if (gfc_match ("proc_bind ( primary )") == MATCH_YES) - c->proc_bind = OMP_PROC_BIND_MASTER; - else 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; @@ -2300,33 +2460,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; @@ -2334,13 +2484,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 @@ -2387,7 +2544,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); @@ -2408,17 +2565,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; @@ -2429,20 +2590,27 @@ 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) - && c->severity == OMP_SEVERITY_UNSET - && gfc_match ("severity ( ") == MATCH_YES) + && (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) @@ -2462,14 +2630,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; } @@ -2497,16 +2671,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; @@ -2531,21 +2709,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; @@ -2555,12 +2736,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 @@ -2578,24 +2756,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; -- cgit v1.1 From 03be3cfeef7b3811acb6c4a8da2fc5c1e25d3e4c Mon Sep 17 00:00:00 2001 From: Marcel Vollweiler Date: Tue, 31 Aug 2021 06:09:40 -0700 Subject: Add support for device-modifiers for 'omp target device'. 'device_num' and 'ancestor' are now parsed on target device constructs for C, C++, and Fortran (see OpenMP specification 5.0, p. 170). When 'ancestor' is used, then 'sorry, not supported' is output. Moreover, the restrictions for 'ancestor' are implemented (see OpenMP specification 5.0, p. 174f). gcc/c/ChangeLog: * c-parser.c (c_parser_omp_clause_device): Parse device-modifiers 'device_num' and 'ancestor' in 'target device' clauses. gcc/cp/ChangeLog: * parser.c (cp_parser_omp_clause_device): Parse device-modifiers 'device_num' and 'ancestor' in 'target device' clauses. * semantics.c (finish_omp_clauses): Error handling. Constant device ids must evaluate to '1' if 'ancestor' is used. gcc/fortran/ChangeLog: * gfortran.h: Add variable for 'ancestor' in struct gfc_omp_clauses. * openmp.c (gfc_match_omp_clauses): Parse device-modifiers 'device_num' and 'ancestor' in 'target device' clauses. * trans-openmp.c (gfc_trans_omp_clauses): Set OMP_CLAUSE_DEVICE_ANCESTOR. gcc/ChangeLog: * gimplify.c (gimplify_scan_omp_clauses): Error handling. 'ancestor' only allowed on target constructs and only with particular other clauses. * omp-expand.c (expand_omp_target): Output of 'sorry, not supported' if 'ancestor' is used. * omp-low.c (check_omp_nesting_restrictions): Error handling. No nested OpenMP structs when 'ancestor' is used. (scan_omp_1_stmt): No usage of OpenMP runtime routines in a target region when 'ancestor' is used. * tree-pretty-print.c (dump_omp_clause): Append 'ancestor'. * tree.h (OMP_CLAUSE_DEVICE_ANCESTOR): Define macro. gcc/testsuite/ChangeLog: * c-c++-common/gomp/target-device-1.c: New test. * c-c++-common/gomp/target-device-2.c: New test. * c-c++-common/gomp/target-device-ancestor-1.c: New test. * c-c++-common/gomp/target-device-ancestor-2.c: New test. * c-c++-common/gomp/target-device-ancestor-3.c: New test. * c-c++-common/gomp/target-device-ancestor-4.c: New test. * gfortran.dg/gomp/target-device-1.f90: New test. * gfortran.dg/gomp/target-device-2.f90: New test. * gfortran.dg/gomp/target-device-ancestor-1.f90: New test. * gfortran.dg/gomp/target-device-ancestor-2.f90: New test. * gfortran.dg/gomp/target-device-ancestor-3.f90: New test. * gfortran.dg/gomp/target-device-ancestor-4.f90: New test. --- gcc/fortran/openmp.c | 47 +++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 45 insertions(+), 2 deletions(-) (limited to 'gcc/fortran/openmp.c') diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index 715fd32..64ecd54 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -1825,11 +1825,54 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, continue; if ((mask & OMP_CLAUSE_DEVICE) && !openacc - && (m = gfc_match_dupl_check (!c->device, "device", true, - &c->device)) != MATCH_NO) + && ((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 ("% device modifier not " + "preceded by % directive " + "with % 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 % 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 % or % at %C"); + break; + } continue; } if ((mask & OMP_CLAUSE_DEVICE) -- cgit v1.1 From ba1cc6956b956eb5b92c45af79a8b1fe426ec4d3 Mon Sep 17 00:00:00 2001 From: Marcel Vollweiler Date: Tue, 7 Sep 2021 03:46:28 -0700 Subject: C, C++, Fortran, OpenMP: Add support for 'flush seq_cst' construct. This patch adds support for the 'seq_cst' memory order clause on the 'flush' directive which was introduced in OpenMP 5.1. gcc/c-family/ChangeLog: * c-omp.c (c_finish_omp_flush): Handle MEMMODEL_SEQ_CST. gcc/c/ChangeLog: * c-parser.c (c_parser_omp_flush): Parse 'seq_cst' clause on 'flush' directive. gcc/cp/ChangeLog: * parser.c (cp_parser_omp_flush): Parse 'seq_cst' clause on 'flush' directive. * semantics.c (finish_omp_flush): Handle MEMMODEL_SEQ_CST. gcc/fortran/ChangeLog: * openmp.c (gfc_match_omp_flush): Parse 'seq_cst' clause on 'flush' directive. * trans-openmp.c (gfc_trans_omp_flush): Handle OMP_MEMORDER_SEQ_CST. gcc/testsuite/ChangeLog: * c-c++-common/gomp/flush-1.c: Add test case for 'seq_cst'. * c-c++-common/gomp/flush-2.c: Add test case for 'seq_cst'. * g++.dg/gomp/attrs-1.C: Adapt test to handle all flush clauses. * g++.dg/gomp/attrs-2.C: Adapt test to handle all flush clauses. * gfortran.dg/gomp/flush-1.f90: Add test case for 'seq_cst'. * gfortran.dg/gomp/flush-2.f90: Add test case for 'seq_cst'. --- gcc/fortran/openmp.c | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) (limited to 'gcc/fortran/openmp.c') diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index 64ecd54..a64b7f5 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -3782,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; @@ -3790,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 (); -- cgit v1.1