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