OpenMP: Handle order(concurrent) clause in gfortran

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

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

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