From d8140b9ed3c0fed041aedaff3fa4a603984ca10f Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Wed, 29 Jul 2020 18:37:13 +0200 Subject: [PATCH] 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(-) create mode 100644 gcc/testsuite/gfortran.dg/gomp/order-3.f90 create mode 100644 gcc/testsuite/gfortran.dg/gomp/order-4.f90 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 -- 2.30.2