From patchwork Wed May 31 19:22:15 2023 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 70406 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 90B973856DD6 for ; Wed, 31 May 2023 19:22:53 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from esa1.mentor.iphmx.com (esa1.mentor.iphmx.com [68.232.129.153]) by sourceware.org (Postfix) with ESMTPS id 7EEF13858CD1; Wed, 31 May 2023 19:22:32 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 7EEF13858CD1 Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=codesourcery.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=mentor.com X-IronPort-AV: E=Sophos;i="6.00,207,1681200000"; d="diff'?scan'208";a="8190323" Received: from orw-gwy-01-in.mentorg.com ([192.94.38.165]) by esa1.mentor.iphmx.com with ESMTP; 31 May 2023 11:22:30 -0800 IronPort-SDR: MIlh5RizXcfEr9aJjTypN2l+Bf9+7RGP2HmKGStkhEW48y66F+MQtZUiuRxJLjVL1liusCGy3l kPpQWPWiu4g9epOiRWH3SmYKhV1TekGIxyMn7cyST4dzfaYMyFHa+pMvxz09mPEcI01CRsYhFf Ysfokzjm/5ZYJjFJp68SqdB8LDt4QfRnpBWVMEF5VJX2ksc3xHlVW9BlNUfHCgqBukg2uxTA6J uastreoEBLRyEDRNYWEJPiSHWoNPGA+VER2AzpfRqmO/sz/0Ya4I8RYIW8FaCd+ehcRPtzdMUu s6Q= Message-ID: Date: Wed, 31 May 2023 21:22:15 +0200 MIME-Version: 1.0 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:102.0) Gecko/20100101 Thunderbird/102.11.2 Content-Language: en-US To: gcc-patches , fortran From: Tobias Burnus Subject: [Patch] OpenMP/Fortran: Permit pure directives inside PURE X-Originating-IP: [137.202.0.90] X-ClientProxiedBy: svr-ies-mbx-15.mgc.mentorg.com (139.181.222.15) To svr-ies-mbx-12.mgc.mentorg.com (139.181.222.12) X-Spam-Status: No, score=-11.3 required=5.0 tests=BAYES_00, GIT_PATCH_0, HEADER_FROM_DIFFERENT_DOMAINS, KAM_DMARC_STATUS, SPF_HELO_PASS, SPF_PASS, TXREP, T_SCC_BODY_TEXT_LINE autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) 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" I intent to commit the attached patch soon. However, I want to give anyone the chance to comment on any aspect before committing. Comments after the commit are welcome as well :-) OpenMP 5.2 now uses properties to clauses and "pure" is among those properties. Note that pure-2.f90 contains also stubs for directives only added in TR11 or TR12 to reduce the chance of missing those once they get implemented. Additionally, 'scan' is 'pure' only since very recently - which I read as bug fix; hence, it is accepted with the attached patch. 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 OpenMP/Fortran: Permit pure directives inside PURE Update permitted directives for directives marked in OpenMP's 5.2 as pure. To ensure that list is updated, unimplemented directives are placed into pure-2.f90 such the test FAILs once a known to be pure directive is implemented without handling its pureness. gcc/fortran/ChangeLog: * parse.cc (decode_omp_directive): Accept all pure directives inside a PURE procedures; handle 'error at(execution). libgomp/ChangeLog: * libgomp.texi (OpenMP 5.2): Mark pure-directive handling as 'Y'. gcc/testsuite/ChangeLog: * gfortran.dg/gomp/nothing-2.f90: Remove one dg-error. * gfortran.dg/gomp/pr79154-2.f90: Update expected dg-error wording. * gfortran.dg/gomp/pr79154-simd.f90: Likewise. * gfortran.dg/gomp/pure-1.f90: New test. * gfortran.dg/gomp/pure-2.f90: New test. * gfortran.dg/gomp/pure-3.f90: New test. * gfortran.dg/gomp/pure-4.f90: New test. gcc/fortran/parse.cc | 50 +++++++++----- gcc/testsuite/gfortran.dg/gomp/nothing-2.f90 | 2 +- gcc/testsuite/gfortran.dg/gomp/pr79154-2.f90 | 24 +++---- gcc/testsuite/gfortran.dg/gomp/pr79154-simd.f90 | 2 +- gcc/testsuite/gfortran.dg/gomp/pure-1.f90 | 88 +++++++++++++++++++++++++ gcc/testsuite/gfortran.dg/gomp/pure-2.f90 | 73 ++++++++++++++++++++ gcc/testsuite/gfortran.dg/gomp/pure-3.f90 | 31 +++++++++ gcc/testsuite/gfortran.dg/gomp/pure-4.f90 | 35 ++++++++++ libgomp/libgomp.texi | 2 +- 9 files changed, 277 insertions(+), 30 deletions(-) diff --git a/gcc/fortran/parse.cc b/gcc/fortran/parse.cc index 9730ab095e2..733294c8cfa 100644 --- a/gcc/fortran/parse.cc +++ b/gcc/fortran/parse.cc @@ -934,7 +934,16 @@ decode_omp_directive (void) first (those also shall not turn off implicit pure). */ switch (c) { + case 'a': + /* For -fopenmp-simd, ignore 'assumes'; note no clause starts with 's'. */ + if (!flag_openmp && gfc_match ("assumes") == MATCH_YES) + break; + matcho ("assumes", gfc_match_omp_assumes, ST_OMP_ASSUMES); + matchs ("assume", gfc_match_omp_assume, ST_OMP_ASSUME); + break; case 'd': + matchds ("declare reduction", gfc_match_omp_declare_reduction, + ST_OMP_DECLARE_REDUCTION); matchds ("declare simd", gfc_match_omp_declare_simd, ST_OMP_DECLARE_SIMD); matchdo ("declare target", gfc_match_omp_declare_target, @@ -942,16 +951,25 @@ decode_omp_directive (void) matchdo ("declare variant", gfc_match_omp_declare_variant, ST_OMP_DECLARE_VARIANT); break; + case 'e': + matchs ("end assume", gfc_match_omp_eos_error, ST_OMP_END_ASSUME); + matchs ("end simd", gfc_match_omp_eos_error, ST_OMP_END_SIMD); + matcho ("error", gfc_match_omp_error, ST_OMP_ERROR); + break; case 's': + matchs ("scan", gfc_match_omp_scan, ST_OMP_SCAN); matchs ("simd", gfc_match_omp_simd, ST_OMP_SIMD); break; + case 'n': + matcho ("nothing", gfc_match_omp_nothing, ST_NONE); + break; } pure_ok = false; if (flag_openmp && gfc_pure (NULL)) { - gfc_error_now ("OpenMP directives other than SIMD or DECLARE TARGET " - "at %C may not appear in PURE procedures"); + gfc_error_now ("OpenMP directive at %C is not pure and thus may not " + "appear in a PURE procedure"); gfc_error_recovery (); return ST_NONE; } @@ -967,11 +985,6 @@ decode_omp_directive (void) else matcho ("allocate", gfc_match_omp_allocate, ST_OMP_ALLOCATE); matcho ("allocators", gfc_match_omp_allocators, ST_OMP_ALLOCATORS); - /* For -fopenmp-simd, ignore 'assumes'; note no clause starts with 's'. */ - if (!flag_openmp && gfc_match ("assumes") == MATCH_YES) - break; - matcho ("assumes", gfc_match_omp_assumes, ST_OMP_ASSUMES); - matchs ("assume", gfc_match_omp_assume, ST_OMP_ASSUME); matcho ("atomic", gfc_match_omp_atomic, ST_OMP_ATOMIC); break; case 'b': @@ -984,8 +997,6 @@ decode_omp_directive (void) matcho ("critical", gfc_match_omp_critical, ST_OMP_CRITICAL); break; case 'd': - matchds ("declare reduction", gfc_match_omp_declare_reduction, - ST_OMP_DECLARE_REDUCTION); matcho ("depobj", gfc_match_omp_depobj, ST_OMP_DEPOBJ); matchs ("distribute parallel do simd", gfc_match_omp_distribute_parallel_do_simd, @@ -999,9 +1010,7 @@ decode_omp_directive (void) matcho ("do", gfc_match_omp_do, ST_OMP_DO); break; case 'e': - matcho ("error", gfc_match_omp_error, ST_OMP_ERROR); matcho ("end allocators", gfc_match_omp_eos_error, ST_OMP_END_ALLOCATORS); - matchs ("end assume", gfc_match_omp_eos_error, ST_OMP_END_ASSUME); matcho ("end atomic", gfc_match_omp_eos_error, ST_OMP_END_ATOMIC); matcho ("end critical", gfc_match_omp_end_critical, ST_OMP_END_CRITICAL); matchs ("end distribute parallel do simd", gfc_match_omp_eos_error, @@ -1014,7 +1023,6 @@ decode_omp_directive (void) matchs ("end do simd", gfc_match_omp_end_nowait, ST_OMP_END_DO_SIMD); matcho ("end do", gfc_match_omp_end_nowait, ST_OMP_END_DO); matchs ("end loop", gfc_match_omp_eos_error, ST_OMP_END_LOOP); - matchs ("end simd", gfc_match_omp_eos_error, ST_OMP_END_SIMD); matcho ("end masked taskloop simd", gfc_match_omp_eos_error, ST_OMP_END_MASKED_TASKLOOP_SIMD); matcho ("end masked taskloop", gfc_match_omp_eos_error, @@ -1160,7 +1168,6 @@ decode_omp_directive (void) matcho ("requires", gfc_match_omp_requires, ST_OMP_REQUIRES); break; case 's': - matchs ("scan", gfc_match_omp_scan, ST_OMP_SCAN); matcho ("scope", gfc_match_omp_scope, ST_OMP_SCOPE); matcho ("sections", gfc_match_omp_sections, ST_OMP_SECTIONS); matcho ("section", gfc_match_omp_eos_error, ST_OMP_SECTION); @@ -1244,14 +1251,27 @@ decode_omp_directive (void) return ST_NONE; finish: + if (ret == ST_OMP_ERROR && new_st.ext.omp_clauses->at == OMP_AT_EXECUTION) + { + gfc_unset_implicit_pure (NULL); + + if (gfc_pure (NULL)) + { + gfc_error_now ("OpenMP ERROR directive at %L with % " + "clause in a PURE procedure", &old_locus); + reject_statement (); + gfc_error_recovery (); + return ST_NONE; + } + } if (!pure_ok) { gfc_unset_implicit_pure (NULL); if (!flag_openmp && gfc_pure (NULL)) { - gfc_error_now ("OpenMP directives other than SIMD or DECLARE TARGET " - "at %C may not appear in PURE procedures"); + gfc_error_now ("OpenMP directive at %C is not pure and thus may not " + "appear in a PURE procedure"); reject_statement (); gfc_error_recovery (); return ST_NONE; diff --git a/gcc/testsuite/gfortran.dg/gomp/nothing-2.f90 b/gcc/testsuite/gfortran.dg/gomp/nothing-2.f90 index 554d4ef99ca..94fa3bba472 100644 --- a/gcc/testsuite/gfortran.dg/gomp/nothing-2.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/nothing-2.f90 @@ -1,5 +1,5 @@ pure subroutine foo - !$omp nothing ! { dg-error "OpenMP directives other than SIMD or DECLARE TARGET at .1. may not appear in PURE procedures" } + !$omp nothing end subroutine subroutine bar diff --git a/gcc/testsuite/gfortran.dg/gomp/pr79154-2.f90 b/gcc/testsuite/gfortran.dg/gomp/pr79154-2.f90 index 38d3fe5c384..6ceabc2b5e6 100644 --- a/gcc/testsuite/gfortran.dg/gomp/pr79154-2.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/pr79154-2.f90 @@ -3,14 +3,14 @@ pure real function foo (a, b) real, intent(in) :: a, b -!$omp taskwait ! { dg-error "may not appear in PURE" } +!$omp taskwait ! { dg-error "may not appear in a PURE" } foo = a + b end function foo pure function bar (a, b) real, intent(in) :: a(8), b(8) real :: bar(8) integer :: i -!$omp do simd ! { dg-error "may not appear in PURE" } +!$omp do simd ! { dg-error "may not appear in a PURE" } do i = 1, 8 bar(i) = a(i) + b(i) end do @@ -19,38 +19,38 @@ pure function baz (a, b) real, intent(in) :: a(8), b(8) real :: baz(8) integer :: i -!$omp do ! { dg-error "may not appear in PURE" } +!$omp do ! { dg-error "may not appear in a PURE" } do i = 1, 8 baz(i) = a(i) + b(i) end do -!$omp end do ! { dg-error "may not appear in PURE" } +!$omp end do ! { dg-error "may not appear in a PURE" } end function baz pure real function baz2 (a, b) real, intent(in) :: a, b -!$omp target map(from:baz2) ! { dg-error "may not appear in PURE" } +!$omp target map(from:baz2) ! { dg-error "may not appear in a PURE" } baz2 = a + b -!$omp end target ! { dg-error "may not appear in PURE" } +!$omp end target ! { dg-error "may not appear in a PURE" } end function baz2 ! ELEMENTAL implies PURE elemental real function fooe (a, b) real, intent(in) :: a, b -!$omp taskyield ! { dg-error "may not appear in PURE" } +!$omp taskyield ! { dg-error "may not appear in a PURE" } fooe = a + b end function fooe elemental real function baze (a, b) real, intent(in) :: a, b -!$omp target map(from:baz) ! { dg-error "may not appear in PURE" } +!$omp target map(from:baz) ! { dg-error "may not appear in a PURE" } baze = a + b -!$omp end target ! { dg-error "may not appear in PURE" } +!$omp end target ! { dg-error "may not appear in a PURE" } end function baze elemental impure real function fooei (a, b) real, intent(in) :: a, b -!$omp taskyield ! { dg-bogus "may not appear in PURE" } +!$omp taskyield ! { dg-bogus "may not appear in a PURE" } fooe = a + b end function fooei elemental impure real function bazei (a, b) real, intent(in) :: a, b -!$omp target map(from:baz) ! { dg-bogus "may not appear in PURE" } +!$omp target map(from:baz) ! { dg-bogus "may not appear in a PURE" } baze = a + b -!$omp end target ! { dg-bogus "may not appear in PURE" } +!$omp end target ! { dg-bogus "may not appear in a PURE" } end function bazei diff --git a/gcc/testsuite/gfortran.dg/gomp/pr79154-simd.f90 b/gcc/testsuite/gfortran.dg/gomp/pr79154-simd.f90 index d6b72d6f3da..a6626b03fba 100644 --- a/gcc/testsuite/gfortran.dg/gomp/pr79154-simd.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/pr79154-simd.f90 @@ -8,7 +8,7 @@ end pure subroutine foo(a,b) integer, intent(out) :: a(5) integer, intent(in) :: b(5) - !$omp target teams distribute simd ! { dg-error "may not appear in PURE procedures" } + !$omp target teams distribute simd ! { dg-error "may not appear in a PURE procedure" } do i=1, 5 a(i) = b(i) end do diff --git a/gcc/testsuite/gfortran.dg/gomp/pure-1.f90 b/gcc/testsuite/gfortran.dg/gomp/pure-1.f90 new file mode 100644 index 00000000000..598e455d2e9 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/pure-1.f90 @@ -0,0 +1,88 @@ +! The following directives are all 'pure' and should compile + +pure logical function func_assume(i) + implicit none + integer, value :: i + !$omp assume holds(i > 5) + func_assume = i < 3 + !$omp end assume +end + +pure logical function func_assumes() + implicit none + !$omp assumes absent(parallel) + func_assumes = .false. +end + +pure logical function func_reduction() + implicit none + !$omp declare reduction (foo : integer : omp_out = omp_out + omp_in) initializer (omp_priv = 0) + func_reduction = .false. +end + +pure logical function func_declare_simd() + implicit none + !$omp declare simd + func_declare_simd = .false. +end + +pure logical function func_declare_target() + implicit none + !$omp declare target + func_declare_target = .false. +end + +pure logical function func_error_1() + implicit none + !$omp error severity(warning) ! { dg-warning "OMP ERROR encountered" } + func_error_1 = .false. +end + +pure logical function func_error_2() + implicit none + !$omp error severity(warning) at(compilation) ! { dg-warning "OMP ERROR encountered" } + func_error_2 = .false. +end + +pure logical function func_error_3() + implicit none + !$omp error severity(warning) at(execution) ! { dg-error "OpenMP ERROR directive at .1. with 'at\\(execution\\)' clause in a PURE procedure" } + func_error_3 = .false. +end + +pure logical function func_nothing() + implicit none + !$omp nothing + func_nothing = .false. +end + +pure logical function func_scan(n) + implicit none + integer, value :: n + integer :: i, r + integer :: A(n) + integer :: B(n) + A = 0 + B = 0 + r = 0 + !$omp simd reduction (inscan, +:r) + do i = 1, 1024 + r = r + a(i) + !$omp scan inclusive(r) + b(i) = i + end do + + func_scan = b(1) == 3 +end + +pure integer function func_simd(n) + implicit none + integer, value :: n + integer :: j, r + r = 0 + !$omp simd reduction(+:r) + do j = 1, n + r = r + j + end do + func_simd = r +end diff --git a/gcc/testsuite/gfortran.dg/gomp/pure-2.f90 b/gcc/testsuite/gfortran.dg/gomp/pure-2.f90 new file mode 100644 index 00000000000..1e3cf8c9416 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/pure-2.f90 @@ -0,0 +1,73 @@ +! The following directives are all 'pure' and should compile +! However, they are not yet implemented. Once done, move to pure-1.f90 + +!pure logical function func_declare_induction() +logical function func_declare_induction() + implicit none + ! Not quite right but should trigger an different error once implemented. + !$omp declare induction(next : (integer, integer)) & ! { dg-error "Unclassifiable OpenMP directive" } + !$omp& inductor (omp_var = omp_var(omp_step)) & + !$omp& collector(omp_step * omp_idx) + + func_declare_induction = .false. +end + +!pure logical function func_interchange(n) +logical function func_interchange(n) + implicit none + integer, value :: n + integer :: i, j + func_interchange = .false. + !$omp interchange permutation(2,1) ! { dg-error "Unclassifiable OpenMP directive" } + do i = 1, n + do j = 1, n + func_interchange = .not. func_interchange + end do + end do +end + + +!pure logical function func_metadirective() +logical function func_metadirective() + implicit none + !$omp metadirective ! { dg-error "Unclassifiable OpenMP directive" } + func_metadirective = .false. +end + +!pure logical function func_reverse(n) +logical function func_reverse(n) + implicit none + integer, value :: n + integer :: j + func_reverse = .false. + !$omp reverse ! { dg-error "Unclassifiable OpenMP directive" } + do j = 1, n + func_reverse = .not. func_reverse + end do +end + +!pure integer function func_unroll(n) +integer function func_unroll(n) + implicit none + integer, value :: n + integer :: j, r + r = 0 + !$omp unroll partial(2) ! { dg-error "Unclassifiable OpenMP directive" } + do j = 1, n + r = r + j + end do + func_unroll = r +end + +!pure integer function func_tile(n) +integer function func_tile(n) + implicit none + integer, value :: n + integer :: j, r + r = 0 + !$omp tile sizes(2) ! { dg-error "Unclassifiable OpenMP directive" } + do j = 1, n + r = r + j + end do + func_tile = r +end diff --git a/gcc/testsuite/gfortran.dg/gomp/pure-3.f90 b/gcc/testsuite/gfortran.dg/gomp/pure-3.f90 new file mode 100644 index 00000000000..8c3c300dfb2 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/pure-3.f90 @@ -0,0 +1,31 @@ +! { dg-options "-fno-openmp -fopenmp-simd" } + +! Invalid combined directives with SIMD in PURE + +pure subroutine sub1 + implicit none + integer :: i + !$omp target do ! OK - not parsed by -fopenmp-simd + do i = 1, 5 + end do + !$omp end target +end + +subroutine sub2 + implicit none + integer :: i + !$omp target simd ! OK - not pure + do i = 1, 5 + end do + !$omp end target simd +end + +pure subroutine sub3 + implicit none + integer :: i + !$omp target simd ! { dg-error "OpenMP directive at .1. is not pure and thus may not appear in a PURE procedure" } + do i = 1, 5 + end do + !$omp end target simd ! { dg-error "OpenMP directive at .1. is not pure and thus may not appear in a PURE procedure" } +end + diff --git a/gcc/testsuite/gfortran.dg/gomp/pure-4.f90 b/gcc/testsuite/gfortran.dg/gomp/pure-4.f90 new file mode 100644 index 00000000000..a03cdfb41ce --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/pure-4.f90 @@ -0,0 +1,35 @@ +pure subroutine sub1 + implicit none + integer :: i + !$omp target do ! { dg-error "OpenMP directive at .1. is not pure and thus may not appear in a PURE procedure" } + do i = 1, 5 + end do + !$omp end target ! { dg-error "OpenMP directive at .1. is not pure and thus may not appear in a PURE procedure" } +end + +subroutine sub2 + implicit none + integer :: i + !$omp target simd ! OK - not pure + do i = 1, 5 + end do + !$omp end target simd +end + +pure subroutine sub3 + implicit none + integer :: i + !$omp target simd ! { dg-error "OpenMP directive at .1. is not pure and thus may not appear in a PURE procedure" } + do i = 1, 5 + end do + !$omp end target simd ! { dg-error "OpenMP directive at .1. is not pure and thus may not appear in a PURE procedure" } +end + +pure subroutine sub4 + implicit none + integer :: i + !$omp do ! { dg-error "OpenMP directive at .1. is not pure and thus may not appear in a PURE procedure" } + do i = 1, 5 + end do + !$omp end do ! { dg-error "OpenMP directive at .1. is not pure and thus may not appear in a PURE procedure" } +end diff --git a/libgomp/libgomp.texi b/libgomp/libgomp.texi index dc6b4aca38b..3ea17a4cbdb 100644 --- a/libgomp/libgomp.texi +++ b/libgomp/libgomp.texi @@ -388,7 +388,7 @@ to address of matching mapped list item per 5.1, Sect. 2.21.7.2 @tab N @tab @tab Y @tab @item Deprecation of @code{to} clause on declare target directive @tab N @tab @item Extended list of directives permitted in Fortran pure procedures - @tab N @tab + @tab Y @tab @item New @code{allocators} directive for Fortran @tab N @tab @item Deprecation of @code{allocate} directive for Fortran allocatables/pointers @tab N @tab