public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc/devel/omp/gcc-13] OpenMP/Fortran: Reject not strictly nested target -> teams [PR110725, PR71065]
@ 2023-07-25 8:31 Tobias Burnus
0 siblings, 0 replies; only message in thread
From: Tobias Burnus @ 2023-07-25 8:31 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:c05e6498ba9295835918a7abdf75b93f7842620f
commit c05e6498ba9295835918a7abdf75b93f7842620f
Author: Tobias Burnus <tobias@codesourcery.com>
Date: Mon Jul 24 22:57:07 2023 +0200
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."
This commit checks now for this restriction.
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.
(cherry picked from commit 2e31fe431b08b0302e1fa8a1c18ee51adafd41df)
With follow-up fix for pr99226.f90's dg-error update:
cherry picked from commit 50656980497d77ac12a5e7179013a6af09ba32f7
Diff:
---
gcc/fortran/gfortran.h | 1 +
gcc/fortran/openmp.cc | 39 +++++++-
gcc/fortran/parse.cc | 33 +++++++
gcc/testsuite/gfortran.dg/gomp/pr99226.f90 | 4 +-
gcc/testsuite/gfortran.dg/gomp/teams-5.f90 | 150 +++++++++++++++++++++++++++++
5 files changed, 224 insertions(+), 3 deletions(-)
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 3c2d9d7e14b..b1bdcc44fad 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1588,6 +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;
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 99fe52c49bd..e71bf2e2e3b 100644
--- a/gcc/fortran/openmp.cc
+++ b/gcc/fortran/openmp.cc
@@ -12238,6 +12238,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. */
@@ -12294,6 +12329,9 @@ gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns)
case EXEC_OMP_UNROLL:
resolve_omp_unroll (code);
break;
+ case EXEC_OMP_TARGET:
+ resolve_omp_target (code);
+ gcc_fallthrough ();
case EXEC_OMP_ASSUME:
case EXEC_OMP_CANCEL:
case EXEC_OMP_ERROR:
@@ -12307,7 +12345,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 f44701da539..3cfb8f153e7 100644
--- a/gcc/fortran/parse.cc
+++ b/gcc/fortran/parse.cc
@@ -1260,6 +1260,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..d1b35076dd0 100644
--- a/gcc/testsuite/gfortran.dg/gomp/pr99226.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/pr99226.f90
@@ -2,8 +2,8 @@
subroutine sub (n)
integer :: n, i
- !$omp target ! { dg-error "construct with nested 'teams' construct contains directives outside of the 'teams' construct" }
- !$omp teams distribute dist_schedule (static,n+4)
+ !$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) ! { 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, 8
end do
!$omp teams distribute dist_schedule (static,n+4)
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..00377b69bf4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/teams-5.f90
@@ -0,0 +1,150 @@
+! { 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
+
+!$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
+ 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
+ block; end 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
+ 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
+ block; end block;
+ 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
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2023-07-25 8:31 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2023-07-25 8:31 [gcc/devel/omp/gcc-13] OpenMP/Fortran: Reject not strictly nested target -> teams [PR110725, PR71065] Tobias Burnus
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).