OpenMP: Handle order(concurrent) clause in gfortran

gcc/fortran/ChangeLog:

	* dump-parse-tree.c (show_omp_clauses): Handle order(concurrent).
	* gfortran.h (struct gfc_omp_clauses): Add order_concurrent.
	* openmp.c (enum omp_mask1, OMP_DO_CLAUSES, OMP_SIMD_CLAUSES):
	Add OMP_CLAUSE_ORDER.
	* trans-openmp.c (gfc_trans_omp_clauses, gfc_split_omp_clauses):
	Handle order(concurrent) clause.

gcc/testsuite/ChangeLog:

	* gfortran.dg/gomp/order-3.f90: New test.
	* gfortran.dg/gomp/order-4.f90: New test.

(cherry picked from commit d8140b9ed3c0fed041aedaff3fa4a603984ca10f)

diff --git a/gcc/fortran/ChangeLog.omp b/gcc/fortran/ChangeLog.omp
index 38b268e71d6400ee172876f539c159acc6cb9ad0..40ca406ccc6b9d5222f1af23104bc4a814e12b9c 100644 (file)
--- a/gcc/fortran/ChangeLog.omp
+++ b/gcc/fortran/ChangeLog.omp
@@ -1,3 +1,15 @@
+2020-08-21  Tobias Burnus  <tobias@codesourcery.com>
+
+       Backport from mainline
+       2020-07-29  Tobias Burnus  <tobias@codesourcery.com>
+
+       * dump-parse-tree.c (show_omp_clauses): Handle order(concurrent).
+       * gfortran.h (struct gfc_omp_clauses): Add order_concurrent.
+       * openmp.c (enum omp_mask1, OMP_DO_CLAUSES, OMP_SIMD_CLAUSES):
+       Add OMP_CLAUSE_ORDER.
+       * trans-openmp.c (gfc_trans_omp_clauses, gfc_split_omp_clauses):
+       Handle order(concurrent) clause.
+
 2020-08-21  Tobias Burnus  <tobias@codesourcery.com>
 
        Backport from mainline

diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
index 364584d2060c1f58cbe337ab2283fd9df44a1b1b..c34a2a0e12803626a27d1d223c158ccc2732704a 100644 (file)
--- a/gcc/fortran/dump-parse-tree.c
+++ b/gcc/fortran/dump-parse-tree.c
@@ -1552,6 +1552,8 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses)
     fputs (" SEQ", dumpfile);
   if (omp_clauses->independent)
     fputs (" INDEPENDENT", dumpfile);
+  if (omp_clauses->order_concurrent)
+    fputs (" ORDER(CONCURRENT)", dumpfile);
   if (omp_clauses->ordered)
     {
       if (omp_clauses->orderedc)

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 09957c83de8bdc4a387fd6796902be9b5129f0d7..c7842e1f96d5e7df5abc6f36219d27a3af5683a2 100644 (file)
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1350,7 +1350,7 @@ typedef struct gfc_omp_clauses
   bool nowait, ordered, untied, mergeable;
   bool inbranch, notinbranch, defaultmap, nogroup;
   bool sched_simd, sched_monotonic, sched_nonmonotonic;
-  bool simd, threads, depend_source;
+  bool simd, threads, depend_source, order_concurrent;
   enum gfc_omp_cancel_kind cancel;
   enum gfc_omp_proc_bind_kind proc_bind;
   struct gfc_expr *safelen_expr;

diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 8d5f1486bc0387ab3aea9b7c75d2466df32d2c98..32037add7173e64d80a7fb9cafcc3f93fb1e3b79 100644 (file)
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -767,6 +767,7 @@ enum omp_mask1
   OMP_CLAUSE_NUM_THREADS,
   OMP_CLAUSE_SCHEDULE,
   OMP_CLAUSE_DEFAULT,
+  OMP_CLAUSE_ORDER,
   OMP_CLAUSE_ORDERED,
   OMP_CLAUSE_COLLAPSE,
   OMP_CLAUSE_UNTIED,
@@ -1558,6 +1559,13 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
            continue;
          break;
        case 'o':
+         if ((mask & OMP_CLAUSE_ORDER)
+             && !c->order_concurrent
+             && gfc_match ("order ( concurrent )") == MATCH_YES)
+           {
+             c->order_concurrent = true;
+             continue;
+           }
          if ((mask & OMP_CLAUSE_ORDERED)
              && !c->ordered
              && gfc_match ("ordered") == MATCH_YES)
@@ -2587,7 +2595,7 @@ cleanup:
   (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE             \
    | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION                     \
    | OMP_CLAUSE_SCHEDULE | OMP_CLAUSE_ORDERED | OMP_CLAUSE_COLLAPSE    \
-   | OMP_CLAUSE_LINEAR)
+   | OMP_CLAUSE_LINEAR | OMP_CLAUSE_ORDER)
 #define OMP_SECTIONS_CLAUSES \
   (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE             \
    | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION)
