public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc/devel/omp/gcc-13] OpenMP/Fortran: Permit pure directives inside PURE
@ 2023-06-01  8:42 Tobias Burnus
  0 siblings, 0 replies; only message in thread
From: Tobias Burnus @ 2023-06-01  8:42 UTC (permalink / raw)
  To: gcc-cvs

https://gcc.gnu.org/g:07a5187c0c9a705868abbedd0ccaa013cf564d64

commit 07a5187c0c9a705868abbedd0ccaa013cf564d64
Author: Tobias Burnus <tobias@codesourcery.com>
Date:   Thu Jun 1 10:41:21 2023 +0200

    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.
    
    (cherry picked from commit 2df7e45188f32e3c448e004af38d56eb9ab8d959)
    (Also marks unroll, tile and metadirectives as pure - and updated the
    pure-1.f90 + pure-2.f90 tests accordingly.)

Diff:
---
 gcc/fortran/ChangeLog.omp                       |   8 ++
 gcc/fortran/parse.cc                            |  75 +++++++++-----
 gcc/testsuite/ChangeLog.omp                     |  13 +++
 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       | 124 ++++++++++++++++++++++++
 gcc/testsuite/gfortran.dg/gomp/pure-2.f90       |  39 ++++++++
 gcc/testsuite/gfortran.dg/gomp/pure-3.f90       |  31 ++++++
 gcc/testsuite/gfortran.dg/gomp/pure-4.f90       |  35 +++++++
 libgomp/ChangeLog.omp                           |   7 ++
 libgomp/libgomp.texi                            |   2 +-
 12 files changed, 322 insertions(+), 40 deletions(-)

diff --git a/gcc/fortran/ChangeLog.omp b/gcc/fortran/ChangeLog.omp
index 24f9b508e23..708828ac4e3 100644
--- a/gcc/fortran/ChangeLog.omp
+++ b/gcc/fortran/ChangeLog.omp
@@ -1,3 +1,11 @@
+2023-06-01  Tobias Burnus  <tobias@codesourcery.com>
+
+	Backported from master:
+	2023-06-01  Tobias Burnus  <tobias@codesourcery.com>
+
+	* parse.cc (decode_omp_directive): Accept all pure directives
+	inside a PURE procedures; handle 'error at(execution).
+
 2023-05-30  Tobias Burnus  <tobias@codesourcery.com>
 
 	Backported from master:
diff --git a/gcc/fortran/parse.cc b/gcc/fortran/parse.cc
index 7dd5d18977f..73f15608260 100644
--- a/gcc/fortran/parse.cc
+++ b/gcc/fortran/parse.cc
@@ -861,7 +861,20 @@ 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 'b':
+      matcho ("begin metadirective", gfc_match_omp_begin_metadirective,
+	      ST_OMP_BEGIN_METADIRECTIVE);
+      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,
@@ -869,16 +882,36 @@ 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);
+      matcho ("end metadirective", gfc_match_omp_eos_error,
+	      ST_OMP_END_METADIRECTIVE);
+      matchs ("end simd", gfc_match_omp_eos_error, ST_OMP_END_SIMD);
+      matcho ("error", gfc_match_omp_error, ST_OMP_ERROR);
+      break;
+    case 'm':
+      matcho ("metadirective", gfc_match_omp_metadirective,
+	      ST_OMP_METADIRECTIVE);
+      break;
+    case 'n':
+      matcho ("nothing", gfc_match_omp_nothing, ST_NONE);
+      break;
     case 's':
+      matchs ("scan", gfc_match_omp_scan, ST_OMP_SCAN);
       matchs ("simd", gfc_match_omp_simd, ST_OMP_SIMD);
       break;
+    case 't':
+      matchs ("tile sizes", gfc_match_omp_tile, ST_OMP_TILE);
+    case 'u':
+      matchs ("unroll", gfc_match_omp_unroll, ST_OMP_UNROLL);
+      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;
     }
@@ -889,18 +922,11 @@ decode_omp_directive (void)
   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);
       matcho ("atomic", gfc_match_omp_atomic, ST_OMP_ATOMIC);
       matcho ("allocate", gfc_match_omp_allocate, ST_OMP_ALLOCATE);
       break;
     case 'b':
       matcho ("barrier", gfc_match_omp_barrier, ST_OMP_BARRIER);
-      matcho ("begin metadirective", gfc_match_omp_begin_metadirective,
-	      ST_OMP_BEGIN_METADIRECTIVE);
       break;
     case 'c':
       matcho ("cancellation% point", gfc_match_omp_cancellation_point,
@@ -909,8 +935,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,
@@ -924,8 +948,6 @@ 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);
-      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,
@@ -938,7 +960,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,
@@ -949,8 +970,6 @@ decode_omp_directive (void)
       matcho ("end master taskloop", gfc_match_omp_eos_error,
 	      ST_OMP_END_MASTER_TASKLOOP);
       matcho ("end master", gfc_match_omp_eos_error, ST_OMP_END_MASTER);
