* [Patch] OpenMP: Handle order(concurrent) clause in gfortran
@ 2020-07-29 16:30 Tobias Burnus
2020-07-29 16:34 ` Jakub Jelinek
2021-03-25 10:53 ` Thomas Schwinge
0 siblings, 2 replies; 3+ messages in thread
From: Tobias Burnus @ 2020-07-29 16:30 UTC (permalink / raw)
To: Jakub Jelinek, gcc-patches, fortran
[-- Attachment #1: Type: text/plain, Size: 431 bytes --]
Adds 'order(concurrent)'. OpenMP 5.0 also permits it
for 'loop' but gfortran does not yet support 'loop'.
(That the argument is passed on to the ME can be
seen by the testcases as the errors are emitted
by the ME.)
OK?
Tobias
-----------------
Mentor Graphics (Deutschland) GmbH, Arnulfstraße 201, 80634 München / Germany
Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Alexander Walter
[-- Attachment #2: omp-order-concurrent.diff --]
[-- Type: text/x-patch, Size: 15772 bytes --]
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.
gcc/fortran/dump-parse-tree.c | 2 +
gcc/fortran/gfortran.h | 2 +-
gcc/fortran/openmp.c | 12 +-
gcc/fortran/trans-openmp.c | 12 ++
gcc/testsuite/gfortran.dg/gomp/order-3.f90 | 227 +++++++++++++++++++++++++++++
gcc/testsuite/gfortran.dg/gomp/order-4.f90 | 34 +++++
6 files changed, 286 insertions(+), 3 deletions(-)
diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
index 2a02bc871bc..71d0e7d00f5 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 20cce5cf39b..48b2ab14fdb 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 16f39a4e086..ec116206a5c 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 f6a39edf121..076efb03831 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 00000000000..06df89fc392
--- /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 00000000000..e4580e38b89
--- /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
^ permalink raw reply [flat|nested] 3+ messages in thread
* Re: [Patch] OpenMP: Handle order(concurrent) clause in gfortran
2020-07-29 16:30 [Patch] OpenMP: Handle order(concurrent) clause in gfortran Tobias Burnus
@ 2020-07-29 16:34 ` Jakub Jelinek
2021-03-25 10:53 ` Thomas Schwinge
1 sibling, 0 replies; 3+ messages in thread
From: Jakub Jelinek @ 2020-07-29 16:34 UTC (permalink / raw)
To: Tobias Burnus; +Cc: gcc-patches, fortran
On Wed, Jul 29, 2020 at 06:30:16PM +0200, Tobias Burnus wrote:
> Adds 'order(concurrent)'. OpenMP 5.0 also permits it
> for 'loop' but gfortran does not yet support 'loop'.
>
> (That the argument is passed on to the ME can be
> seen by the testcases as the errors are emitted
> by the ME.)
>
> OK?
Ok, thanks.
Jakub
^ permalink raw reply [flat|nested] 3+ messages in thread
* Re: [Patch] OpenMP: Handle order(concurrent) clause in gfortran
2020-07-29 16:30 [Patch] OpenMP: Handle order(concurrent) clause in gfortran Tobias Burnus
2020-07-29 16:34 ` Jakub Jelinek
@ 2021-03-25 10:53 ` Thomas Schwinge
1 sibling, 0 replies; 3+ messages in thread
From: Thomas Schwinge @ 2021-03-25 10:53 UTC (permalink / raw)
To: Tobias Burnus, gcc-patches; +Cc: Jakub Jelinek, fortran
[-- Attachment #1: Type: text/plain, Size: 18260 bytes --]
Hi!
On 2020-07-29T18:30:16+0200, Tobias Burnus <tobias@codesourcery.com> wrote:
> Adds 'order(concurrent)'. OpenMP 5.0 also permits it
> for 'loop' but gfortran does not yet support 'loop'.
>
> (That the argument is passed on to the ME can be
> seen by the testcases as the errors are emitted
> by the ME.)
This later got cherry-picked into devel/omp/gcc-10 branch, with FAILing
testcase 'gfortran.dg/gomp/order-4.f90'. I've now pushed "Adjust
'gfortran.dg/gomp/order-4.f90' for og10" to devel/omp/gcc-10 branch in
commit b0e5c3b84ef2c477fe797da59a1aadfbed8445fe, see attached.
Grüße
Thomas
> 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.
>
> gcc/fortran/dump-parse-tree.c | 2 +
> gcc/fortran/gfortran.h | 2 +-
> gcc/fortran/openmp.c | 12 +-
> gcc/fortran/trans-openmp.c | 12 ++
> gcc/testsuite/gfortran.dg/gomp/order-3.f90 | 227 +++++++++++++++++++++++++++++
> gcc/testsuite/gfortran.dg/gomp/order-4.f90 | 34 +++++
> 6 files changed, 286 insertions(+), 3 deletions(-)
>
> diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
> index 2a02bc871bc..71d0e7d00f5 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 20cce5cf39b..48b2ab14fdb 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 16f39a4e086..ec116206a5c 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 f6a39edf121..076efb03831 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 00000000000..06df89fc392
> --- /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 00000000000..e4580e38b89
> --- /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
-----------------
Mentor Graphics (Deutschland) GmbH, Arnulfstrasse 201, 80634 München Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Frank Thürauf
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Adjust-gfortran.dg-gomp-order-4.f90-for-og10.og10.patch --]
[-- Type: text/x-diff, Size: 2548 bytes --]
From b0e5c3b84ef2c477fe797da59a1aadfbed8445fe Mon Sep 17 00:00:00 2001
From: Thomas Schwinge <thomas@codesourcery.com>
Date: Fri, 16 Oct 2020 11:20:21 +0200
Subject: [PATCH] Adjust 'gfortran.dg/gomp/order-4.f90' for og10
Testcase added in og10 commit 835160b024ce34bc6f258e7df366bb5c15e12a4b "OpenMP:
Handle order(concurrent) clause in gfortran" (cherry picked from commit
d8140b9ed3c0fed041aedaff3fa4a603984ca10f), but og10 doesn't have commit
4f2ab6b89e170f1343f935761481c3745fe603b1 "[OpenMP, gimplifier] 'inform' after
'error' diagnostic".
gcc/testsuite/
* gfortran.dg/gomp/order-4.f90: Adjust.
---
gcc/testsuite/ChangeLog.omp | 4 ++++
gcc/testsuite/gfortran.dg/gomp/order-4.f90 | 7 ++++---
2 files changed, 8 insertions(+), 3 deletions(-)
diff --git a/gcc/testsuite/ChangeLog.omp b/gcc/testsuite/ChangeLog.omp
index d010ff87307c..97cad18a0692 100644
--- a/gcc/testsuite/ChangeLog.omp
+++ b/gcc/testsuite/ChangeLog.omp
@@ -1,3 +1,7 @@
+2021-03-25 Thomas Schwinge <thomas@codesourcery.com>
+
+ * gfortran.dg/gomp/order-4.f90: Adjust.
+
2021-02-25 Tobias Burnus <tobias@codesourcery.com>
Backport from mainline
diff --git a/gcc/testsuite/gfortran.dg/gomp/order-4.f90 b/gcc/testsuite/gfortran.dg/gomp/order-4.f90
index e4580e38b89a..e3863b6805bf 100644
--- a/gcc/testsuite/gfortran.dg/gomp/order-4.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/order-4.f90
@@ -7,7 +7,7 @@ subroutine f1
use m
implicit none
integer :: i
- !$omp simd order(concurrent) ! { dg-message "note: enclosing region" } */
+ !$omp simd order(concurrent) ! { dg-error "enclosing region" }
do i = 1, 64
t = t + 1 ! { dg-error "threadprivate variable 't' used in a region with 'order\\(concurrent\\)' clause" } */
end do
@@ -17,9 +17,10 @@ subroutine f2
use m
implicit none
integer :: i
- !$omp do simd order(concurrent) ! { dg-message "note: enclosing region" } */
+ !$omp do simd order(concurrent) ! { dg-error "enclosing region" }
do i = 1, 64
t = t + 1 ! { dg-error "threadprivate variable 't' used in a region with 'order\\(concurrent\\)' clause" } */
+ ! { dg-error "enclosing region" "" { target *-*-* } .-1 }
end do
end
@@ -27,7 +28,7 @@ subroutine f3
use m
implicit none
integer :: i
- !$omp do order(concurrent) ! { dg-message "note: enclosing region" } */
+ !$omp do order(concurrent) ! { dg-error "enclosing region" }
do i = 1, 64
t = t + 1 ! { dg-error "threadprivate variable 't' used in a region with 'order\\(concurrent\\)' clause" } */
end do
--
2.30.2
^ permalink raw reply [flat|nested] 3+ messages in thread
end of thread, other threads:[~2021-03-25 10:53 UTC | newest]
Thread overview: 3+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2020-07-29 16:30 [Patch] OpenMP: Handle order(concurrent) clause in gfortran Tobias Burnus
2020-07-29 16:34 ` Jakub Jelinek
2021-03-25 10:53 ` Thomas Schwinge
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).