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

	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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index a29d4229c7eb49f0ce436cfc8a02cc5e0f92da7c..3a188bac265b5acb9b0245207035d4727780c1ab 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -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

diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index d9dfcabc65ef0737391a39f954afe5220a0aa7f8..3a4f96222cb876e5bac7d26787094d548293570c 100644 (file)
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -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)

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 8ae30c286a74d2539770f9b4ee64c96c894697ce..8f3edaf5dcd08fc5f8ec3eb987a5e9a462625ed4 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -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.

diff --git a/gcc/testsuite/gfortran.dg/gomp/teams1.f90 b/gcc/testsuite/gfortran.dg/gomp/teams1.f90
new file mode 100644 (file)
index 0000000..21101cd
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/teams1.f90
@@ -0,0 +1,8 @@
+! PR fortran/92756
+
+program pr92756
+  integer :: i
+  !$omp teams distribute parallel do
+  do i = 1, 64
+  end do
+end

diff --git a/libgomp/ChangeLog b/libgomp/ChangeLog
index 88b7bb2dc8cf7bc4c288f2320400f5b85d953ee0..183e7a6c02d93e8cf5336342e88a749b89e0c2c5 100644 (file)
--- a/libgomp/ChangeLog
+++ b/libgomp/ChangeLog
@@ -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.

diff --git a/libgomp/testsuite/libgomp.fortran/teams1.f90 b/libgomp/testsuite/libgomp.fortran/teams1.f90
new file mode 100644 (file)
index 0000000..4f14607
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/teams1.f90
@@ -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

diff --git a/libgomp/testsuite/libgomp.fortran/teams2.f90 b/libgomp/testsuite/libgomp.fortran/teams2.f90
new file mode 100644 (file)
index 0000000..f6b58f7
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/teams2.f90
@@ -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