OpenMP/Fortran: Reject declarations between target + teams While commit r14-2754-g2e31fe431b08b0302e1fa8a1c18ee51adafd41df detected executable statements, declarations do not show up as executable statements. Hence, we now check whether the first statement after TARGET is TEAMS - such that we can detect data statements like type or variable declarations. Fortran semantics ensures that only executable directives/statemens can come after '!$omp end teams' such that those can be detected with the previous check. Note that statements returning ST_NONE such as 'omp nothing' or 'omp error at(compilation)' will still slip through. PR fortran/110725 PR middle-end/71065 gcc/fortran/ChangeLog: * gfortran.h (gfc_omp_clauses): Add target_first_st_is_teams. * parse.cc (parse_omp_structured_block): Set it if the first statement in the structured block of a TARGET is TEAMS or a combined/composite starting with TEAMS. * openmp.cc (resolve_omp_target): Also show an error for contains_teams_construct without target_first_st_is_teams. gcc/testsuite/ChangeLog: * gfortran.dg/gomp/teams-6.f90: New test. gcc/fortran/gfortran.h | 2 +- gcc/fortran/openmp.cc | 13 ++--- gcc/fortran/parse.cc | 25 ++++++++-- gcc/testsuite/gfortran.dg/gomp/teams-6.f90 | 78 ++++++++++++++++++++++++++++++ 4 files changed, 108 insertions(+), 10 deletions(-) diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 577ef807af7..9a00e6dea6f 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -1575,7 +1575,7 @@ typedef struct gfc_omp_clauses unsigned order_unconstrained:1, order_reproducible:1, capture:1; unsigned grainsize_strict:1, num_tasks_strict:1, compare:1, weak:1; unsigned non_rectangular:1, order_concurrent:1; - unsigned contains_teams_construct:1; + unsigned contains_teams_construct:1, target_first_st_is_teams:1; ENUM_BITFIELD (gfc_omp_sched_kind) sched_kind:3; ENUM_BITFIELD (gfc_omp_device_type) device_type:2; ENUM_BITFIELD (gfc_omp_memorder) memorder:3; diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc index 675011a18ce..52eeaf2d4da 100644 --- a/gcc/fortran/openmp.cc +++ b/gcc/fortran/openmp.cc @@ -10666,12 +10666,13 @@ resolve_omp_target (gfc_code *code) if (!code->ext.omp_clauses->contains_teams_construct) return; - if ((GFC_IS_TEAMS_CONSTRUCT (code->block->next->op) - && code->block->next->next == NULL) - || (code->block->next->op == EXEC_BLOCK - && code->block->next->next - && GFC_IS_TEAMS_CONSTRUCT (code->block->next->next->op) - && code->block->next->next->next == NULL)) + if (code->ext.omp_clauses->target_first_st_is_teams + && ((GFC_IS_TEAMS_CONSTRUCT (code->block->next->op) + && code->block->next->next == NULL) + || (code->block->next->op == EXEC_BLOCK + && code->block->next->next + && GFC_IS_TEAMS_CONSTRUCT (code->block->next->next->op) + && code->block->next->next->next == NULL))) return; gfc_code *c = code->block->next; while (c && !GFC_IS_TEAMS_CONSTRUCT (c->op)) diff --git a/gcc/fortran/parse.cc b/gcc/fortran/parse.cc index 011a39c3d04..aa6bb663def 100644 --- a/gcc/fortran/parse.cc +++ b/gcc/fortran/parse.cc @@ -5766,7 +5766,7 @@ parse_openmp_allocate_block (gfc_statement omp_st) static gfc_statement parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only) { - gfc_statement st, omp_end_st; + gfc_statement st, omp_end_st, first_st; gfc_code *cp, *np; gfc_state_data s; @@ -5857,7 +5857,7 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only) gfc_namespace *my_ns = NULL; gfc_namespace *my_parent = NULL; - st = next_statement (); + first_st = st = next_statement (); if (st == ST_BLOCK) { @@ -5876,9 +5876,28 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only) new_st.ext.block.ns = my_ns; new_st.ext.block.assoc = NULL; accept_statement (ST_BLOCK); - st = parse_spec (ST_NONE); + first_st = next_statement (); + st = parse_spec (first_st); } + if (omp_end_st == ST_OMP_END_TARGET) + switch (first_st) + { + case ST_OMP_TEAMS: + case ST_OMP_TEAMS_DISTRIBUTE: + case ST_OMP_TEAMS_DISTRIBUTE_SIMD: + case ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: + case ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + case ST_OMP_TEAMS_LOOP: + { + gfc_state_data *stk = gfc_state_stack->previous; + stk->tail->ext.omp_clauses->target_first_st_is_teams = true; + break; + } + default: + break; + } + do { if (workshare_stmts_only) diff --git a/gcc/testsuite/gfortran.dg/gomp/teams-6.f90 b/gcc/testsuite/gfortran.dg/gomp/teams-6.f90 new file mode 100644 index 00000000000..be453f27f40 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/teams-6.f90 @@ -0,0 +1,78 @@ +! { dg-do compile } + +! PR fortran/110725 +! PR middle-end/71065 + + +subroutine one +!$omp target ! { dg-error "OMP TARGET region at .1. with a nested TEAMS at .2. may not contain any other statement, declaration or directive outside of the single TEAMS construct" } +block + integer :: i ! <<< invalid: variable declaration + !$omp teams ! { dg-error "OMP TARGET region at .1. with a nested TEAMS at .2. may not contain any other statement, declaration or directive outside of the single TEAMS construct" } + i = 5 + !$omp end teams +end block + +!$omp target ! { dg-error "OMP TARGET region at .1. with a nested TEAMS at .2. may not contain any other statement, declaration or directive outside of the single TEAMS construct" } +block + type t ! <<< invalid: type declaration + end type t + !$omp teams ! { dg-error "OMP TARGET region at .1. with a nested TEAMS at .2. may not contain any other statement, declaration or directive outside of the single TEAMS construct" } + i = 5 + !$omp end teams +end block + +!$omp target + ! The following is invalid - but not detected as ST_NONE is returned: + !$omp error at(compilation) severity(warning) ! { dg-warning "OMP ERROR encountered" } + !$omp teams + i = 5 + !$omp end teams +!$omp end target + +!$omp target + ! The following is invalid - but not detected as ST_NONE is returned: + !$omp nothing ! <<< invalid: directive + !$omp teams + i = 5 + !$omp end teams +!$omp end target +end + + +subroutine two +!$omp target ! { dg-error "OMP TARGET region at .1. with a nested TEAMS at .2. may not contain any other statement, declaration or directive outside of the single TEAMS construct" } +block + integer :: i ! <<< invalid: variable declaration + !$omp teams distribute ! { dg-error "OMP TARGET region at .1. with a nested TEAMS at .2. may not contain any other statement, declaration or directive outside of the single TEAMS construct" } + do i = 1, 5 + end do + !$omp end teams distribute +end block + +!$omp target ! { dg-error "OMP TARGET region at .1. with a nested TEAMS at .2. may not contain any other statement, declaration or directive outside of the single TEAMS construct" } +block + type t ! <<< invalid: type declaration + end type t + !$omp teams distribute parallel do ! { dg-error "OMP TARGET region at .1. with a nested TEAMS at .2. may not contain any other statement, declaration or directive outside of the single TEAMS construct" } + do i = 1, 5 + end do +end block + +!$omp target + ! The following is invalid - but not detected as ST_NONE is returned: + !$omp error at(compilation) severity(warning) ! { dg-warning "OMP ERROR encountered" } + !$omp teams loop + do i = 5, 10 + end do +!$omp end target + +!$omp target + ! The following is invalid - but not detected as ST_NONE is returned: + !$omp nothing ! <<< invalid: directive + !$omp teams distribute simd + do i = -3, 5 + end do + !$omp end teams distribute simd +!$omp end target +end