OpenMP/Fortran: Fix loop-iter var privatization with !$OMP LOOP [PR108512]

For 'parallel', loop-iteration variables are marked are marked as 'private',
unless they either appear in an omp do/simd loop or an data-sharing clause
already exists for those on 'parallel'. 'omp loop' wasn't handled, leading
to (potentially) multiple data-sharing clauses in gfc_resolve_do_iterator
as omp_current_ctx pointed to the 'parallel' directive, ignoring the
in-betwen 'loop' directive.

The latter lead to a bogus diagnostic - or rather an ICE as the source
location var contained only '\0'.

Additionally, several 'case EXEC_OMP...LOOP' have been added to call the
right resolution function and likewise for '{masked,master} taskloop'.

gcc/fortran/ChangeLog:

	PR fortran/108512
	* openmp.cc (gfc_resolve_omp_parallel_blocks): Handle combined 'loop'
	directives.
	(gfc_resolve_do_iterator): Set a source location for added
	'private'-clause arguments.
	* resolve.cc (gfc_resolve_code): Call gfc_resolve_omp_do_blocks
	also for EXEC_OMP_LOOP and gfc_resolve_omp_parallel_blocks for
	combined directives with loop + '{masked,master} taskloop (simd)'.

gcc/testsuite/ChangeLog:

	PR fortran/108512
	* gfortran.dg/gomp/loop-5.f90: New test.
	* gfortran.dg/gomp/loop-2.f90: Update dg-error.
	* gfortran.dg/gomp/taskloop-2.f90: Update dg-error.

(cherry picked from commit 7a8cada824c5e45ea729c112f3d1d29956067b7b)

diff --git a/gcc/fortran/ChangeLog.omp b/gcc/fortran/ChangeLog.omp
index 579d8ee7c97370c0f043b3359c726bf20258f452..f6ee8726c8da20d1b986692460daf566b37deb60 100644 (file)
--- a/gcc/fortran/ChangeLog.omp
+++ b/gcc/fortran/ChangeLog.omp
@@ -1,3 +1,17 @@
+2023-02-15  Tobias Burnus  <tobias@codesourcery.com>
+
+       Backported from master:
+       2023-02-15  Tobias Burnus  <tobias@codesourcery.com>
+
+       PR fortran/108512
+       * openmp.cc (gfc_resolve_omp_parallel_blocks): Handle combined 'loop'
+       directives.
+       (gfc_resolve_do_iterator): Set a source location for added
+       'private'-clause arguments.
+       * resolve.cc (gfc_resolve_code): Call gfc_resolve_omp_do_blocks
+       also for EXEC_OMP_LOOP and gfc_resolve_omp_parallel_blocks for
+       combined directives with loop + '{masked,master} taskloop (simd)'.
+
 2023-02-14  Kwok Cheung Yeung  <kcy@codesourcery.com>
 
        * dump-parse-tree.cc (show_omp_namelist): Display 'present' map

diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc
index 75c994d9bf6651e9a4fb3dfb01e855a97ae6c02f..9cbb1728e72ffe3a1f4f2da0a88e62f337d575ba 100644 (file)
--- a/gcc/fortran/openmp.cc
+++ b/gcc/fortran/openmp.cc
@@ -9970,28 +9970,32 @@ gfc_resolve_omp_parallel_blocks (gfc_code *code, gfc_namespace *ns)
     {
     case EXEC_OMP_DISTRIBUTE_PARALLEL_DO:
     case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD:
+    case EXEC_OMP_MASKED_TASKLOOP:
+    case EXEC_OMP_MASKED_TASKLOOP_SIMD:
+    case EXEC_OMP_MASTER_TASKLOOP:
+    case EXEC_OMP_MASTER_TASKLOOP_SIMD:
     case EXEC_OMP_PARALLEL_DO:
     case EXEC_OMP_PARALLEL_DO_SIMD:
+    case EXEC_OMP_PARALLEL_LOOP:
     case EXEC_OMP_PARALLEL_MASKED_TASKLOOP:
     case EXEC_OMP_PARALLEL_MASKED_TASKLOOP_SIMD:
     case EXEC_OMP_PARALLEL_MASTER_TASKLOOP:
     case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD:
-    case EXEC_OMP_MASKED_TASKLOOP:
-    case EXEC_OMP_MASKED_TASKLOOP_SIMD:
-    case EXEC_OMP_MASTER_TASKLOOP:
-    case EXEC_OMP_MASTER_TASKLOOP_SIMD:
     case EXEC_OMP_TARGET_PARALLEL_DO:
     case EXEC_OMP_TARGET_PARALLEL_DO_SIMD:
+    case EXEC_OMP_TARGET_PARALLEL_LOOP:
     case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE:
     case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO:
     case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
     case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD:
+    case EXEC_OMP_TARGET_TEAMS_LOOP:
     case EXEC_OMP_TASKLOOP:
     case EXEC_OMP_TASKLOOP_SIMD:
     case EXEC_OMP_TEAMS_DISTRIBUTE:
     case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO:
     case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
     case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD:
+    case EXEC_OMP_TEAMS_LOOP:
       gfc_resolve_omp_do_blocks (code, ns);
       break;
     default:
@@ -10070,6 +10074,7 @@ gfc_resolve_do_iterator (gfc_code *code, gfc_symbol *sym, bool add_clause)
 
       p = gfc_get_omp_namelist ();
       p->sym = sym;
+      p->where = omp_current_ctx->code->loc;
       p->next = omp_clauses->lists[OMP_LIST_PRIVATE];
       omp_clauses->lists[OMP_LIST_PRIVATE] = p;
     }

diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 719685a79077c5611e4bb52972ea4a535b67ae23..fcc2f0aa016e3607739d25c9a49d37b63dbfeaca 100644 (file)
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -11903,9 +11903,14 @@ gfc_resolve_code (gfc_code *code, gfc_namespace *ns)
              break;
            case EXEC_OMP_DISTRIBUTE_PARALLEL_DO:
            case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD:
+           case EXEC_OMP_MASKED_TASKLOOP:
+           case EXEC_OMP_MASKED_TASKLOOP_SIMD:
+           case EXEC_OMP_MASTER_TASKLOOP:
+           case EXEC_OMP_MASTER_TASKLOOP_SIMD:
            case EXEC_OMP_PARALLEL:
            case EXEC_OMP_PARALLEL_DO:
            case EXEC_OMP_PARALLEL_DO_SIMD:
+           case EXEC_OMP_PARALLEL_LOOP:
            case EXEC_OMP_PARALLEL_MASKED:
            case EXEC_OMP_PARALLEL_MASKED_TASKLOOP:
            case EXEC_OMP_PARALLEL_MASKED_TASKLOOP_SIMD:
@@ -11916,11 +11921,13 @@ gfc_resolve_code (gfc_code *code, gfc_namespace *ns)
            case EXEC_OMP_TARGET_PARALLEL:
            case EXEC_OMP_TARGET_PARALLEL_DO:
            case EXEC_OMP_TARGET_PARALLEL_DO_SIMD:
+           case EXEC_OMP_TARGET_PARALLEL_LOOP:
            case EXEC_OMP_TARGET_TEAMS:
            case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE:
            case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO:
            case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
            case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD:
+           case EXEC_OMP_TARGET_TEAMS_LOOP:
            case EXEC_OMP_TASK:
            case EXEC_OMP_TASKLOOP:
            case EXEC_OMP_TASKLOOP_SIMD:
@@ -11929,6 +11936,7 @@ gfc_resolve_code (gfc_code *code, gfc_namespace *ns)
            case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO:
            case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
            case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD:
+           case EXEC_OMP_TEAMS_LOOP:
              omp_workshare_save = omp_workshare_flag;
              omp_workshare_flag = 0;
              gfc_resolve_omp_parallel_blocks (code, ns);
@@ -11937,6 +11945,7 @@ gfc_resolve_code (gfc_code *code, gfc_namespace *ns)
            case EXEC_OMP_DISTRIBUTE_SIMD:
            case EXEC_OMP_DO:
            case EXEC_OMP_DO_SIMD:
+           case EXEC_OMP_LOOP:
            case EXEC_OMP_SIMD:
            case EXEC_OMP_TARGET_SIMD:
              gfc_resolve_omp_do_blocks (code, ns);

