re PR fortran/79154 (omp declare simd in pure function?)

	PR fortran/79154
	* parse.c (matchs, matcho, matchds, matchdo): Replace return st;
	with { ret = st; goto finish; }.
	(decode_omp_directive): Allow declare simd, declare target and
	simd directives in PURE/ELEMENTAL procedures.  Only call
	gfc_unset_implicit_pure on successful match of other procedures.

	* gfortran.dg/gomp/pr79154-1.f90: New test.
	* gfortran.dg/gomp/pr79154-2.f90: New test.

From-SVN: r244763

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index a8c1f44da2bea3b200148a13495ea8529ce0da9f..b3b883fdf430c8c7330962c78bc910aa751c2b62 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,12 @@
+2017-01-22  Jakub Jelinek  <jakub@redhat.com>
+
+       PR fortran/79154
+       * parse.c (matchs, matcho, matchds, matchdo): Replace return st;
+       with { ret = st; goto finish; }.
+       (decode_omp_directive): Allow declare simd, declare target and
+       simd directives in PURE/ELEMENTAL procedures.  Only call
+       gfc_unset_implicit_pure on successful match of other procedures.
+
 2017-01-21  Gerald Pfeifer  <gerald@pfeifer.com>
 
        * gfc-internals.texi (Symbol Versioning): Change references

diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index 0cd1d482099ef8fb2611415c1d9db74a76fa28c9..c9f8da46ed3d04fee0481b44c668761d07ad5ae1 100644 (file)
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -721,7 +721,10 @@ decode_oacc_directive (void)
        goto do_spec_only;                                      \
       if (match_word_omp_simd (keyword, subr, &old_locus,      \
                               &simd_matched) == MATCH_YES)     \
-       return st;                                              \
+       {                                                       \
+         ret = st;                                             \
+         goto finish;                                          \
+       }                                                       \
       else                                                     \
        undo_new_statement ();                                  \
     } while (0);
@@ -736,7 +739,10 @@ decode_oacc_directive (void)
        goto do_spec_only;                                      \
       else if (match_word (keyword, subr, &old_locus)          \
               == MATCH_YES)                                    \
-       return st;                                              \
+       {                                                       \
+         ret = st;                                             \
+         goto finish;                                          \
+       }                                                       \
       else                                                     \
        undo_new_statement ();                                  \
     } while (0);
@@ -746,7 +752,10 @@ decode_oacc_directive (void)
     do {                                                       \
       if (match_word_omp_simd (keyword, subr, &old_locus,      \
                               &simd_matched) == MATCH_YES)     \
-       return st;                                              \
+       {                                                       \
+         ret = st;                                             \
+         goto finish;                                          \
+       }                                                       \
       else                                                     \
        undo_new_statement ();                                  \
     } while (0);
@@ -758,7 +767,10 @@ decode_oacc_directive (void)
        ;                                                       \
       else if (match_word (keyword, subr, &old_locus)          \
               == MATCH_YES)                                    \
-       return st;                                              \
+       {                                                       \
+         ret = st;                                             \
+         goto finish;                                          \
+       }                                                       \
       else                                                     \
        undo_new_statement ();                                  \
     } while (0);
@@ -770,26 +782,18 @@ decode_omp_directive (void)
   char c;
   bool simd_matched = false;
   bool spec_only = false;
+  gfc_statement ret = ST_NONE;
+  bool pure_ok = true;
 
   gfc_enforce_clean_symbol_state ();
 
   gfc_clear_error ();  /* Clear any pending errors.  */
   gfc_clear_warning ();        /* Clear any pending warnings.  */
 
-  if (gfc_pure (NULL))
-    {
-      gfc_error_now ("OpenMP directives at %C may not appear in PURE "
-                    "or ELEMENTAL procedures");
-      gfc_error_recovery ();
-      return ST_NONE;
-    }
-
   if (gfc_current_state () == COMP_FUNCTION
       && gfc_current_block ()->result->ts.kind == -1)
     spec_only = true;
 
-  gfc_unset_implicit_pure (NULL);
-
   old_locus = gfc_current_locus;
 
   /* General OpenMP directive matching: Instead of testing every possible
@@ -798,6 +802,33 @@ decode_omp_directive (void)
 
   c = gfc_peek_ascii_char ();
 
+  /* match is for directives that should be recognized only if
+     -fopenmp, matchs for directives that should be recognized
+     if either -fopenmp or -fopenmp-simd.
+     Handle only the directives allowed in PURE/ELEMENTAL procedures
+     first (those also shall not turn off implicit pure).  */
+  switch (c)
+    {
+    case 'd':
+      matchds ("declare simd", gfc_match_omp_declare_simd,
+              ST_OMP_DECLARE_SIMD);
+      matchdo ("declare target", gfc_match_omp_declare_target,
+              ST_OMP_DECLARE_TARGET);
+      break;
+    case 's':
+      matchs ("simd", gfc_match_omp_simd, ST_OMP_SIMD);
+      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 or ELEMENTAL procedures");
+      gfc_error_recovery ();
+      return ST_NONE;
+    }
+
   /* match is for directives that should be recognized only if
      -fopenmp, matchs for directives that should be recognized
      if either -fopenmp or -fopenmp-simd.  */
