Yet another omission, the flag was not properly set for deeply buried 'omp teams' as I stopped too early when walking up the stack.
Now fixed by commit r14-2826-g081e25d3cfd86c * * * This was found when 'repairing' the feature on the OG13 (devel/omp/gcc-13) branch for metadirectives, cf. the second attached patch, applied after cherry-picking the mainline patch. Tobias ----------------- Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955
commit 081e25d3cfd86c4094999ded0bbe99b91762013c Author: Tobias Burnus <tob...@codesourcery.com> Date: Thu Jul 27 18:14:11 2023 +0200 OpenMP/Fortran: Extend reject code between target + teams [PR71065, PR110725] The previous version failed to diagnose when the 'teams' was nested more deeply inside the target region, e.g. inside a DO or some block or structured block. PR fortran/110725 PR middle-end/71065 gcc/fortran/ChangeLog: * openmp.cc (resolve_omp_target): Minor cleanup. * parse.cc (decode_omp_directive): Find TARGET statement also higher in the stack. gcc/testsuite/ChangeLog: * gfortran.dg/gomp/teams-6.f90: Extend. diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc index 52eeaf2d4da..2952cd300ac 100644 --- a/gcc/fortran/openmp.cc +++ b/gcc/fortran/openmp.cc @@ -10666,15 +10666,14 @@ resolve_omp_target (gfc_code *code) if (!code->ext.omp_clauses->contains_teams_construct) return; + gfc_code *c = code->block->next; 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))) + && ((GFC_IS_TEAMS_CONSTRUCT (c->op) && c->next == NULL) + || (c->op == EXEC_BLOCK + && c->next + && GFC_IS_TEAMS_CONSTRUCT (c->next->op) + && c->next->next == NULL))) return; - gfc_code *c = code->block->next; while (c && !GFC_IS_TEAMS_CONSTRUCT (c->op)) c = c->next; if (c) diff --git a/gcc/fortran/parse.cc b/gcc/fortran/parse.cc index aa6bb663def..e797402b59f 100644 --- a/gcc/fortran/parse.cc +++ b/gcc/fortran/parse.cc @@ -1318,32 +1318,27 @@ decode_omp_directive (void) 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; - } - } + for (gfc_state_data *stk = gfc_state_stack->previous; stk; + stk = stk->previous) + 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) diff --git a/gcc/testsuite/gfortran.dg/gomp/teams-6.f90 b/gcc/testsuite/gfortran.dg/gomp/teams-6.f90 index be453f27f40..0bd7735e738 100644 --- a/gcc/testsuite/gfortran.dg/gomp/teams-6.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/teams-6.f90 @@ -37,6 +37,16 @@ end block i = 5 !$omp end teams !$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 + do i = 5, 8 + !$omp teams + block; end block + end do +end block + end
commit eae457d9aa6ccad1692759bffee8fa3f6c92a3a0 Author: Tobias Burnus <tob...@codesourcery.com> Date: Thu Jul 27 18:30:20 2023 +0200 OpenMP/Fortran: Fix target + teams diagnostic with metadirectives gcc/fortran/ChangeLog: * gfortran.h (gfc_omp_clauses): Rename target_first_st_is_teams to target_first_st_is_teams_or_meta. * parse.cc (parse_omp_structured_block): Handle metadirectives for target_first_st_is_teams. * openmp.cc (resolve_omp_target): Likewise to fix target+teams diagnostic with metadirectives. libgomp/ChangeLog: * testsuite/libgomp.fortran/metadirective-1.f90: Extend. * testsuite/libgomp.fortran/metadirective-6.f90: New test. --- gcc/fortran/ChangeLog.omp | 9 ++++ gcc/fortran/gfortran.h | 2 +- gcc/fortran/openmp.cc | 35 ++++++++++--- gcc/fortran/parse.cc | 4 +- libgomp/ChangeLog.omp | 5 ++ .../testsuite/libgomp.fortran/metadirective-1.f90 | 28 +++++++++++ .../testsuite/libgomp.fortran/metadirective-6.f90 | 58 ++++++++++++++++++++++ 7 files changed, 132 insertions(+), 9 deletions(-) diff --git a/gcc/fortran/ChangeLog.omp b/gcc/fortran/ChangeLog.omp index c197f77f1f9..237e9ebeba2 100644 --- a/gcc/fortran/ChangeLog.omp +++ b/gcc/fortran/ChangeLog.omp @@ -1,3 +1,12 @@ +2023-07-27 Tobias Burnus <tob...@codesourcery.com> + + * gfortran.h (gfc_omp_clauses): Rename target_first_st_is_teams + to target_first_st_is_teams_or_meta. + * parse.cc (parse_omp_structured_block): Handle metadirectives + for target_first_st_is_teams. + * openmp.cc (resolve_omp_target): Likewise to fix target+teams + diagnostic with metadirectives. + 2023-07-27 Tobias Burnus <tob...@codesourcery.com> Backported from master: diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 2cf8a0e0c39..0e7e80e4bf1 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -1588,7 +1588,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, target_first_st_is_teams:1; + unsigned contains_teams_construct:1, target_first_st_is_teams_or_meta:1; unsigned unroll_full:1, unroll_none:1, unroll_partial:1; unsigned unroll_partial_factor; ENUM_BITFIELD (gfc_omp_sched_kind) sched_kind:3; diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc index 18a4a33feaa..deccb14a525 100644 --- a/gcc/fortran/openmp.cc +++ b/gcc/fortran/openmp.cc @@ -12252,13 +12252,34 @@ resolve_omp_target (gfc_code *code) if (!code->ext.omp_clauses->contains_teams_construct) return; gfc_code *c = code->block->next; - if (code->ext.omp_clauses->target_first_st_is_teams - && ((GFC_IS_TEAMS_CONSTRUCT (c->op) && c->next == NULL) - || (c->op == EXEC_BLOCK - && c->next - && GFC_IS_TEAMS_CONSTRUCT (c->next->op) - && c->next->next == NULL))) - return; + if (c->op == EXEC_BLOCK) + c = c->next; + if (code->ext.omp_clauses->target_first_st_is_teams_or_meta) + { + if (c->op == EXEC_OMP_METADIRECTIVE) + { + struct gfc_omp_metadirective_clause *mc + = c->ext.omp_metadirective_clauses; + /* All mc->(next...->)code should be identical with regards + to the diagnostic below. */ + do + { + if (mc->stmt != ST_NONE + && GFC_IS_TEAMS_CONSTRUCT (mc->code->op)) + { + if (c->next == NULL && mc->code->next == NULL) + return; + c = mc->code; + break; + } + mc = mc->next; + } + while (mc); + } + else if (GFC_IS_TEAMS_CONSTRUCT (c->op) && c->next == NULL) + return; + } + while (c && !GFC_IS_TEAMS_CONSTRUCT (c->op)) c = c->next; if (c) diff --git a/gcc/fortran/parse.cc b/gcc/fortran/parse.cc index 2070a8a7dee..efedde1d84b 100644 --- a/gcc/fortran/parse.cc +++ b/gcc/fortran/parse.cc @@ -5833,9 +5833,11 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only) case ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: case ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: case ST_OMP_TEAMS_LOOP: + case ST_OMP_METADIRECTIVE: + case ST_OMP_BEGIN_METADIRECTIVE: { gfc_state_data *stk = gfc_state_stack->previous; - stk->tail->ext.omp_clauses->target_first_st_is_teams = true; + stk->tail->ext.omp_clauses->target_first_st_is_teams_or_meta = true; break; } default: diff --git a/libgomp/ChangeLog.omp b/libgomp/ChangeLog.omp index f83700f1c00..9f8e3ec947d 100644 --- a/libgomp/ChangeLog.omp +++ b/libgomp/ChangeLog.omp @@ -1,3 +1,8 @@ +2023-07-27 Tobias Burnus <tob...@codesourcery.com> + + * testsuite/libgomp.fortran/metadirective-1.f90: Extend. + * testsuite/libgomp.fortran/metadirective-6.f90: New test. + 2023-07-26 Tobias Burnus <tob...@codesourcery.com> Backported from master: diff --git a/libgomp/testsuite/libgomp.fortran/metadirective-1.f90 b/libgomp/testsuite/libgomp.fortran/metadirective-1.f90 index 9f6a07459e0..7b3e09f7c2a 100644 --- a/libgomp/testsuite/libgomp.fortran/metadirective-1.f90 +++ b/libgomp/testsuite/libgomp.fortran/metadirective-1.f90 @@ -17,17 +17,45 @@ program test do i = 1, N if (z(i) .ne. x(i) * y(i)) stop 1 end do + + ! ----- + do i = 1, N + x(i) = i; + y(i) = -i; + end do + + call g (x, y, z) + + do i = 1, N + if (z(i) .ne. x(i) * y(i)) stop 1 + end do + contains subroutine f (x, y, z) integer :: x(N), y(N), z(N) !$omp target map (to: x, y) map(from: z) + block + !$omp metadirective & + !$omp& when(device={arch("nvptx")}: teams loop) & + !$omp& default(parallel loop) + do i = 1, N + z(i) = x(i) * y(i) + enddo + end block + end subroutine + subroutine g (x, y, z) + integer :: x(N), y(N), z(N) + + !$omp target map (to: x, y) map(from: z) + block !$omp metadirective & !$omp& when(device={arch("nvptx")}: teams loop) & !$omp& default(parallel loop) do i = 1, N z(i) = x(i) * y(i) enddo + end block !$omp end target end subroutine end program diff --git a/libgomp/testsuite/libgomp.fortran/metadirective-6.f90 b/libgomp/testsuite/libgomp.fortran/metadirective-6.f90 new file mode 100644 index 00000000000..436fdbade2f --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/metadirective-6.f90 @@ -0,0 +1,58 @@ +! { dg-do compile } + +program test + implicit none + + integer, parameter :: N = 100 + integer :: x(N), y(N), z(N) + integer :: i + +contains + subroutine f (x, y, z) + integer :: x(N), y(N), z(N) + + !$omp target map (to: x, y) map(from: z) ! { 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 metadirective & + !$omp& when(device={arch("nvptx")}: teams loop) & + !$omp& default(parallel loop) ! { dg-error "\\(1\\)" } + ! FIXME: The line above should be the same error as above but some fails here with -fno-diagnostics-show-caret + ! Seems as if some gcc/testsuite/ fix is missing for libgomp/testsuite + do i = 1, N + z(i) = x(i) * y(i) + enddo + z(N) = z(N) + 1 ! <<< invalid + end block + end subroutine + + subroutine f2 (x, y, z) + integer :: x(N), y(N), z(N) + + !$omp target map (to: x, y) map(from: z) ! { 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 + integer :: i ! << invalid + !$omp metadirective & + !$omp& when(device={arch("nvptx")}: teams loop) & + !$omp& default(parallel loop) + do i = 1, N + z(i) = x(i) * y(i) + enddo + end block + end subroutine + subroutine g (x, y, z) + integer :: x(N), y(N), z(N) + + !$omp target map (to: x, y) map(from: z) ! { 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 + !$omp metadirective & ! <<<< invalid + !$omp& when(device={arch("nvptx")}: flush) & + !$omp& default(nothing) + !$omp teams loop + do i = 1, N + z(i) = x(i) * y(i) + enddo + end block + !$omp end target + end subroutine + +end program