diff --git a/gcc/testsuite/ChangeLog.omp b/gcc/testsuite/ChangeLog.omp
index 572effcad5ad4a478e5d17146820fedecc648f94..98458dfa937f693f1af4c19c15a6a2fbd1531217 100644 (file)
--- a/gcc/testsuite/ChangeLog.omp
+++ b/gcc/testsuite/ChangeLog.omp
@@ -1,3 +1,13 @@
+2023-02-15  Tobias Burnus  <tobias@codesourcery.com>
+
+       Backported from master:
+       2023-02-15  Tobias Burnus  <tobias@codesourcery.com>
+
+       PR fortran/108512
+       * gfortran.dg/gomp/loop-5.f90: New test.
+       * gfortran.dg/gomp/loop-2.f90: Update dg-error.
+       * gfortran.dg/gomp/taskloop-2.f90: Update dg-error.
+
 2023-02-13  Tobias Burnus  <tobias@codesourcery.com>
 
        * gfortran.dg/gomp/openmp-simd-8.f90: Remove dump test.

diff --git a/gcc/testsuite/gfortran.dg/gomp/loop-2.f90 b/gcc/testsuite/gfortran.dg/gomp/loop-2.f90
index 4962683f2b0607668181b81f62ad67b1e14c69e0..2d83e3a750733c4a92183301698edce0fae30e12 100644 (file)
--- a/gcc/testsuite/gfortran.dg/gomp/loop-2.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/loop-2.f90
@@ -18,18 +18,23 @@ do i = 1, 64
 end do
 
 !$omp loop reduction(inscan, +: r)  ! { dg-error "'inscan' REDUCTION clause on construct other than DO, SIMD, DO SIMD, PARALLEL DO, PARALLEL DO SIMD" }
+  ! { dg-error "With INSCAN at .1., expected loop body with ..OMP SCAN between two structured-block-sequences" "" { target *-*-* } .-1 }
 do i = 1, 64
 end do
 !$omp teams loop reduction(inscan, +: r)  ! { dg-error "'inscan' REDUCTION clause on construct other than DO, SIMD, DO SIMD, PARALLEL DO, PARALLEL DO SIMD" }
+  ! { dg-error "With INSCAN at .1., expected loop body with ..OMP SCAN between two structured-block-sequences" "" { target *-*-* } .-1 }
 do i = 1, 64
 end do
 !$omp parallel loop reduction(inscan, +: r) ! { dg-error "'inscan' REDUCTION clause on construct other than DO, SIMD, DO SIMD, PARALLEL DO, PARALLEL DO SIMD" }
+  ! { dg-error "With INSCAN at .1., expected loop body with ..OMP SCAN between two structured-block-sequences" "" { target *-*-* } .-1 }
 do i = 1, 64
 end do
 !$omp target teams loop reduction(inscan, +: r)  ! { dg-error "'inscan' REDUCTION clause on construct other than DO, SIMD, DO SIMD, PARALLEL DO, PARALLEL DO SIMD" }
+  ! { dg-error "With INSCAN at .1., expected loop body with ..OMP SCAN between two structured-block-sequences" "" { target *-*-* } .-1 }
 do i = 1, 64
 end do
 !$omp target parallel loop reduction(inscan, +: r)  ! { dg-error "'inscan' REDUCTION clause on construct other than DO, SIMD, DO SIMD, PARALLEL DO, PARALLEL DO SIMD" }
+  ! { dg-error "With INSCAN at .1., expected loop body with ..OMP SCAN between two structured-block-sequences" "" { target *-*-* } .-1 }
 do i = 1, 64
 end do
 

