OpenMP/Fortran: Reject not strictly nested target -> teams [PR110725, PR71065] OpenMP requires: "If a teams region is nested inside a target region, the corresponding target construct must not contain any statements, declarations or directives outside of the corresponding teams construct." Test for it! PR fortran/110725 PR middle-end/71065 gcc/fortran/ChangeLog: * gfortran.h (gfc_omp_clauses): Add contains_teams_construct. * openmp.cc (resolve_omp_target): New; check for teams nesting. (gfc_resolve_omp_directive): Call it. * parse.cc (decode_omp_directive): Set contains_teams_construct on enclosing ST_OMP_TARGET. gcc/testsuite/ChangeLog: * gfortran.dg/gomp/pr99226.f90: Update dg-error. * gfortran.dg/gomp/teams-5.f90: New test. gcc/fortran/gfortran.h | 1 + gcc/fortran/openmp.cc | 39 ++++++++- gcc/fortran/parse.cc | 33 ++++++++ gcc/testsuite/gfortran.dg/gomp/pr99226.f90 | 2 +- gcc/testsuite/gfortran.dg/gomp/teams-5.f90 | 127 +++++++++++++++++++++++++++++ 5 files changed, 200 insertions(+), 2 deletions(-) diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 6482a885211..577ef807af7 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -1575,6 +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; 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 05a697da071..675011a18ce 100644 --- a/gcc/fortran/openmp.cc +++ b/gcc/fortran/openmp.cc @@ -10653,6 +10653,41 @@ gfc_resolve_oacc_directive (gfc_code *code, gfc_namespace *ns ATTRIBUTE_UNUSED) } +static void +resolve_omp_target (gfc_code *code) +{ +#define GFC_IS_TEAMS_CONSTRUCT(op) \ + (op == EXEC_OMP_TEAMS \ + || op == EXEC_OMP_TEAMS_DISTRIBUTE \ + || op == EXEC_OMP_TEAMS_DISTRIBUTE_SIMD \ + || op == EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO \ + || op == EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD \ + || op == EXEC_OMP_TEAMS_LOOP) + + 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)) + return; + gfc_code *c = code->block->next; + while (c && !GFC_IS_TEAMS_CONSTRUCT (c->op)) + c = c->next; + if (c) + gfc_error ("!$OMP TARGET region at %L with a nested TEAMS at %L may not " + "contain any other statement, declaration or directive outside " + "of the single TEAMS construct", &c->loc, &code->loc); + else + gfc_error ("!$OMP TARGET region at %L with a nested TEAMS may not " + "contain any other statement, declaration or directive outside " + "of the single TEAMS construct", &code->loc); +#undef GFC_IS_TEAMS_CONSTRUCT +} + + /* Resolve OpenMP directive clauses and check various requirements of each directive. */ @@ -10703,6 +10738,9 @@ gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns) case EXEC_OMP_TEAMS_LOOP: resolve_omp_do (code); break; + case EXEC_OMP_TARGET: + resolve_omp_target (code); + gcc_fallthrough (); case EXEC_OMP_ALLOCATE: case EXEC_OMP_ALLOCATORS: case EXEC_OMP_ASSUME: @@ -10718,7 +10756,6 @@ gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns) case EXEC_OMP_SCOPE: case EXEC_OMP_SECTIONS: case EXEC_OMP_SINGLE: - case EXEC_OMP_TARGET: case EXEC_OMP_TARGET_DATA: case EXEC_OMP_TARGET_ENTER_DATA: case EXEC_OMP_TARGET_EXIT_DATA: diff --git a/gcc/fortran/parse.cc b/gcc/fortran/parse.cc index e53b7a42e92..011a39c3d04 100644 --- a/gcc/fortran/parse.cc +++ b/gcc/fortran/parse.cc @@ -1312,6 +1312,39 @@ decode_omp_directive (void) prog_unit->omp_target_seen = true; break; } + 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: + if (gfc_state_stack->previous && gfc_state_stack->previous->tail) + { + gfc_state_data *stk = gfc_state_stack; + do { + stk = stk->previous; + } while (stk && stk->tail && stk->tail->op == EXEC_BLOCK); + if (stk && stk->tail) + switch (stk->tail->op) + { + case EXEC_OMP_TARGET: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_TARGET_TEAMS_LOOP: + case EXEC_OMP_TARGET_PARALLEL: + case EXEC_OMP_TARGET_PARALLEL_DO: + case EXEC_OMP_TARGET_PARALLEL_DO_SIMD: + case EXEC_OMP_TARGET_PARALLEL_LOOP: + case EXEC_OMP_TARGET_SIMD: + stk->tail->ext.omp_clauses->contains_teams_construct = 1; + break; + default: + break; + } + } + break; case ST_OMP_ERROR: if (new_st.ext.omp_clauses->at != OMP_AT_EXECUTION) return ST_NONE; diff --git a/gcc/testsuite/gfortran.dg/gomp/pr99226.f90 b/gcc/testsuite/gfortran.dg/gomp/pr99226.f90 index 72dbdde2e28..2aea0c15585 100644 --- a/gcc/testsuite/gfortran.dg/gomp/pr99226.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/pr99226.f90 @@ -2,7 +2,7 @@ subroutine sub (n) integer :: n, i - !$omp target ! { dg-error "construct with nested 'teams' construct contains directives outside of the 'teams' construct" } + !$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" } !$omp teams distribute dist_schedule (static,n+4) do i = 1, 8 end do diff --git a/gcc/testsuite/gfortran.dg/gomp/teams-5.f90 b/gcc/testsuite/gfortran.dg/gomp/teams-5.f90 new file mode 100644 index 00000000000..bf5461b87c8 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/teams-5.f90 @@ -0,0 +1,127 @@ +! { dg-do compile } + +! PR fortran/110725 +! PR middle-end/71065 + +implicit none +integer :: x +!$omp target device(1) + block + !$omp teams num_teams(f()) + !$omp end teams + end block +!!$omp end target + +!$omp target device(1) + !$omp teams num_teams(f()) + !$omp end teams +!$omp end target + +!$omp target device(1) ! { 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" } + x = 5 + !$omp teams num_teams(f()) ! { 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" } + !$omp end teams +!$omp end target + +!$omp target device(1) ! { 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" } + !$omp teams num_teams(f()) ! { 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" } + !$omp end teams + x = 5 +!$omp end target + +!$omp target ! { dg-error "OMP TARGET region at .1. with a nested TEAMS may not contain any other statement, declaration or directive outside of the single TEAMS construct" } + block + block + !$omp teams num_teams(f()) + !$omp end teams + end block + end block +!$omp end target + +!$omp target device(1) ! { 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 + x = 5 + !$omp teams num_teams(f()) ! { 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" } + !$omp end teams + end block +!$omp end target + +!$omp target device(1) ! { 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 + !$omp teams num_teams(f()) ! { 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" } + !$omp end teams + x = 5 + end block +!$omp end target + +!$omp target device(1) ! { 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 + !$omp teams num_teams(f()) ! { 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" } + !$omp end teams + x = 5 + end block +!$omp end target + +contains + +function f() + !$omp declare target + integer, allocatable :: f + f = 5 +end +end + +subroutine sub1 + implicit none + integer :: x,i + + !$omp target device(1) ! { 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 + !$omp teams distribute num_teams(f()) ! { 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 + x = 7 + end block + !$omp end target + + !$omp target device(1) ! { 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 + !$omp teams loop num_teams(f()) ! { 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 + x = 7 + end block + !$omp end target + + !$omp target device(1) ! { 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" } + !$omp teams distribute simd num_teams(f()) ! { 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 + x = 7 + !$omp end target + + !$omp target device(1) ! { 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" } + !$omp teams distribute parallel do num_teams(f()) ! { 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 + x = 7 + !$omp end target + + !$omp target device(1) ! { 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 + x = 7 + !$omp teams distribute parallel do simd num_teams(f()) ! { 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 end target + +contains + +function f() + !$omp declare target + integer, allocatable :: f + f = 5 +end + +end