OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR fortran/92756 (ICE in lower_omp, at omp-low.c:12988)

Browse Source 
PR fortran/92756
	* trans-openmp.c (gfc_trans_omp_teams): Wrap OMP_TEAMS body into a
	BIND_EXPR with a forced BLOCK.

	* gfortran.dg/gomp/teams1.f90: New test.

	* testsuite/libgomp.fortran/teams1.f90: New test.
	* testsuite/libgomp.fortran/teams2.f90: New test.

From-SVN: r278956
This commit is contained in:
Jakub Jelinek 2019-12-04 09:47:13 +01:00 committed by Jakub Jelinek
parent c96828f1ec
commit a8a5f4cc04
7 changed files with 193 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
gcc/fortran/ChangeLog
View File

@ -1,3 +1,9 @@
2019-12-04 Jakub Jelinek <jakub@redhat.com>
PR fortran/92756
* trans-openmp.c (gfc_trans_omp_teams): Wrap OMP_TEAMS body into a
BIND_EXPR with a forced BLOCK.
2019-11-30 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/91783

13
gcc/fortran/trans-openmp.c
View File

@ -4858,10 +4858,14 @@ gfc_trans_omp_teams (gfc_code *code, gfc_omp_clauses *clausesa,
gfc_split_omp_clauses (code, clausesa);
}
if (flag_openmp)
omp_clauses
= chainon (omp_clauses,
gfc_trans_omp_clauses (&block, &clausesa[GFC_OMP_SPLIT_TEAMS],
code->loc));
{
omp_clauses
= chainon (omp_clauses,
gfc_trans_omp_clauses (&block,
&clausesa[GFC_OMP_SPLIT_TEAMS],
code->loc));
pushlevel ();
}
switch (code->op)
{
case EXEC_OMP_TARGET_TEAMS:
@ -4881,6 +4885,7 @@ gfc_trans_omp_teams (gfc_code *code, gfc_omp_clauses *clausesa,
}
if (flag_openmp)
{
stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
stmt = build2_loc (input_location, OMP_TEAMS, void_type_node, stmt,
omp_clauses);
if (combined)

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
2019-12-04 Jakub Jelinek <jakub@redhat.com>
PR fortran/92756
* gfortran.dg/gomp/teams1.f90: New test.
2019-12-03 Jakub Jelinek <jakub@redhat.com>
* g++.dg/cpp2a/srcloc1.C: New test.

8
gcc/testsuite/gfortran.dg/gomp/teams1.f90 Normal file
View File

@ -0,0 +1,8 @@
! PR fortran/92756
program pr92756
integer :: i
!$omp teams distribute parallel do
do i = 1, 64
end do
end

6
libgomp/ChangeLog
View File

@ -1,3 +1,9 @@
2019-12-04 Jakub Jelinek <jakub@redhat.com>
PR fortran/92756
* testsuite/libgomp.fortran/teams1.f90: New test.
* testsuite/libgomp.fortran/teams2.f90: New test.
2019-12-03 Frederik Harwath <frederik@codesourcery.com>
* oacc-init.c (acc_known_device_type): Add function.

19
libgomp/testsuite/libgomp.fortran/teams1.f90 Normal file
View File

@ -0,0 +1,19 @@
program teams1
use omp_lib
!$omp teams thread_limit (2)
if (omp_in_parallel ()) stop 1
if (omp_get_level () .ne. 0) stop 2
if (omp_get_ancestor_thread_num (0) .ne. 0) stop 3
if (omp_get_ancestor_thread_num (1) .ne. -1) stop 4
call omp_set_dynamic (.false.)
call omp_set_nested (.true.)
!$omp parallel num_threads (2)
if (.not. omp_in_parallel ()) stop 5
if (omp_get_level () .ne. 1) stop 6
if (omp_get_ancestor_thread_num (0) .ne. 0) stop 7
if (omp_get_ancestor_thread_num (1) &
& .ne. omp_get_thread_num ()) stop 8
if (omp_get_ancestor_thread_num (2) .ne. -1) stop 9
!$omp end parallel
!$omp end teams
end program

140
libgomp/testsuite/libgomp.fortran/teams2.f90 Normal file
View File

@ -0,0 +1,140 @@
program teams2
use omp_lib
integer :: i, j, err
err = 0
!$omp teams reduction(+:err)
err = err + bar (0, 0, 0)
!$omp end teams
if (err .ne. 0) stop 1
!$omp teams reduction(+:err)
err = err + bar (1, 0, 0)
!$omp end teams
if (err .ne. 0) stop 2
!$omp teams reduction(+:err)
!$omp distribute
do i = 0, 63
err = err + bar (2, i, 0)
end do
!$omp end teams
if (err .ne. 0) stop 3
!$omp teams reduction(+:err)
!$omp distribute
do i = 0, 63
!$omp parallel do reduction(+:err)
do j = 0, 31
err = err + bar (3, i, j)
end do
end do
!$omp end teams
if (err .ne. 0) stop 4
contains
subroutine foo (x, y, z, a, b)
integer :: x, y, z, a, b(64), i, j
if (x .eq. 0) then
do i = 0, 63
!$omp parallel do shared (a, b)
do j = 0, 31
call foo (3, i, j, a, b)
end do
end do
else if (x .eq. 1) then
!$omp distribute dist_schedule (static, 1)
do i = 0, 63
!$omp parallel do shared (a, b)
do j = 0, 31
call foo (3, i, j, a, b)
end do
end do
else if (x .eq. 2) then
!$omp parallel do shared (a, b)
do j = 0, 31
call foo (3, y, j, a, b)
end do
else
!$omp atomic
b(y + 1) = b(y + 1) + z
!$omp end atomic
!$omp atomic
a = a + 1
!$omp end atomic
end if
end subroutine
integer function bar (x, y, z)
use omp_lib
integer :: x, y, z, a, b(64), i, c, d, e, f
a = 8
do i = 0, 63
b(i + 1) = i
end do
call foo (x, y, z, a, b)
if (x .eq. 0) then
if (a .ne. 8 + 64 * 32) then
bar = 1
return
end if
do i = 0, 63
if (b(i + 1) .ne. i + 31 * 32 / 2) then
bar = 1
return
end if
end do
else if (x .eq. 1) then
c = omp_get_num_teams ()
d = omp_get_team_num ()
e = d
f = 0
do i = 0, 63
if (i .eq. e) then
if (b(i + 1) .ne. i + 31 * 32 / 2) then
bar = 1
return
end if
f = f + 1
e = e + c
else if (b(i + 1) .ne. i) then
bar = 1
return
end if
end do
if (a .lt. 8 .or. a > 8 + f * 32) then
bar = 1
return
end if
else if (x .eq. 2) then
if (a .ne. 8 + 32) then
bar = 1
return
end if
do i = 0, 63
if (i .eq. y) then
c = 31 * 32 / 2
else
c = 0
end if
if (b(i + 1) .ne. i + c) then
bar = 1
return
end if
end do
else if (x .eq. 3) then
if (a .ne. 8 + 1) then
bar = 1
return
end if
do i = 0, 63
if (i .eq. y) then
c = z
else
c = 0
end if
if (b (i + 1) .ne. i + c) then
bar = 1
return
end if
end do
end if
bar = 0
return
end function
end program