diff --git a/gcc/testsuite/gfortran.dg/gomp/loop-5.f90 b/gcc/testsuite/gfortran.dg/gomp/loop-5.f90
new file mode 100644 (file)
index 0000000..1948e78
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/loop-5.f90
@@ -0,0 +1,84 @@
+! { dg-additional-options "-fdump-tree-original" }
+!
+! PR fortran/108512
+
+! The problem was that the context wasn't reset for the 'LOOP'
+! such that the clauses of the loops weren't seen when adding
+! PRIVATE clauses.
+!
+! In the following, only the loop variable of the non-OpenMP loop
+! in 'subroutine four' should get a front-end addded PRIVATE clause
+
+implicit none
+integer :: x, a(10), b(10), n
+    n = 10
+    a = -42
+    b = [(2*x, x=1,10)]
+
+! { dg-final { scan-tree-dump-times "#pragma omp target map\\(tofrom:a\\) map\\(tofrom:b\\) map\\(tofrom:x\\)\[\r\n\]" 1 "original" } }
+! { dg-final { scan-tree-dump-times "#pragma omp parallel\[\r\n\]" 2 "original" } }
+!  ^- shows up twice; checked only here.
+! { dg-final { scan-tree-dump-times "#pragma omp loop lastprivate\\(x\\)\[\r\n\]" 1 "original" } }
+
+    !$omp target parallel map(tofrom: a, b, x)
+    !$omp loop lastprivate(x)
+    DO x = 1, n
+      a(x) = a(x) + b(x)
+    END DO
+    !$omp end loop
+    !$omp end target parallel
+    if (x /= 11) error stop
+    if (any (a /= [(2*x - 42, x=1,10)])) error stop
+    call two()
+    call three()
+    call four()
+end
+
+subroutine two
+  implicit none
+  integer :: ii, mm, arr(10)
+  mm = 10
+  arr = 0
+
+! { dg-final { scan-tree-dump-times "#pragma omp target map\\(tofrom:arr\\) map\\(tofrom:ii\\)\[\r\n\]" 1 "original" } }
+! { dg-final { scan-tree-dump-times "#pragma omp parallel shared\\(ii\\)\[\r\n\]" 1 "original" } }
+! { dg-final { scan-tree-dump-times "#pragma omp loop lastprivate\\(ii\\)\[\r\n\]" 1 "original" } }
+
+  !$omp target parallel loop map(tofrom: arr) lastprivate(ii)
+    DO ii = 1, mm
+      arr(ii) = arr(ii) + ii
+    END DO
+end
+
+subroutine three
+  implicit none
+  integer :: kk, zz, var(10)
+  zz = 10
+  var = 0
+
+! { dg-final { scan-tree-dump-times "#pragma omp target map\\(tofrom:var\\)\[\r\n\]" 1 "original" } }
+! "#pragma omp parallel\[\r\n\]" - shows up twice, dump checked above
+! { dg-final { scan-tree-dump-times "#pragma omp loop\[\r\n\]" 1 "original" } }
+
+  !$omp target parallel loop map(tofrom: var)
+    DO kk = 1, zz
+      var(kk) = var(kk) + kk
+    END DO
+end
+
+subroutine four
+  implicit none
+  integer :: jj, qq, dist(10)
+  qq = 10
+  dist = 0
+
+! { dg-final { scan-tree-dump-times "#pragma omp target map\\(tofrom:dist\\)\[\r\n\]" 1 "original" } }
+! { dg-final { scan-tree-dump-times "#pragma omp parallel private\\(jj\\)\[\r\n\]" 1 "original" } }
+
+  !$omp target parallel map(tofrom: dist)
+    ! *no* '!$omp do/loop/simd'
+    DO jj = 1, qq
+      dist(qq) = dist(qq) + qq
+    END DO
+  !$omp end target parallel
+end

diff --git a/gcc/testsuite/gfortran.dg/gomp/taskloop-2.f90 b/gcc/testsuite/gfortran.dg/gomp/taskloop-2.f90
index 21427623584add871de238a9c12e2dbab6b038c9..41b4d6d21913c5fcdf5d9a977f29512eeaedf3db 100644 (file)
--- a/gcc/testsuite/gfortran.dg/gomp/taskloop-2.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/taskloop-2.f90
@@ -27,9 +27,11 @@ end do
 do i = 1, 64                                 ! { dg-error "OMP SCAN between two structured-block-sequences" "" { target *-*-* } .-1 }
 end do
 !$omp master taskloop reduction(inscan, +: r) ! { dg-error "'inscan' REDUCTION clause on construct other than DO, SIMD, DO SIMD, PARALLEL DO, PARALLEL DO SIMD" }
+  ! { dg-error "With INSCAN at .1., expected loop body with ..OMP SCAN between two structured-block-sequences" "" { target *-*-* } .-1 }
 do i = 1, 64
 end do
 !$omp master taskloop simd reduction(inscan, +: r)  ! { dg-error "'inscan' REDUCTION clause on construct other than DO, SIMD, DO SIMD, PARALLEL DO, PARALLEL DO SIMD" }
+  ! { dg-error "With INSCAN at .1., expected loop body with ..OMP SCAN between two structured-block-sequences" "" { target *-*-* } .-1 }
 do i = 1, 64
 end do
 !$omp parallel master taskloop reduction(inscan, +: r)  ! { dg-error "'inscan' REDUCTION clause on construct other than DO, SIMD, DO SIMD, PARALLEL DO, PARALLEL DO SIMD" }