aboutsummaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
Diffstat (limited to 'gcc')
-rw-r--r--gcc/fortran/gfortran.h1
-rw-r--r--gcc/fortran/openmp.cc39
-rw-r--r--gcc/fortran/parse.cc33
-rw-r--r--gcc/testsuite/gfortran.dg/gomp/pr99226.f902
-rw-r--r--gcc/testsuite/gfortran.dg/gomp/teams-5.f90150
5 files changed, 223 insertions, 2 deletions
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 6482a88..577ef80 100644
--- 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 05a697d..675011a 100644
--- 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 e53b7a4..011a39c 100644
--- 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 72dbdde..2aea0c1 100644
--- 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
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
generated by cgit v1.1 at 2025-05-28 10:20:46 +0000