diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
index 2a02bc871bc82af169448020f831ea84d05bffc6..71d0e7d00f53c0e3a20ffca2e19852e3d9c8c3c1 100644
--- 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 20cce5cf39bb75ab057f3f9f8f890ceed1459aff..48b2ab14fdbb057e387579164f2aa830455409b6 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1365,7 +1365,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 16f39a4e08606e99ef341344e8a4c1be9d3a8885..ec116206a5c78072f40bd1117d10694128e5bbc0 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -766,6 +766,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,
@@ -1549,6 +1550,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)
@@ -2575,7 +2583,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)
@@ -2583,7 +2591,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 f6a39edf121f66bc1966c78fa5a879f8062cf420..076efb03831f6dc6aef3e94043d25db0ab04b6a2 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -3371,6 +3371,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);
@@ -4970,6 +4976,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)
{
@@ -5015,6 +5023,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)
{
@@ -5029,6 +5039,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/gfortran.dg/gomp/order-3.f90 b/gcc/testsuite/gfortran.dg/gomp/order-3.f90
new file mode 100644
index 0000000000000000000000000000000000000000..06df89fc39256471318ee4b4b97205074da7e626
--- /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
index 0000000000000000000000000000000000000000..e4580e38b89a57a2ef402422f9f9a57f57081cda
--- /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