On 24.07.23 21:49, Jakub Jelinek via Fortran wrote:
On Mon, Jul 24, 2023 at 09:43:10PM +0200, Tobias Burnus wrote:
This patch adds diagnostic for additional code alongside a nested teams
in a target region.
Thanks for working on this. The fuzzy thing on the Fortran side is
if e.g. multiple nested BLOCK statements can appear sandwiched in between
target and teams (of course without declarations in them)
Talking about declarations, I realized that I missed to diagnose them;
the attached patch should handle them as well. (Except for 'omp nothing'
and 'omp error', which return ST_NONE.)
Comments, remarks, suggestions? If none or no changes are required,
I will later commit the attached follow-up 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
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
