OpenMP/Fortran: Reject declarations between target + teams (was: [Patch] OpenMP/Fortran: Reject not strictly nested target -> teams [PR110725, PR71065])
Checks
Commit Message
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(-)
@@ -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;
@@ -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))
@@ -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)
new file mode 100644
@@ -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