@@ -818,10 +849,6 @@ decode_omp_directive (void)
     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,
-              ST_OMP_DECLARE_TARGET);
       matchs ("distribute parallel do simd",
              gfc_match_omp_distribute_parallel_do_simd,
              ST_OMP_DISTRIBUTE_PARALLEL_DO_SIMD);
@@ -923,7 +950,6 @@ decode_omp_directive (void)
     case 's':
       matcho ("sections", gfc_match_omp_sections, ST_OMP_SECTIONS);
       matcho ("section", gfc_match_omp_eos, ST_OMP_SECTION);
-      matchs ("simd", gfc_match_omp_simd, ST_OMP_SIMD);
       matcho ("single", gfc_match_omp_single, ST_OMP_SINGLE);
       break;
     case 't':
@@ -997,6 +1023,23 @@ decode_omp_directive (void)
 
   return ST_NONE;
 
+ finish:
+  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 or ELEMENTAL "
+                        "procedures");
+         reject_statement ();
+         gfc_error_recovery ();
+         return ST_NONE;
+       }
+    }
+  return ret;
+
  do_spec_only:
   reject_statement ();
   gfc_clear_error ();

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 1b6a2957ef4361de75d8d90eee3a2f83b06bbada..d758476b53c72964d552e207be8af086c9ec8967 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2017-01-22  Jakub Jelinek  <jakub@redhat.com>
+
+       PR fortran/79154
+       * gfortran.dg/gomp/pr79154-1.f90: New test.
+       * gfortran.dg/gomp/pr79154-2.f90: New test.
+
 2017-01-22  Andreas Schwab  <schwab@linux-m68k.org>
 
        * gcc.dg/tree-ssa/pr77445-2.c: Quote brackets.

diff --git a/gcc/testsuite/gfortran.dg/gomp/pr79154-1.f90 b/gcc/testsuite/gfortran.dg/gomp/pr79154-1.f90
new file mode 100644 (file)
index 0000000..6c86ded
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/pr79154-1.f90
@@ -0,0 +1,32 @@
+! PR fortran/79154
+! { dg-do compile }
+
+pure real function foo (a, b)
+!$omp declare simd(foo)                        ! { dg-bogus "may not appear in PURE or ELEMENTAL" }
+  real, intent(in) :: a, b
+  foo = a + b
+end function foo
+pure function bar (a, b)
+  real, intent(in) :: a(8), b(8)
+  real :: bar(8)
+  integer :: i
+!$omp simd                             ! { dg-bogus "may not appear in PURE or ELEMENTAL" }
+  do i = 1, 8
+    bar(i) = a(i) + b(i)
+  end do
+end function bar
+pure real function baz (a, b)
+!$omp declare target                   ! { dg-bogus "may not appear in PURE or ELEMENTAL" }
+  real, intent(in) :: a, b
+  baz = a + b
+end function baz
+elemental real function fooe (a, b)
+!$omp declare simd(fooe)               ! { dg-bogus "may not appear in PURE or ELEMENTAL" }
+  real, intent(in) :: a, b
+  fooe = a + b
+end function fooe
+elemental real function baze (a, b)
+!$omp declare target                   ! { dg-bogus "may not appear in PURE or ELEMENTAL" }
+  real, intent(in) :: a, b
+  baze = a + b
+end function baze

diff --git a/gcc/testsuite/gfortran.dg/gomp/pr79154-2.f90 b/gcc/testsuite/gfortran.dg/gomp/pr79154-2.f90
new file mode 100644 (file)
index 0000000..67344f0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/pr79154-2.f90
@@ -0,0 +1,44 @@
+! PR fortran/79154
+! { dg-do compile }
+
+pure real function foo (a, b)
+  real, intent(in) :: a, b
+!$omp taskwait                         ! { dg-error "may not appear in PURE or ELEMENTAL" }
+  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 or ELEMENTAL" }
+  do i = 1, 8
+    bar(i) = a(i) + b(i)
+  end do
+end function bar
+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 or ELEMENTAL" }
+  do i = 1, 8
+    baz(i) = a(i) + b(i)
+  end do
+!$omp end do                           ! { dg-error "may not appear in PURE or ELEMENTAL" }
+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 or ELEMENTAL" }
+  baz2 = a + b
+!$omp end target                       ! { dg-error "may not appear in PURE or ELEMENTAL" }
+end function baz2
+elemental real function fooe (a, b)
+  real, intent(in) :: a, b
+!$omp taskyield                                ! { dg-error "may not appear in PURE or ELEMENTAL" }
+  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 or ELEMENTAL" }
+  baze = a + b
+!$omp end target                       ! { dg-error "may not appear in PURE or ELEMENTAL" }
+end function baze