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

@@ -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;

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

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

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

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

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

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
+

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

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