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.

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 6482a8852116a159e0f0b5f680c3e152e5452428..577ef807af7a8fae4444c65d546fea4d1072b7ee 100644 (file)
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1575,6 +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;
   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 05a697da07100ad5276b30f3426f42d24a48c29d..675011a18ce897aa487bab052c5288285e6fc997 100644 (file)
--- a/gcc/fortran/openmp.cc
+++ b/gcc/fortran/openmp.cc
@@ -10653,6 +10653,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.  */
 
@@ -10703,6 +10738,9 @@ gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns)
     case EXEC_OMP_TEAMS_LOOP:
       resolve_omp_do (code);
       break;
+    case EXEC_OMP_TARGET:
+      resolve_omp_target (code);
+      gcc_fallthrough ();
     case EXEC_OMP_ALLOCATE:
     case EXEC_OMP_ALLOCATORS:
     case EXEC_OMP_ASSUME:
@@ -10718,7 +10756,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 e53b7a42e92d97d005cc90400e5d3c920e431264..011a39c3d04b710ac5597dc3afa64233c20946a5 100644 (file)
--- a/gcc/fortran/parse.cc
+++ b/gcc/fortran/parse.cc
@@ -1312,6 +1312,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 72dbdde2e280f11bab6bd8b7238523acd1507541..2aea0c155850adefa4c1825cc2d1a0c2fcb56671 100644 (file)
--- a/gcc/testsuite/gfortran.dg/gomp/pr99226.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/pr99226.f90
@@ -2,7 +2,7 @@
 
 subroutine sub (n)
    integer :: n, i
-   !$omp target        ! { dg-error "construct with nested 'teams' construct contains directives outside of the 'teams' construct" }
+   !$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)
    do i = 1, 8
    end do

diff --git a/gcc/testsuite/gfortran.dg/gomp/teams-5.f90 b/gcc/testsuite/gfortran.dg/gomp/teams-5.f90
new file mode 100644 (file)
index 0000000..00377b6
--- /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