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 52eeaf2d4dabc5fef9d58edb43fafc6a2b9b9ae7..2952cd300ac1da3692a5a0ce684e5e9408353421 100644 (file)
--- 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 aa6bb663deff851ddd6db83c3eac025a435f175d..e797402b59fce0c0d35d94531f14f6c23211ac18 100644 (file)
--- 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 be453f27f406e2c24fc9e3c72a79892569cf9c11..0bd7735e73840f29062c9533f7770cc6c72fdd9c 100644 (file)
--- 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