0e3702f8da
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.
15 lines
471 B
Fortran
15 lines
471 B
Fortran
! { 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"} }
|