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