-      matcho ("end metadirective", gfc_match_omp_eos_error,
-	      ST_OMP_END_METADIRECTIVE);
       matchs ("end ordered", gfc_match_omp_eos_error, ST_OMP_END_ORDERED);
       matchs ("end parallel do simd", gfc_match_omp_eos_error,
 	      ST_OMP_END_PARALLEL_DO_SIMD);
@@ -1036,8 +1055,6 @@ decode_omp_directive (void)
       matcho ("master taskloop", gfc_match_omp_master_taskloop,
 	      ST_OMP_MASTER_TASKLOOP);
       matcho ("master", gfc_match_omp_master, ST_OMP_MASTER);
-      matcho ("metadirective", gfc_match_omp_metadirective,
-	      ST_OMP_METADIRECTIVE);
       break;
     case 'n':
       matcho ("nothing", gfc_match_omp_nothing, ST_NONE);
@@ -1090,7 +1107,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);
@@ -1149,10 +1165,6 @@ decode_omp_directive (void)
       matcho ("teams", gfc_match_omp_teams, ST_OMP_TEAMS);
       matchdo ("threadprivate", gfc_match_omp_threadprivate,
 	       ST_OMP_THREADPRIVATE);
-      matchs ("tile sizes", gfc_match_omp_tile, ST_OMP_TILE);
-      break;
-    case 'u':
-      matchs ("unroll", gfc_match_omp_unroll, ST_OMP_UNROLL);
       break;
     case 'w':
       matcho ("workshare", gfc_match_omp_workshare, ST_OMP_WORKSHARE);
@@ -1182,14 +1194,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;
diff --git a/gcc/testsuite/ChangeLog.omp b/gcc/testsuite/ChangeLog.omp
index a2a16b4baf6..df1ffcea097 100644
--- a/gcc/testsuite/ChangeLog.omp
+++ b/gcc/testsuite/ChangeLog.omp
@@ -1,3 +1,16 @@
+2023-06-01  Tobias Burnus  <tobias@codesourcery.com>
+
+	Backported from master:
+	2023-06-01  Tobias Burnus  <tobias@codesourcery.com>
+
+	* 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.
+
 2023-05-30  Tobias Burnus  <tobias@codesourcery.com>
 
 	Backported from master:
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..3fab91ca0dc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/pure-1.f90
@@ -0,0 +1,124 @@
+! 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_metadirective()
+  implicit none
+  integer :: i
+  !$omp metadirective default (nothing)
+
+  !$omp begin metadirective default(simd)
+  do i = 1, 0
+  end do
+  !$omp end metadirective
+  func_metadirective = .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
+
+pure integer function func_unroll(n)
+  implicit none
+  integer, value :: n
+  integer :: j, r
+  r = 0
+  !$omp unroll partial(2)
+  do j = 1, n
+    r = r + j
+  end do
+  func_unroll = r
+end
+
+pure integer function func_tile(n)
+  implicit none
+  integer, value :: n
+  integer :: j, r
+  r = 0
+  !$omp tile sizes(2)
+  do j = 1, n
+    r = r + j
+  end do
+  func_tile = 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..123ac2611d4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/pure-2.f90
@@ -0,0 +1,39 @@
+! 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_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
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/ChangeLog.omp b/libgomp/ChangeLog.omp
index a93c8c9aa04..4283134a5a5 100644
--- a/libgomp/ChangeLog.omp
+++ b/libgomp/ChangeLog.omp
@@ -1,3 +1,10 @@
+2023-06-01  Tobias Burnus  <tobias@codesourcery.com>
+
+	Backported from master:
+	2023-06-01  Tobias Burnus  <tobias@codesourcery.com>
+
+	* libgomp.texi (OpenMP 5.2): Mark pure-directive handling as 'Y'.
+
 2023-05-30  Tobias Burnus  <tobias@codesourcery.com>
 
 	Backported from master:
diff --git a/libgomp/libgomp.texi b/libgomp/libgomp.texi
index 6f775fe45d2..dcd2c2d3ea9 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

^ permalink raw reply	[flat|nested] only message in thread

only message in thread, other threads:[~2023-06-01  8:42 UTC | newest]

Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2023-06-01  8:42 [gcc/devel/omp/gcc-13] OpenMP/Fortran: Permit pure directives inside PURE Tobias Burnus

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).