procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

OpenMP/Fortran: Extend reject code between target + teams [PR71065, PR110725]

Browse source 
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.
This commit is contained in:
Tobias Burnus 2023-07-27 18:14:11 +02:00
parent 50bc490c09
commit 081e25d3cf
3 changed files with 38 additions and 34 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

15
gcc/fortran/openmp.cc
View file

@ -10666,15 +10666,14 @@ resolve_omp_target (gfc_code *code)
if (!code->ext.omp_clauses->contains_teams_construct)
return;
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;
if (code->ext.omp_clauses->target_first_st_is_teams
&& ((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;
while (c && !GFC_IS_TEAMS_CONSTRUCT (c->op))
c = c->next;
if (c)

47
gcc/fortran/parse.cc
View file

@ -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)

10
gcc/testsuite/gfortran.dg/gomp/teams-6.f90
View file

@ -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