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

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

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)

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.

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

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.

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

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