From patchwork Fri Sep 17 21:42:13 2021 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 45147 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id E9263385B83B for ; Fri, 17 Sep 2021 21:42:41 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from esa3.mentor.iphmx.com (esa3.mentor.iphmx.com [68.232.137.180]) by sourceware.org (Postfix) with ESMTPS id 59C7F385840D; Fri, 17 Sep 2021 21:42:21 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 59C7F385840D Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=codesourcery.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=mentor.com IronPort-SDR: yNV5CvNh+0hE3KrXcZDAAZ3WGSK0L4dRMo+4R2Dc2dELlUlrKGCBd9CSpe9Psi+sFjXLkyONyN 0Z5j4zGRiB0MZVtd44cEdhrgiCkwJySXZGibZiO9RgAMBXgWvRtchAiwl9caRskZaQ2tE8heyH g0H7cHbZTYbJ6wek2+NpgeJ9gQdilfRtaENGEIX8AFObqvlyknhL3MRrCJXIWs/wrrF0zaOgrf VF2K2co3dJybEUUIKJl3phgmSD3O3YjHNGorn5MRyNE8XW/XWZ8WbqgucxeKYZbpzhYYM3LTsF 9ZALrB15EafQqphXxU0rscmz X-IronPort-AV: E=Sophos;i="5.85,302,1624348800"; d="diff'?scan'208";a="65998005" Received: from orw-gwy-02-in.mentorg.com ([192.94.38.167]) by esa3.mentor.iphmx.com with ESMTP; 17 Sep 2021 13:42:20 -0800 IronPort-SDR: Ydav4p7SIevIrxRq8w4JyZcekR5TlOvqHz0lnsweMqC77Yp1HaTgHLLo8j8eXfkhIjbz09c+/P Tz3IHAKdjGU4YTCR0srOaJB6GWi0vhbxaBi2JbM5lPQ2CAqQrZ5q3EL7JpDFkJ/ObgXsfcCDI+ +kGQXj++fgyIcS8Y51rYm6l4yGOInGYKTM7wev4dwkH8jb4Lf5y+9v5f2Sd6y8WzA/DCAHpXXf pKjV6an7NGnEjQJp1ZTjtK5w5bXO7C0QB0bxJanhSJP7JDOEPkS3/tVkqZOim4AQluWz9TBz+v oZI= To: Jakub Jelinek , gcc-patches , fortran From: Tobias Burnus Subject: [Patch] Fortran/OpenMP: unconstrained/reproducible ordered modifier Message-ID: <68b73c25-9e9d-ad04-88cf-03891ddc8ab9@codesourcery.com> Date: Fri, 17 Sep 2021 23:42:13 +0200 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:78.0) Gecko/20100101 Thunderbird/78.14.0 MIME-Version: 1.0 Content-Language: en-US X-Originating-IP: [137.202.0.90] X-ClientProxiedBy: svr-ies-mbx-06.mgc.mentorg.com (139.181.222.6) To svr-ies-mbx-01.mgc.mentorg.com (139.181.222.1) X-Spam-Status: No, score=-11.6 required=5.0 tests=BAYES_00, GIT_PATCH_0, HEADER_FROM_DIFFERENT_DOMAINS, KAM_DMARC_STATUS, SPF_HELO_PASS, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.4 X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces+patchwork=sourceware.org@gcc.gnu.org Sender: "Gcc-patches" This patch adds Fortran support for the new OpenMP 5.1 unconstrained and reproducible modifiers to ordered(concurrent). This patch requires Jakub's patch to handle the middle-end (and C/C++) part, which still has to be committed. The testcases are based on the C/C++ ones. OK? Tobias ----------------- Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955 Fortran/OpenMP: unconstrained/reproducible ordered modifier gcc/fortran/ChangeLog: * gfortran.h (gfc_omp_clauses): Add order_unconstrained. * dump-parse-tree.c (show_omp_clauses): Dump it. * openmp.c (gfc_match_omp_clauses): Match unconstrained/reproducible modifiers to ordered(concurrent). (OMP_DISTRIBUTE_CLAUSES): Accept ordered clause. (resolve_omp_clauses): Reject ordered + order on same directive. * trans-openmp.c (gfc_trans_omp_clauses, gfc_split_omp_clauses): Pass on unconstrained modifier of ordered(concurrent). gcc/testsuite/ChangeLog: * gfortran.dg/gomp/order-5.f90: New test. * gfortran.dg/gomp/order-6.f90: New test. * gfortran.dg/gomp/order-7.f90: New test. * gfortran.dg/gomp/order-8.f90: New test. * gfortran.dg/gomp/order-9.f90: New test. gcc/fortran/dump-parse-tree.c | 7 +- gcc/fortran/gfortran.h | 3 +- gcc/fortran/openmp.c | 25 +- gcc/fortran/trans-openmp.c | 7 + gcc/testsuite/gfortran.dg/gomp/order-5.f90 | 129 +++++++++ gcc/testsuite/gfortran.dg/gomp/order-6.f90 | 436 +++++++++++++++++++++++++++++ gcc/testsuite/gfortran.dg/gomp/order-7.f90 | 59 ++++ gcc/testsuite/gfortran.dg/gomp/order-8.f90 | 61 ++++ gcc/testsuite/gfortran.dg/gomp/order-9.f90 | 35 +++ 9 files changed, 756 insertions(+), 6 deletions(-) diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c index a1df47c2f82..28eb09e261d 100644 --- a/gcc/fortran/dump-parse-tree.c +++ b/gcc/fortran/dump-parse-tree.c @@ -1630,7 +1630,12 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses) if (omp_clauses->independent) fputs (" INDEPENDENT", dumpfile); if (omp_clauses->order_concurrent) - fputs (" ORDER(CONCURRENT)", dumpfile); + { + fputs (" ORDER(", dumpfile); + if (omp_clauses->order_unconstrained) + fputs ("UNCONSTRAINED:", dumpfile); + fputs ("CONCURRENT)", dumpfile); + } if (omp_clauses->ordered) { if (omp_clauses->orderedc) diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index fdf556eef3d..8b91225d659 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -1491,7 +1491,8 @@ typedef struct gfc_omp_clauses unsigned inbranch:1, notinbranch:1, nogroup:1; unsigned sched_simd:1, sched_monotonic:1, sched_nonmonotonic:1; unsigned simd:1, threads:1, depend_source:1, destroy:1, order_concurrent:1; - unsigned capture:1, grainsize_strict:1, num_tasks_strict:1; + unsigned order_unconstrained:1, capture:1, grainsize_strict:1; + unsigned num_tasks_strict:1; ENUM_BITFIELD (gfc_omp_sched_kind) sched_kind:3; ENUM_BITFIELD (gfc_omp_device_type) device_type:2; ENUM_BITFIELD (gfc_omp_memorder) memorder:3; diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index a64b7f5aa10..9ee52d6b0ea 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -2369,9 +2369,23 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, break; case 'o': if ((mask & OMP_CLAUSE_ORDER) - && !c->order_concurrent - && gfc_match ("order ( concurrent )") == MATCH_YES) + && (m = gfc_match_dupl_check (!c->order_concurrent, "order (")) + != MATCH_NO) { + if (m == MATCH_ERROR) + goto error; + if (gfc_match (" reproducible : concurrent )") == MATCH_YES + || gfc_match (" concurrent )") == MATCH_YES) + ; + else if (gfc_match (" unconstrained : concurrent )") == MATCH_YES) + c->order_unconstrained = true; + else + { + gfc_error ("Expected ORDER(CONCURRENT) at %C " + "with optional % or " + "% modifier"); + goto error; + } c->order_concurrent = true; continue; } @@ -3475,7 +3489,8 @@ cleanup: | OMP_CLAUSE_SHARED | OMP_CLAUSE_REDUCTION) #define OMP_DISTRIBUTE_CLAUSES \ (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE \ - | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_COLLAPSE | OMP_CLAUSE_DIST_SCHEDULE) + | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_COLLAPSE | OMP_CLAUSE_DIST_SCHEDULE \ + | OMP_CLAUSE_ORDER) #define OMP_SINGLE_CLAUSES \ (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE) #define OMP_ORDERED_CLAUSES \ @@ -5643,7 +5658,9 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, if (omp_clauses->orderedc && omp_clauses->orderedc < omp_clauses->collapse) gfc_error ("ORDERED clause parameter is less than COLLAPSE at %L", &code->loc); - + if (omp_clauses->order_concurrent && omp_clauses->ordered) + gfc_error ("ORDER clause must not be used together ORDERED at %L", + &code->loc); if (omp_clauses->if_expr) { gfc_expr *expr = omp_clauses->if_expr; diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c index e55e0c81868..4ca2c3f9e7f 100644 --- a/gcc/fortran/trans-openmp.c +++ b/gcc/fortran/trans-openmp.c @@ -3803,6 +3803,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, if (clauses->order_concurrent) { c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_ORDER); + OMP_CLAUSE_ORDER_UNCONSTRAINED (c) = clauses->order_unconstrained; omp_clauses = gfc_trans_add_clause (c, omp_clauses); } @@ -5892,6 +5893,8 @@ gfc_split_omp_clauses (gfc_code *code, = code->ext.omp_clauses->collapse; clausesa[GFC_OMP_SPLIT_DISTRIBUTE].order_concurrent = code->ext.omp_clauses->order_concurrent; + clausesa[GFC_OMP_SPLIT_DISTRIBUTE].order_unconstrained + = code->ext.omp_clauses->order_unconstrained; } if (mask & GFC_OMP_MASK_PARALLEL) { @@ -5946,6 +5949,8 @@ gfc_split_omp_clauses (gfc_code *code, = code->ext.omp_clauses->collapse; clausesa[GFC_OMP_SPLIT_DO].order_concurrent = code->ext.omp_clauses->order_concurrent; + clausesa[GFC_OMP_SPLIT_DO].order_unconstrained + = code->ext.omp_clauses->order_unconstrained; } if (mask & GFC_OMP_MASK_SIMD) { @@ -5962,6 +5967,8 @@ gfc_split_omp_clauses (gfc_code *code, = code->ext.omp_clauses->if_exprs[OMP_IF_SIMD]; clausesa[GFC_OMP_SPLIT_SIMD].order_concurrent = code->ext.omp_clauses->order_concurrent; + clausesa[GFC_OMP_SPLIT_SIMD].order_unconstrained + = code->ext.omp_clauses->order_unconstrained; /* 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-5.f90 b/gcc/testsuite/gfortran.dg/gomp/order-5.f90 new file mode 100644 index 00000000000..4d9e33642af --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/order-5.f90 @@ -0,0 +1,129 @@ +! { dg-additional-options "-fdump-tree-original" } + +subroutine f1 (a) + integer :: a(*), i + !$omp do order(reproducible:concurrent) + do i = 1, 128 + a(i) = a(i) + 1 + end do + !$omp simd order ( reproducible : concurrent ) + do i = 1, 128 + a(i) = a(i) + 1 + end do + !$omp do simd order(reproducible :concurrent) + do i = 1, 128 + a(i) = a(i) + 1 + end do +end + +subroutine f2 (a) + integer :: a(*), i + !$omp parallel do order(reproducible: concurrent) + do i = 1, 128 + a(i) = a(i) + 1 + end do + !$omp parallel do simd order (reproducible:concurrent) + do i = 1, 128 + a(i) = a(i) + 1 + end do + !$omp teams distribute parallel do order(reproducible:concurrent) + do i = 1, 128 + a(i) = a(i) + 1 + end do + !$omp teams distribute parallel do simd order(reproducible:concurrent) + do i = 1, 128 + a(i) = a(i) + 1 + end do + !$omp teams distribute order(reproducible:concurrent) + do i = 1, 128 + a(i) = a(i) + 1 + end do + !$omp teams + !$omp distribute parallel do order(reproducible:concurrent) + do i = 1, 128 + a(i) = a(i) + 1 + end do + !$omp distribute parallel do simd order(reproducible:concurrent) + do i = 1, 128 + a(i) = a(i) + 1 + end do + !$omp distribute order(reproducible:concurrent) + do i = 1, 128 + a(i) = a(i) + 1 + end do + !$omp end teams + !$omp taskloop simd order (reproducible:concurrent) + do i = 1, 128 + a(i) = a(i) + 1 + end do +end + +subroutine f3 (a) + integer :: a(*), i + !$omp do order(unconstrained:concurrent) + do i = 1, 128 + a(i) = a(i) + 1 + end do + !$omp simd order ( unconstrained : concurrent ) + do i = 1, 128 + a(i) = a(i) + 1 + end do + !$omp do simd order(unconstrained :concurrent) + do i = 1, 128 + a(i) = a(i) + 1 + end do +end + +subroutine f4 (a) + integer :: a(*), i + !$omp parallel do order(unconstrained: concurrent) + do i = 1, 128 + a(i) = a(i) + 1 + end do + !$omp parallel do simd order (unconstrained:concurrent) + do i = 1, 128 + a(i) = a(i) + 1 + end do + !$omp teams distribute parallel do order(unconstrained:concurrent) + do i = 1, 128 + a(i) = a(i) + 1 + end do + !$omp teams distribute parallel do simd order(unconstrained:concurrent) + do i = 1, 128 + a(i) = a(i) + 1 + end do + !$omp teams distribute order(unconstrained:concurrent) + do i = 1, 128 + a(i) = a(i) + 1 + end do + !$omp teams + !$omp distribute parallel do order(unconstrained:concurrent) + do i = 1, 128 + a(i) = a(i) + 1 + end do + !$omp distribute parallel do simd order(unconstrained:concurrent) + do i = 1, 128 + a(i) = a(i) + 1 + end do + !$omp distribute order(unconstrained:concurrent) + do i = 1, 128 + a(i) = a(i) + 1 + end do + !$omp end teams + !$omp taskloop simd order (unconstrained:concurrent) + do i = 1, 128 + a(i) = a(i) + 1 + end do +end + +! { dg-final { scan-tree-dump-times "#pragma omp distribute order\\(concurrent\\)" 6 "original"} } +! { dg-final { scan-tree-dump-times "#pragma omp distribute order\\(unconstrained:concurrent\\)" 6 "original"} } +! { dg-final { scan-tree-dump-times "#pragma omp for nowait order\\(concurrent\\)" 6 "original"} } +! { dg-final { scan-tree-dump-times "#pragma omp for nowait order\\(unconstrained:concurrent\\)" 6 "original"} } +! { dg-final { scan-tree-dump-times "#pragma omp for order\\(concurrent\\)" 2 "original"} } +! { dg-final { scan-tree-dump-times "#pragma omp for order\\(unconstrained:concurrent\\)" 2 "original"} } +! { dg-final { scan-tree-dump-times "#pragma omp parallel" 12 "original"} } +! { dg-final { scan-tree-dump-times "#pragma omp simd linear\\(i:1\\) order\\(concurrent\\)" 6 "original"} } +! { dg-final { scan-tree-dump-times "#pragma omp simd linear\\(i:1\\) order\\(unconstrained:concurrent\\)" 6 "original"} } +! { dg-final { scan-tree-dump-times "#pragma omp taskloop" 2 "original"} } +! { dg-final { scan-tree-dump-times "#pragma omp teams" 8 "original"} } diff --git a/gcc/testsuite/gfortran.dg/gomp/order-6.f90 b/gcc/testsuite/gfortran.dg/gomp/order-6.f90 new file mode 100644 index 00000000000..c8aeecb6f27 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/order-6.f90 @@ -0,0 +1,436 @@ +module m + use iso_c_binding + implicit none (type, external) + interface + subroutine foo() + end subroutine foo + integer function omp_get_thread_num () + end + integer function omp_get_num_threads () + end + integer function omp_target_is_present (x, i) + import :: c_ptr + type(c_ptr) :: x + integer, value :: i + end + integer function omp_get_cancellation () + end + end interface + integer :: v +contains +subroutine f1 (a) + integer, target :: a(*) + integer :: i + !$omp simd order(reproducible: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 simd order(reproducible:concurrent) + do i = 1, 64 + block + integer j + !$omp simd + do j = 1, 64 + a(64 * i + j) = i + j + end do + end block + end do + !$omp simd order(reproducible: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(reproducible: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(reproducible: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(reproducible: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(reproducible: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(reproducible: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(reproducible: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(reproducible: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(reproducible: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) + integer, target :: a(*) + integer :: i + !$omp do simd order(reproducible: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(reproducible:concurrent) + do i = 1, 64 + block + integer j + !$omp simd + do j = 1, 64 + a(64 * i + j) = i + j + end do + end block + end do + !$omp do simd order(reproducible: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(reproducible: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(reproducible: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(reproducible: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(reproducible: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(reproducible: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(reproducible: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(reproducible: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(reproducible: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) + integer, target :: a(*) + integer :: i + !$omp do order(reproducible:concurrent) + do i = 1, 64 + !$omp parallel + call foo () + !$omp end parallel + end do + !$omp do order(reproducible:concurrent) + do i = 1, 64 + block + integer j + !$omp simd + do j = 1, 64 + a(64 * i + j) = i + j + end do + end block + end do + !$omp do order(reproducible: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(reproducible: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(reproducible: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(reproducible: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(reproducible: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(reproducible: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(reproducible:concurrent) + do i = 1, 64 + block + integer j + !$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 + a(64 * i + j) = i + j + end do + end block + end do + !$omp do order(reproducible: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(reproducible: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(reproducible: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(reproducible: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 f4 (a) + integer, target :: a(*) + integer :: i + !$omp simd order(unconstrained: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 simd order(unconstrained:concurrent) + do i = 1, 64 + block + integer j + !$omp simd + do j = 1, 64 + a(64 * i + j) = i + j + end do + end block + end do + !$omp simd order(unconstrained: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(unconstrained: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(unconstrained: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(unconstrained: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(unconstrained: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(unconstrained: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(unconstrained: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(unconstrained: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(unconstrained: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 f5 (a) + integer, target :: a(*) + integer :: i + !$omp do simd order(unconstrained: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(unconstrained:concurrent) + do i = 1, 64 + block + integer j + !$omp simd + do j = 1, 64 + a(64 * i + j) = i + j + end do + end block + end do + !$omp do simd order(unconstrained: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(unconstrained: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(unconstrained: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(unconstrained: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(unconstrained: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(unconstrained: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(unconstrained: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(unconstrained: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(unconstrained: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 f6 (a) + integer, target :: a(*) + integer :: i + !$omp do order(unconstrained:concurrent) + do i = 1, 64 + !$omp parallel + call foo () + !$omp end parallel + end do + !$omp do order(unconstrained:concurrent) + do i = 1, 64 + block + integer j + !$omp simd + do j = 1, 64 + a(64 * i + j) = i + j + end do + end block + end do + !$omp do order(unconstrained: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(unconstrained: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(unconstrained: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(unconstrained: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(unconstrained: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(unconstrained: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(unconstrained:concurrent) + do i = 1, 64 + block + integer j + !$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 + a(64 * i + j) = i + j + end do + end block + end do + !$omp do order(unconstrained: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(unconstrained: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(unconstrained: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(unconstrained: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 +end module m diff --git a/gcc/testsuite/gfortran.dg/gomp/order-7.f90 b/gcc/testsuite/gfortran.dg/gomp/order-7.f90 new file mode 100644 index 00000000000..4be8ab37233 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/order-7.f90 @@ -0,0 +1,59 @@ +subroutine f1 (a) + integer :: a(*) + integer i + !$omp do order(concurrent) + do i = 1, 128 + a(i) = a(i) + 1 + end do + !$omp simd order ( concurrent ) + do i = 1, 128 + a(i) = a(i) + 1 + end do + !$omp do simd order(concurrent) + do i = 1, 128 + a(i) = a(i) + 1 + end do +end + +subroutine f2 (a) + integer :: a(*) + integer i + !$omp parallel do order(concurrent) + do i = 1, 128 + a(i) = a(i) + 1 + end do + !$omp parallel do simd order (concurrent) + do i = 1, 128 + a(i) = a(i) + 1 + end do + !$omp teams distribute parallel do order(concurrent) + do i = 1, 128 + a(i) = a(i) + 1 + end do + !$omp teams distribute parallel do simd order(concurrent) + do i = 1, 128 + a(i) = a(i) + 1 + end do + !$omp teams distribute order(concurrent) + do i = 1, 128 + a(i) = a(i) + 1 + end do + !$omp teams + !$omp distribute parallel do order(concurrent) + do i = 1, 128 + a(i) = a(i) + 1 + end do + !$omp distribute parallel do simd order(concurrent) + do i = 1, 128 + a(i) = a(i) + 1 + end do + !$omp distribute order(concurrent) + do i = 1, 128 + a(i) = a(i) + 1 + end do + !$omp end teams + !$omp taskloop simd order (concurrent) + do i = 1, 128 + a(i) = a(i) + 1 + end do +end diff --git a/gcc/testsuite/gfortran.dg/gomp/order-8.f90 b/gcc/testsuite/gfortran.dg/gomp/order-8.f90 new file mode 100644 index 00000000000..c753886d621 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/order-8.f90 @@ -0,0 +1,61 @@ +subroutine f1 (a) + integer :: a(*) + integer i + !$omp do order ! { dg-error "Failed to match clause" } + do i = 1, 128 + a(i) = a(i) + 1 + end do + !$omp do simd order : ! { dg-error "Failed to match clause" } + do i = 1, 128 + a(i) = a(i) + 1 + end do + !$omp simd order ( foobar ) ! { dg-error "Expected ORDER\\(CONCURRENT\\) at .1. with optional 'reproducible' or 'unconstrained' modifier" } + do i = 1, 128 + a(i) = a(i) + 1 + end do + !$omp do simd order( concurrent ! { dg-error "Expected ORDER\\(CONCURRENT\\) at .1. with optional 'reproducible' or 'unconstrained' modifier" } + do i = 1, 128 + a(i) = a(i) + 1 + end do + !$omp do simd order( concurrent : foo )! { dg-error "Expected ORDER\\(CONCURRENT\\) at .1. with optional 'reproducible' or 'unconstrained' modifier" } + do i = 1, 128 + a(i) = a(i) + 1 + end do +end + +subroutine f2 (a) + integer :: a(*) + integer i + !$omp teams + !$omp distribute order(concurrent) + do i = 1, 128 + a(i) = a(i) + 1 + end do + !$omp end teams + !$omp taskloop order (concurrent) ! { dg-error "Failed to match clause" } + do i = 1, 128 + a(i) = a(i) + 1 + end do + !$omp do order(concurrent) ordered ! { dg-error "ORDER clause must not be used together ORDERED" } + do i = 1, 128 + !$omp ordered + a(i) = a(i) + 1 + !$omp end ordered + end do + !$omp do ordered order(concurrent) ! { dg-error "ORDER clause must not be used together ORDERED" } + do i = 1, 128 + !$omp ordered + a(i) = a(i) + 1 + !$omp end ordered + end do + !$omp do ordered (1) order(concurrent) ! { dg-error "ORDER clause must not be used together ORDERED" } + do i = 1, 128 + !$omp ordered depend (sink: i - 1) + !$omp ordered depend (source) + end do + !$omp do order(concurrent)ordered (1) ! { dg-error "ORDER clause must not be used together ORDERED" } + do i = 1, 128 + !$omp ordered depend (sink: i - 1) + !$omp ordered depend (source) + end do +end diff --git a/gcc/testsuite/gfortran.dg/gomp/order-9.f90 b/gcc/testsuite/gfortran.dg/gomp/order-9.f90 new file mode 100644 index 00000000000..c7695114cde --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/order-9.f90 @@ -0,0 +1,35 @@ +subroutine foo + !$omp do schedule(static) order(concurrent) order(concurrent) ! { dg-error "Duplicated 'order \\(' clause" } + do i = 1, 8 + call f0 () + end do + !$omp do schedule(static) order(reproducible:concurrent) order(unconstrained:concurrent) ! { dg-error "Duplicated 'order \\(' clause" } + do i = 1, 8 + call f0 () + end do + + !$omp loop bind(thread) order(concurrent) order(concurrent) ! { dg-error "Duplicated 'order \\(' clause" } + do i = 1, 8 + call f0 () + end do + !$omp loop bind(thread) order(reproducible:concurrent) order(unconstrained:concurrent) ! { dg-error "Duplicated 'order \\(' clause" } + do i = 1, 8 + call f0 () + end do + !$omp simd order(concurrent) order(concurrent) ! { dg-error "Duplicated 'order \\(' clause" } + do i = 1, 8 + call f0 () + end do + !$omp simd order(reproducible:concurrent) order(unconstrained:concurrent) ! { dg-error "Duplicated 'order \\(' clause" } + do i = 1, 8 + call f0 () + end do + !$omp distribute dist_schedule(static) order(concurrent) order(concurrent) ! { dg-error "Duplicated 'order \\(' clause" } + do i = 1, 8 + call f0 () + end do + !$omp loop bind(thread) order(reproducible:concurrent) order(unconstrained:concurrent) ! { dg-error "Duplicated 'order \\(' clause" } + do i = 1, 8 + call f0 () + end do +end