Hi! In OpenMP 4.5, the gomp/teams1.f90 code was invalid and diagnosed in the middle-end. In OpenMP 5.0, it is valid and the diagnostics in the middle-end has been removed, but the Fortran side hasn't been adjusted and so the middle-end ICEs on it.
The following patch just does the minimal FE changes needed so that it works, plus includes libgomp.c/teams-{1,2}.c testcases ported from C to Fortran. Bootstrapped/regtested on x86_64-linux and i686-linux, committed to trunk. For GCC 9, I think it might be better to conditionally (for Fortran only) restore the diagnostics in the middle-end. 2019-12-04 Jakub Jelinek <ja...@redhat.com> 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. --- gcc/fortran/trans-openmp.c.jj 2019-11-13 10:54:50.805964153 +0100 +++ gcc/fortran/trans-openmp.c 2019-12-03 18:27:20.268290704 +0100 @@ -4858,10 +4858,14 @@ gfc_trans_omp_teams (gfc_code *code, gfc 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 } 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) --- gcc/testsuite/gfortran.dg/gomp/teams1.f90.jj 2019-12-03 19:09:56.392965420 +0100 +++ gcc/testsuite/gfortran.dg/gomp/teams1.f90 2019-12-03 19:09:50.441056832 +0100 @@ -0,0 +1,8 @@ +! PR fortran/92756 + +program pr92756 + integer :: i + !$omp teams distribute parallel do + do i = 1, 64 + end do +end --- libgomp/testsuite/libgomp.fortran/teams1.f90.jj 2019-12-03 19:10:39.119309202 +0100 +++ libgomp/testsuite/libgomp.fortran/teams1.f90 2019-12-03 19:57:10.699949472 +0100 @@ -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 --- libgomp/testsuite/libgomp.fortran/teams2.f90.jj 2019-12-03 19:10:42.219261589 +0100 +++ libgomp/testsuite/libgomp.fortran/teams2.f90 2019-12-03 19:58:56.976311846 +0100 @@ -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 Jakub