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(-)
@@ -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 %<at(execution)%> "
+ "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;
@@ -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
@@ -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
@@ -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
new file mode 100644
@@ -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
new file mode 100644
@@ -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
new file mode 100644
@@ -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
+
new file mode 100644
@@ -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
@@ -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