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/dump-parse-tree.c | 3 +++
gcc/fortran/frontend-passes.c | 1 +
gcc/fortran/gfortran.h | 6 ++++--
gcc/fortran/match.h | 1 +
gcc/fortran/openmp.c | 11 ++++++++++
gcc/fortran/parse.c | 17 ++++++++++++++-
gcc/fortran/resolve.c | 9 ++++++--
gcc/fortran/st.c | 1 +
gcc/fortran/trans-openmp.c | 25 ++++++++++++++++++++++
gcc/fortran/trans.c | 1 +
.../gfortran.dg/gomp/parallel-master-1.f90 | 23 ++++++++++++++++++++
.../gfortran.dg/gomp/parallel-master-2.f90 | 9 ++++++++
.../testsuite/libgomp.fortran/parallel-master.f90 | 14 ++++++++++++
13 files changed, 116 insertions(+), 5 deletions(-)
@@ -1856,6 +1856,7 @@ show_omp_node (int level, gfc_code *c)
case EXEC_OMP_PARALLEL: name = "PARALLEL"; break;
case EXEC_OMP_PARALLEL_DO: name = "PARALLEL DO"; break;
case EXEC_OMP_PARALLEL_DO_SIMD: name = "PARALLEL DO SIMD"; break;
+ case EXEC_OMP_PARALLEL_MASTER: name = "PARALLEL MASTER"; break;
case EXEC_OMP_PARALLEL_SECTIONS: name = "PARALLEL SECTIONS"; break;
case EXEC_OMP_PARALLEL_WORKSHARE: name = "PARALLEL WORKSHARE"; break;
case EXEC_OMP_SCAN: name = "SCAN"; break;
@@ -1927,6 +1928,7 @@ show_omp_node (int level, gfc_code *c)
case EXEC_OMP_PARALLEL:
case EXEC_OMP_PARALLEL_DO:
case EXEC_OMP_PARALLEL_DO_SIMD:
+ case EXEC_OMP_PARALLEL_MASTER:
case EXEC_OMP_PARALLEL_SECTIONS:
case EXEC_OMP_PARALLEL_WORKSHARE:
case EXEC_OMP_SCAN:
@@ -3139,6 +3141,7 @@ show_code_node (int level, gfc_code *c)
case EXEC_OMP_PARALLEL:
case EXEC_OMP_PARALLEL_DO:
case EXEC_OMP_PARALLEL_DO_SIMD:
+ case EXEC_OMP_PARALLEL_MASTER:
case EXEC_OMP_PARALLEL_SECTIONS:
case EXEC_OMP_PARALLEL_WORKSHARE:
case EXEC_OMP_SCAN:
@@ -5542,6 +5542,7 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t codefn, walk_expr_fn_t exprfn,
case EXEC_OMP_PARALLEL:
case EXEC_OMP_PARALLEL_DO:
case EXEC_OMP_PARALLEL_DO_SIMD:
+ case EXEC_OMP_PARALLEL_MASTER:
case EXEC_OMP_PARALLEL_SECTIONS:
in_omp_workshare = false;
@@ -266,7 +266,8 @@ enum gfc_statement
ST_OMP_REQUIRES, ST_PROCEDURE, ST_GENERIC, ST_CRITICAL, ST_END_CRITICAL,
ST_GET_FCN_CHARACTERISTICS, ST_LOCK, ST_UNLOCK, ST_EVENT_POST,
ST_EVENT_WAIT, ST_FAIL_IMAGE, ST_FORM_TEAM, ST_CHANGE_TEAM,
- ST_END_TEAM, ST_SYNC_TEAM, ST_NONE
+ ST_END_TEAM, ST_SYNC_TEAM, ST_OMP_PARALLEL_MASTER,
+ ST_OMP_END_PARALLEL_MASTER, ST_NONE
};
/* Types of interfaces that we can have. Assignment interfaces are
@@ -2704,7 +2705,8 @@ enum gfc_exec_op
EXEC_OMP_TARGET_ENTER_DATA, EXEC_OMP_TARGET_EXIT_DATA,
EXEC_OMP_TARGET_PARALLEL, EXEC_OMP_TARGET_PARALLEL_DO,
EXEC_OMP_TARGET_PARALLEL_DO_SIMD, EXEC_OMP_TARGET_SIMD,
- EXEC_OMP_TASKLOOP, EXEC_OMP_TASKLOOP_SIMD, EXEC_OMP_SCAN, EXEC_OMP_DEPOBJ
+ EXEC_OMP_TASKLOOP, EXEC_OMP_TASKLOOP_SIMD, EXEC_OMP_SCAN, EXEC_OMP_DEPOBJ,
+ EXEC_OMP_PARALLEL_MASTER
};
typedef struct gfc_code
@@ -174,6 +174,7 @@ match gfc_match_omp_ordered_depend (void);
match gfc_match_omp_parallel (void);
match gfc_match_omp_parallel_do (void);
match gfc_match_omp_parallel_do_simd (void);
+match gfc_match_omp_parallel_master (void);
match gfc_match_omp_parallel_sections (void);
match gfc_match_omp_parallel_workshare (void);
match gfc_match_omp_requires (void);
@@ -3769,6 +3769,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)
{
@@ -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:
@@ -925,6 +925,8 @@ decode_omp_directive (void)
matchs ("end parallel do simd", gfc_match_omp_eos_error,
ST_OMP_END_PARALLEL_DO_SIMD);
matcho ("end parallel do", gfc_match_omp_eos_error, ST_OMP_END_PARALLEL_DO);
+ matcho ("end parallel master", gfc_match_omp_eos_error,
+ ST_OMP_END_PARALLEL_MASTER);
matcho ("end parallel sections", gfc_match_omp_eos_error,
ST_OMP_END_PARALLEL_SECTIONS);
matcho ("end parallel workshare", gfc_match_omp_eos_error,
@@ -990,6 +992,8 @@ decode_omp_directive (void)
matchs ("parallel do simd", gfc_match_omp_parallel_do_simd,
ST_OMP_PARALLEL_DO_SIMD);
matcho ("parallel do", gfc_match_omp_parallel_do, ST_OMP_PARALLEL_DO);
+ matcho ("parallel master", gfc_match_omp_parallel_master,
+ ST_OMP_PARALLEL_MASTER);
matcho ("parallel sections", gfc_match_omp_parallel_sections,
ST_OMP_PARALLEL_SECTIONS);
matcho ("parallel workshare", gfc_match_omp_parallel_workshare,
@@ -1605,7 +1609,7 @@ next_statement (void)
#define case_exec_markers case ST_DO: case ST_FORALL_BLOCK: \
case ST_IF_BLOCK: case ST_BLOCK: case ST_ASSOCIATE: \
case ST_WHERE_BLOCK: case ST_SELECT_CASE: case ST_SELECT_TYPE: \
- case ST_SELECT_RANK: case ST_OMP_PARALLEL: \
+ case ST_SELECT_RANK: case ST_OMP_PARALLEL: case ST_OMP_PARALLEL_MASTER: \
case ST_OMP_PARALLEL_SECTIONS: case ST_OMP_SECTIONS: case ST_OMP_ORDERED: \
case ST_OMP_CRITICAL: case ST_OMP_MASTER: case ST_OMP_SINGLE: \
case ST_OMP_DO: case ST_OMP_PARALLEL_DO: case ST_OMP_ATOMIC: \
@@ -2349,6 +2353,9 @@ gfc_ascii_statement (gfc_statement st)
case ST_OMP_END_PARALLEL_DO_SIMD:
p = "!$OMP END PARALLEL DO SIMD";
break;
+ case ST_OMP_END_PARALLEL_MASTER:
+ p = "!$OMP END PARALLEL MASTER";
+ break;
case ST_OMP_END_PARALLEL_SECTIONS:
p = "!$OMP END PARALLEL SECTIONS";
break;
@@ -2443,6 +2450,9 @@ gfc_ascii_statement (gfc_statement st)
case ST_OMP_PARALLEL_DO_SIMD:
p = "!$OMP PARALLEL DO SIMD";
break;
+ case ST_OMP_PARALLEL_MASTER:
+ p = "!$OMP PARALLEL MASTER";
+ break;
case ST_OMP_PARALLEL_SECTIONS:
p = "!$OMP PARALLEL SECTIONS";
break;
@@ -5255,6 +5265,9 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only)
case ST_OMP_PARALLEL:
omp_end_st = ST_OMP_END_PARALLEL;
break;
+ case ST_OMP_PARALLEL_MASTER:
+ omp_end_st = ST_OMP_END_PARALLEL_MASTER;
+ break;
case ST_OMP_PARALLEL_SECTIONS:
omp_end_st = ST_OMP_END_PARALLEL_SECTIONS;
break;
@@ -5379,6 +5392,7 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only)
break;
case ST_OMP_PARALLEL:
+ case ST_OMP_PARALLEL_MASTER:
case ST_OMP_PARALLEL_SECTIONS:
parse_omp_structured_block (st, false);
break;
@@ -5580,6 +5594,7 @@ parse_executable (gfc_statement st)
break;
case ST_OMP_PARALLEL:
+ case ST_OMP_PARALLEL_MASTER:
case ST_OMP_PARALLEL_SECTIONS:
case ST_OMP_SECTIONS:
case ST_OMP_ORDERED:
@@ -10802,6 +10802,7 @@ gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns)
case EXEC_OMP_PARALLEL:
case EXEC_OMP_PARALLEL_DO:
case EXEC_OMP_PARALLEL_DO_SIMD:
+ case EXEC_OMP_PARALLEL_MASTER:
case EXEC_OMP_PARALLEL_SECTIONS:
case EXEC_OMP_PARALLEL_WORKSHARE:
case EXEC_OMP_SECTIONS:
@@ -11763,6 +11764,7 @@ gfc_resolve_code (gfc_code *code, gfc_namespace *ns)
case EXEC_OMP_PARALLEL:
case EXEC_OMP_PARALLEL_DO:
case EXEC_OMP_PARALLEL_DO_SIMD:
+ case EXEC_OMP_PARALLEL_MASTER:
case EXEC_OMP_PARALLEL_SECTIONS:
case EXEC_OMP_TARGET_PARALLEL:
case EXEC_OMP_TARGET_PARALLEL_DO:
@@ -12243,6 +12245,7 @@ start:
case EXEC_OMP_PARALLEL:
case EXEC_OMP_PARALLEL_DO:
case EXEC_OMP_PARALLEL_DO_SIMD:
+ case EXEC_OMP_PARALLEL_MASTER:
case EXEC_OMP_PARALLEL_SECTIONS:
case EXEC_OMP_PARALLEL_WORKSHARE:
omp_workshare_save = omp_workshare_flag;
@@ -230,6 +230,7 @@ gfc_free_statement (gfc_code *p)
case EXEC_OMP_PARALLEL:
case EXEC_OMP_PARALLEL_DO:
case EXEC_OMP_PARALLEL_DO_SIMD:
+ case EXEC_OMP_PARALLEL_MASTER:
case EXEC_OMP_PARALLEL_SECTIONS:
case EXEC_OMP_PARALLEL_WORKSHARE:
case EXEC_OMP_SCAN:
@@ -5553,6 +5553,28 @@ gfc_trans_omp_parallel_do_simd (gfc_code *code, stmtblock_t *pblock,
return gfc_finish_block (&block);
}
+static tree
+gfc_trans_omp_parallel_master (gfc_code *code)
+{
+ stmtblock_t block;
+ tree stmt, omp_clauses;
+
+ gfc_start_block (&block);
+ omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
+ code->loc);
+ pushlevel ();
+ stmt = gfc_trans_omp_master (code);
+ if (TREE_CODE (stmt) != BIND_EXPR)
+ stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
+ else
+ poplevel (0, 0);
+ stmt = build2_loc (gfc_get_location (&code->loc), OMP_PARALLEL,
+ void_type_node, stmt, omp_clauses);
+ OMP_PARALLEL_COMBINED (stmt) = 1;
+ gfc_add_expr_to_block (&block, stmt);
+ return gfc_finish_block (&block);
+}
+
static tree
gfc_trans_omp_parallel_sections (gfc_code *code)
{
@@ -6092,6 +6114,7 @@ gfc_trans_omp_workshare (gfc_code *code, gfc_omp_clauses *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_CRITICAL:
@@ -6273,6 +6296,8 @@ gfc_trans_omp_directive (gfc_code *code)
return gfc_trans_omp_parallel_do (code, NULL, NULL);
case EXEC_OMP_PARALLEL_DO_SIMD:
return gfc_trans_omp_parallel_do_simd (code, NULL, NULL);
+ case EXEC_OMP_PARALLEL_MASTER:
+ return gfc_trans_omp_parallel_master (code);
case EXEC_OMP_PARALLEL_SECTIONS:
return gfc_trans_omp_parallel_sections (code);
case EXEC_OMP_PARALLEL_WORKSHARE:
@@ -2174,6 +2174,7 @@ trans_code (gfc_code * code, tree cond)
case EXEC_OMP_PARALLEL:
case EXEC_OMP_PARALLEL_DO:
case EXEC_OMP_PARALLEL_DO_SIMD:
+ case EXEC_OMP_PARALLEL_MASTER:
case EXEC_OMP_PARALLEL_SECTIONS:
case EXEC_OMP_PARALLEL_WORKSHARE:
case EXEC_OMP_SECTIONS:
new file mode 100644
@@ -0,0 +1,23 @@
+! { dg-additional-options "-fdump-tree-original" }
+ implicit none
+ integer :: k, p, s, r, nth, t, f
+ logical(kind=2) l2
+ !$omp threadprivate (t)
+
+ external bar
+ !$omp parallel master default(none) private (k)
+ call bar (k)
+ !$omp end parallel master
+
+ !$omp parallel master private (p) firstprivate (f) if (parallel: l2) default(shared) &
+ !$omp& shared(s) reduction(+:r) num_threads (nth) proc_bind(spread) copyin(t)
+ !
+ !$omp end parallel master
+end
+
+! { dg-final { scan-tree-dump "omp parallel private\\(k\\) default\\(none\\)" "original" } }
+! { dg-final { scan-tree-dump-times "#pragma omp master" 1 "original" } }
+! { dg-final { scan-tree-dump "D.\[0-9\]+ = l2;" "original" } }
+! { dg-final { scan-tree-dump "D.\[0-9\]+ = nth;" "original" } }
+! { dg-final { scan-tree-dump "#pragma omp parallel private\\(p\\) firstprivate\\(f\\) shared\\(s\\) copyin\\(t\\) reduction\\(\\+:r\\) if\\(parallel:D.\[0-9\]+\\) num_threads\\(D.\[0-9\]+\\) default\\(shared\\) proc_bind\\(spread\\)" "original" } }
+
new file mode 100644
@@ -0,0 +1,9 @@
+ use iso_c_binding, only: c_intptr_t
+ implicit none (external, type)
+ integer, parameter :: omp_event_handle_kind = c_intptr_t
+ integer (kind=omp_event_handle_kind) :: x
+ !$omp parallel master default (none) ! { dg-message "enclosing 'parallel'" }
+ !$omp task detach (x) ! { dg-error "'x' not specified in enclosing 'parallel'" }
+ !$omp end task
+ !$omp end parallel master
+end
new file mode 100644
@@ -0,0 +1,14 @@
+! { dg-additional-options "-fdump-tree-original" }
+program main
+ use omp_lib
+ implicit none (type, external)
+ integer :: p, a(20)
+ !$omp parallel master num_threads(4) private (p) shared(a)
+ p = omp_get_thread_num ();
+ if (p /= 0) stop 1
+ a = 0
+ !$omp end parallel master
+end
+
+! { dg-final { scan-tree-dump "#pragma omp parallel private\\(p\\) shared\\(a\\) num_threads\\(4\\)" "original"} }
+! { dg-final { scan-tree-dump "#pragma omp master" "original"} }