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

OpenMP/Fortran: Combined directives with map/firstprivate of same symbol

Browse source 
This patch fixes a case where a combined directive (e.g. "!$omp target
parallel ...") contains both a map and a firstprivate clause for the
same variable.  When the combined directive is split into two nested
directives, the outer "target" gets the "map" clause, and the inner
"parallel" gets the "firstprivate" clause, like so:

  !$omp target parallel map(x) firstprivate(x)

  -->

  !$omp target map(x)
    !$omp parallel firstprivate(x)
      ...

When there is no map of the same variable, the firstprivate is distributed
to both directives, e.g. for 'y' in:

  !$omp target parallel map(x) firstprivate(y)

  -->

  !$omp target map(x) firstprivate(y)
    !$omp parallel firstprivate(y)
      ...

This is not a recent regression, but appear to fix a long-standing ICE.
(The included testcase is based on one by Tobias.)

2022-12-06  Julian Brown  <julian@codesourcery.com>

gcc/fortran/
	* trans-openmp.cc (gfc_add_firstprivate_if_unmapped): New function.
	(gfc_split_omp_clauses): Call above.

libgomp/
	* testsuite/libgomp.fortran/combined-directive-splitting-1.f90: New
	test.
This commit is contained in:
Julian Brown 2022-12-06 12:18:33 +00:00
parent 881c6cabce
commit 9316ad3b43
2 changed files with 76 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

37
gcc/fortran/trans-openmp.cc
View file

@ -5968,6 +5968,39 @@ gfc_add_clause_implicitly (gfc_omp_clauses *clauses_out,
}
}
/* Kind of opposite to above, add firstprivate to CLAUSES_OUT if it is mapped
in CLAUSES_IN's FIRSTPRIVATE list but not its MAP list. */
static void
gfc_add_firstprivate_if_unmapped (gfc_omp_clauses *clauses_out,
gfc_omp_clauses *clauses_in)
{
gfc_omp_namelist *n = clauses_in->lists[OMP_LIST_FIRSTPRIVATE];
gfc_omp_namelist **tail = NULL;
for (; n != NULL; n = n->next)
{
gfc_omp_namelist *n2 = clauses_out->lists[OMP_LIST_MAP];
for (; n2 != NULL; n2 = n2->next)
if (n->sym == n2->sym)
break;
if (n2 == NULL)
{
gfc_omp_namelist *dup = gfc_get_omp_namelist ();
*dup = *n;
dup->next = NULL;
if (!tail)
{
tail = &clauses_out->lists[OMP_LIST_FIRSTPRIVATE];
while (*tail && (*tail)->next)
tail = &(*tail)->next;
}
*tail = dup;
tail = &(*tail)->next;
}
}
}
static void
gfc_free_split_omp_clauses (gfc_code *code, gfc_omp_clauses *clausesa)
{
@ -6351,8 +6384,8 @@ gfc_split_omp_clauses (gfc_code *code,
simd and masked/master. Put it on the outermost of those and duplicate
on parallel and teams. */
if (mask & GFC_OMP_MASK_TARGET)
clausesa[GFC_OMP_SPLIT_TARGET].lists[OMP_LIST_FIRSTPRIVATE]
= code->ext.omp_clauses->lists[OMP_LIST_FIRSTPRIVATE];
gfc_add_firstprivate_if_unmapped (&clausesa[GFC_OMP_SPLIT_TARGET],
code->ext.omp_clauses);
if (mask & GFC_OMP_MASK_TEAMS)
clausesa[GFC_OMP_SPLIT_TEAMS].lists[OMP_LIST_FIRSTPRIVATE]
= code->ext.omp_clauses->lists[OMP_LIST_FIRSTPRIVATE];

41
libgomp/testsuite/libgomp.fortran/combined-directive-splitting-1.f90 Normal file
View file

@ -0,0 +1,41 @@
module m
integer :: a = 1
!$omp declare target enter(a)
end module m
module m2
contains
subroutine bar()
use m
implicit none
!$omp declare target
a = a + 5
end subroutine bar
end module m2
program p
use m
use m2
implicit none
integer :: b, i
!$omp target parallel do map(always, tofrom: a) firstprivate(a)
do i = 1, 1
a = 7
call bar()
if (a /= 7) error stop 1
a = a + 8
end do
if (a /= 6) error stop 2
b = 3
!$omp target parallel do map(always, tofrom: a) firstprivate(b)
do i = 1, 1
a = 3
call bar ()
if (a /= 8) error stop 3
a = a + b
end do
if (a /= 11) error stop 4
end program p