@@ -2595,7 +2603,7 @@ cleanup:
   (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_LASTPRIVATE              \
    | OMP_CLAUSE_REDUCTION | OMP_CLAUSE_COLLAPSE | OMP_CLAUSE_SAFELEN   \
    | OMP_CLAUSE_LINEAR | OMP_CLAUSE_ALIGNED | OMP_CLAUSE_SIMDLEN       \
-   | OMP_CLAUSE_IF)
+   | OMP_CLAUSE_IF | OMP_CLAUSE_ORDER)
 #define OMP_TASK_CLAUSES \
   (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE             \
    | OMP_CLAUSE_SHARED | OMP_CLAUSE_IF | OMP_CLAUSE_DEFAULT            \

diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index 9deeded39e7e1ae0f14ce487636a53cbee15ac28..2766d38dc824a1ba0142c97daa6180b6a07cce84 100644 (file)
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -3369,6 +3369,12 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
     }
 
+  if (clauses->order_concurrent)
+    {
+      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_ORDER);
+      omp_clauses = gfc_trans_add_clause (c, omp_clauses);
+    }
+
   if (clauses->untied)
     {
       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_UNTIED);
@@ -4980,6 +4986,8 @@ gfc_split_omp_clauses (gfc_code *code,
          /* Duplicate collapse.  */
          clausesa[GFC_OMP_SPLIT_DISTRIBUTE].collapse
            = code->ext.omp_clauses->collapse;
+         clausesa[GFC_OMP_SPLIT_DISTRIBUTE].order_concurrent
+           = code->ext.omp_clauses->order_concurrent;
        }
       if (mask & GFC_OMP_MASK_PARALLEL)
        {
@@ -5025,6 +5033,8 @@ gfc_split_omp_clauses (gfc_code *code,
          /* Duplicate collapse.  */
          clausesa[GFC_OMP_SPLIT_DO].collapse
            = code->ext.omp_clauses->collapse;
+         clausesa[GFC_OMP_SPLIT_DO].order_concurrent
+           = code->ext.omp_clauses->order_concurrent;
        }
       if (mask & GFC_OMP_MASK_SIMD)
        {
@@ -5039,6 +5049,8 @@ gfc_split_omp_clauses (gfc_code *code,
            = code->ext.omp_clauses->collapse;
          clausesa[GFC_OMP_SPLIT_SIMD].if_exprs[OMP_IF_SIMD]
            = code->ext.omp_clauses->if_exprs[OMP_IF_SIMD];
+         clausesa[GFC_OMP_SPLIT_SIMD].order_concurrent
+           = code->ext.omp_clauses->order_concurrent;
          /* And this is copied to all.  */
          clausesa[GFC_OMP_SPLIT_SIMD].if_expr
            = code->ext.omp_clauses->if_expr;

diff --git a/gcc/testsuite/ChangeLog.omp b/gcc/testsuite/ChangeLog.omp
index 4b5ee0fa9d2b2aee8abb1056a6abdd2278d67cbd..84e67308d1a949819584e9824d9773c4285239d3 100644 (file)
--- a/gcc/testsuite/ChangeLog.omp
+++ b/gcc/testsuite/ChangeLog.omp
@@ -1,3 +1,11 @@
+2020-08-21  Tobias Burnus  <tobias@codesourcery.com>
+
+       Backport from mainline
+       2020-07-29  Tobias Burnus  <tobias@codesourcery.com>
+
+       * gfortran.dg/gomp/order-3.f90: New test.
+       * gfortran.dg/gomp/order-4.f90: New test.
+
 2020-08-21  Tobias Burnus  <tobias@codesourcery.com>
 
        Backport from mainline

diff --git a/gcc/testsuite/gfortran.dg/gomp/order-3.f90 b/gcc/testsuite/gfortran.dg/gomp/order-3.f90
new file mode 100644 (file)
index 0000000..06df89f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/order-3.f90
@@ -0,0 +1,227 @@
+module my_omp_mod
+ use iso_c_binding, only: c_loc
+ implicit none
+ integer :: v
+ interface
+   integer function omp_get_thread_num () bind(C)
+   end
+   integer function omp_get_num_threads () bind(C)
+   end
+   integer function omp_get_cancellation () bind(C)
+   end
+   integer function omp_target_is_present (ptr, device_num) bind(C)
+     use iso_c_binding, only: c_ptr
+     type(c_ptr), value :: ptr
+     integer :: device_num
+   end
+  end interface
+contains
+  subroutine foo ()
+  end
+end 
+
+subroutine f1 (a, b)
+  use my_omp_mod
+  implicit none
+  integer :: a(:), b(:,:)
+  target :: a
+  integer i, j
+  !$omp simd order(concurrent)
+  do i = 1, 64
+    !$omp parallel             ! { dg-error "OpenMP constructs other than 'ordered simd', 'simd', 'loop' or 'atomic' may not be nested inside 'simd' region" }
+    call foo ()
+    !$omp end parallel
+  end do
+  !$omp end simd
+  !$omp simd order(concurrent)
+  do i = 1, 64
+    !$omp simd
+    do j = 1, 64
+      b(j, i) = i + j
+    end do
+  end do
+  !$omp simd order(concurrent)
+  do i = 1, 64
+      !$omp critical           ! { dg-error "OpenMP constructs other than 'ordered simd', 'simd', 'loop' or 'atomic' may not be nested inside 'simd' region" }
+      call foo ()
+      !$omp end critical
+  end do
+  !$omp simd order(concurrent)
+  do i = 1, 64
+    !$omp ordered simd         ! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a region with the 'order\\(concurrent\\)' clause" }
+    call foo ()
+    !$omp end ordered
+  end do
+  !$omp simd order(concurrent)
+  do i = 1, 64
+    !$omp atomic               ! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a region with the 'order\\(concurrent\\)' clause" }
+    v = v + 1
+  end do
+  !$omp simd order(concurrent)
+  do i = 1, 64
+    !$omp atomic read          ! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a region with the 'order\\(concurrent\\)' clause"  }
+    a(i) = v
+  end do
+  !$omp simd order(concurrent)
+  do i = 1, 64
+      !$omp atomic write       ! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a region with the 'order\\(concurrent\\)' clause" }
+      v = a(i)
+  end do
+  !$omp simd order(concurrent)
+  do i = 1, 64
+    a(i) = a(i) + omp_get_thread_num ()  ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_get_thread_num\[^\n\r]*' in a region with 'order\\(concurrent\\)' clause" }
+  end do
+  !$omp simd order(concurrent)
+  do i = 1, 64
+    a(i) = a(i) + omp_get_num_threads ()  ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_get_num_threads\[^\n\r]*' in a region with 'order\\(concurrent\\)' clause" }
+  end do
+  !$omp simd order(concurrent)
+  do i = 1, 64
+    a(i) = a(i) + omp_target_is_present (c_loc(a(i)), 0)  ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_target_is_present\[^\n\r]*' in a region with 'order\\(concurrent\\)' clause" }
+  end do
+  !$omp simd order(concurrent)
+  do i = 1, 64
+    a(i) = a(i) + omp_get_cancellation ()  ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_get_cancellation\[^\n\r]*' in a region with 'order\\(concurrent\\)' clause" }
+  end do
+end
+
+subroutine f2 (a, b)
+  use my_omp_mod
+  implicit none
+  integer a(:), b(:,:)
+  target :: a
+  integer i, j
+  !$omp do simd order(concurrent)
+  do i = 1, 64
+    !$omp parallel             ! { dg-error "OpenMP constructs other than 'ordered simd', 'simd', 'loop' or 'atomic' may not be nested inside 'simd' region" }
+    call foo ()
+    !$omp end parallel
+  end do
+  !$omp do simd order(concurrent)
+  do i = 1, 64
+    !$omp simd
+    do j = 1, 64
+      b (j, i) = i + j
+    end do
+  end do
+  !$omp do simd order(concurrent)
+  do i = 1, 64
+    !$omp critical             ! { dg-error "OpenMP constructs other than 'ordered simd', 'simd', 'loop' or 'atomic' may not be nested inside 'simd' region" }
+    call foo ()
+    !$omp end critical
+  end do
+  !$omp do simd order(concurrent)
+  do i = 1, 64
+    !$omp ordered simd         ! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a region with the 'order\\(concurrent\\)' clause" }
+    call foo ()
+    !$omp end ordered
+  end do
+  !$omp do simd order(concurrent)
+  do i = 1, 64
+    !$omp atomic               ! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a region with the 'order\\(concurrent\\)' clause" }
+    v = v + 1
+  end do
+  !$omp do simd order(concurrent)
+  do i = 1, 64
+    !$omp atomic read          ! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a region with the 'order\\(concurrent\\)' clause" }
+    a(i) = v
+  end do
+  !$omp do simd order(concurrent)
+  do i = 1, 64
+    !$omp atomic write         ! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a region with the 'order\\(concurrent\\)' clause" }
+    v = a(i)
+  end do
+  !$omp do simd order(concurrent)
+  do i = 1, 64
+    a(i) = a(i) + omp_get_thread_num ()  ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_get_thread_num\[^\n\r]*' in a region with 'order\\(concurrent\\)' clause" }
+  end do
+  !$omp do simd order(concurrent)
+  do i = 1, 64
+    a(i) = a(i) + omp_get_num_threads ()  ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_get_num_threads\[^\n\r]*' in a region with 'order\\(concurrent\\)' clause" }
+  end do
+  !$omp do simd order(concurrent)
+  do i = 1, 64
+    a(i) = a(i) + omp_target_is_present (c_loc(a(i)), 0)  ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_target_is_present\[^\n\r]*' in a region with 'order\\(concurrent\\)' clause" }
+  end do
+  !$omp do simd order(concurrent)
+  do i = 1, 64
+    a(i) = a(i) + omp_get_cancellation ()  ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_get_cancellation\[^\n\r]*' in a region with 'order\\(concurrent\\)' clause" }
+  end do
+end
+
+subroutine f3 (a, b)
+  use my_omp_mod
+  implicit none
+  integer :: a(:), b(:,:)
+  target :: a
+  integer i, j
+  !$omp do order(concurrent)
+  do i = 1, 64
+    !$omp parallel
+    call foo ()
+    !$omp end parallel
+  end do
+  !$omp do order(concurrent)
+  do i = 1, 64
+    !$omp simd
+    do j = 1, 64
+      b(j, i) = i + j
+    end do
+  end do
+  !$omp do order(concurrent)
+  do i = 1, 64
+    !$omp critical             ! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a region with the 'order\\(concurrent\\)' clause" }
+    call foo ()
+    !$omp end critical
+  end do
+  !$omp do order(concurrent)
+  do i = 1, 64
+    !$omp ordered simd         ! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a region with the 'order\\(concurrent\\)' clause" }
+    call foo ()
+    !$omp end ordered
+  end do
+  !$omp do order(concurrent)
+  do i = 1, 64
+    !$omp atomic               ! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a region with the 'order\\(concurrent\\)' clause" }
+    v = v + 1
+  end do
+  !$omp do order(concurrent)
+  do i = 1, 64
+    !$omp atomic read          ! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a region with the 'order\\(concurrent\\)' clause" }
+    a(i) = v
+  end do
+  !$omp do order(concurrent)
+  do i = 1, 64
+    !$omp atomic write         ! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a region with the 'order\\(concurrent\\)' clause" }
+    v = a(i)
+  end do
+  !$omp do order(concurrent)
+  do i = 1, 64
+    !$omp task                 ! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a region with the 'order\\(concurrent\\)' clause" }
+    a(i) = a(i) + 1
+    !$omp end task
+  end do
+  !$omp do order(concurrent)
+  do i = 1, 64
+    !$omp taskloop             ! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a region with the 'order\\(concurrent\\)' clause" }
+    do j = 1, 64
+      b(j, i) = i + j
+    end do
+  end do
+  !$omp do order(concurrent)
+  do i = 1, 64
+    a(i) = a(i) + omp_get_thread_num ()  ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_get_thread_num\[^\n\r]*' in a region with 'order\\(concurrent\\)' clause" }
+  end do
+  !$omp do order(concurrent)
+  do i = 1, 64
+    a(i) = a(i) + omp_get_num_threads ()  ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_get_num_threads\[^\n\r]*' in a region with 'order\\(concurrent\\)' clause" }
+  end do
+  !$omp do order(concurrent)
+  do i = 1, 64
+    a(i) = a(i) + omp_target_is_present (c_loc(a(i)), 0)  ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_target_is_present\[^\n\r]*' in a region with 'order\\(concurrent\\)' clause" }
+  end do
+  !$omp do order(concurrent)
+  do i = 1, 64
+    a(i) = a(i) + omp_get_cancellation ()  ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_get_cancellation\[^\n\r]*' in a region with 'order\\(concurrent\\)' clause" }
+  end do
+end

diff --git a/gcc/testsuite/gfortran.dg/gomp/order-4.f90 b/gcc/testsuite/gfortran.dg/gomp/order-4.f90
new file mode 100644 (file)
index 0000000..e4580e3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/order-4.f90
@@ -0,0 +1,34 @@
+module m
+ integer t;
+ !$omp threadprivate(t)
+end
+
+subroutine f1
+  use m
+  implicit none
+  integer :: i
+  !$omp simd order(concurrent)  ! { dg-message "note: enclosing region" } */
+  do i = 1, 64
+    t = t + 1  ! { dg-error "threadprivate variable 't' used in a region with 'order\\(concurrent\\)' clause" } */
+  end do
+end
+
+subroutine f2
+  use m
+  implicit none
+  integer :: i
+  !$omp do simd order(concurrent) ! { dg-message "note: enclosing region" } */
+  do i = 1, 64
+    t = t + 1  ! { dg-error "threadprivate variable 't' used in a region with 'order\\(concurrent\\)' clause" } */
+  end do
+end
+
+subroutine f3
+  use m
+  implicit none
+  integer :: i
+  !$omp do order(concurrent)  ! { dg-message "note: enclosing region" } */
+  do i = 1, 64
+    t = t + 1  ! { dg-error "threadprivate variable 't' used in a region with 'order\\(concurrent\\)' clause" } */
+  end do
+end