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.

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 577ef807af7a8fae4444c65d546fea4d1072b7ee..9a00e6dea6f1f91077d2dc8a2c4ce37c79c93788 100644 (file)
--- 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 675011a18ce897aa487bab052c5288285e6fc997..52eeaf2d4dabc5fef9d58edb43fafc6a2b9b9ae7 100644 (file)
--- 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 011a39c3d04b710ac5597dc3afa64233c20946a5..aa6bb663deff851ddd6db83c3eac025a435f175d 100644 (file)
--- 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 (file)
index 0000000..be453f2
--- /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