public inbox for gcc-patches@gcc.gnu.org
 help / color / mirror / Atom feed
* [committed] Allow omp {declare {simd,target},simd} in PURE/ELEMENTAL (PR fortran/79154)
@ 2017-01-22 19:44 Jakub Jelinek
  2017-01-22 20:21 ` Paul Richard Thomas
  0 siblings, 1 reply; 2+ messages in thread
From: Jakub Jelinek @ 2017-01-22 19:44 UTC (permalink / raw)
  To: gcc-patches, fortran

Hi!

OpenMP 4.5 allows !$omp declare simd, !$omp declare target and !$omp simd
in pure and elemental procedures.  Fixed thusly, bootstrapped/regtested on
x86_64-linux and i686-linux, committed to trunk.

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.

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

--- gcc/fortran/parse.c.jj	2017-01-01 12:45:47.000000000 +0100
+++ gcc/fortran/parse.c	2017-01-21 11:11:52.600886810 +0100
@@ -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
@@ -800,6 +804,33 @@ decode_omp_directive (void)
 
   /* 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.  */
   switch (c)
     {
@@ -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 ();
--- gcc/testsuite/gfortran.dg/gomp/pr79154-1.f90.jj	2017-01-21 11:13:46.162411804 +0100
+++ gcc/testsuite/gfortran.dg/gomp/pr79154-1.f90	2017-01-21 11:13:22.000000000 +0100
@@ -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
--- gcc/testsuite/gfortran.dg/gomp/pr79154-2.f90.jj	2017-01-21 11:15:40.277929603 +0100
+++ gcc/testsuite/gfortran.dg/gomp/pr79154-2.f90	2017-01-21 11:21:15.883570552 +0100
@@ -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

	Jakub

^ permalink raw reply	[flat|nested] 2+ messages in thread

* Re: [committed] Allow omp {declare {simd,target},simd} in PURE/ELEMENTAL (PR fortran/79154)
  2017-01-22 19:44 [committed] Allow omp {declare {simd,target},simd} in PURE/ELEMENTAL (PR fortran/79154) Jakub Jelinek
@ 2017-01-22 20:21 ` Paul Richard Thomas
  0 siblings, 0 replies; 2+ messages in thread
From: Paul Richard Thomas @ 2017-01-22 20:21 UTC (permalink / raw)
  To: Jakub Jelinek; +Cc: gcc-patches, fortran

Hi Jakub,

That's OK - thanks

Paul

On 22 January 2017 at 20:38, Jakub Jelinek <jakub@redhat.com> wrote:
> Hi!
>
> OpenMP 4.5 allows !$omp declare simd, !$omp declare target and !$omp simd
> in pure and elemental procedures.  Fixed thusly, bootstrapped/regtested on
> x86_64-linux and i686-linux, committed to trunk.
>
> 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.
>
>         * gfortran.dg/gomp/pr79154-1.f90: New test.
>         * gfortran.dg/gomp/pr79154-2.f90: New test.
>
> --- gcc/fortran/parse.c.jj      2017-01-01 12:45:47.000000000 +0100
> +++ gcc/fortran/parse.c 2017-01-21 11:11:52.600886810 +0100
> @@ -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
> @@ -800,6 +804,33 @@ decode_omp_directive (void)
>
>    /* 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.  */
>    switch (c)
>      {
> @@ -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 ();
> --- gcc/testsuite/gfortran.dg/gomp/pr79154-1.f90.jj     2017-01-21 11:13:46.162411804 +0100
> +++ gcc/testsuite/gfortran.dg/gomp/pr79154-1.f90        2017-01-21 11:13:22.000000000 +0100
> @@ -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
> --- gcc/testsuite/gfortran.dg/gomp/pr79154-2.f90.jj     2017-01-21 11:15:40.277929603 +0100
> +++ gcc/testsuite/gfortran.dg/gomp/pr79154-2.f90        2017-01-21 11:21:15.883570552 +0100
> @@ -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
>
>         Jakub



-- 
"If you can't explain it simply, you don't understand it well enough"
- Albert Einstein

^ permalink raw reply	[flat|nested] 2+ messages in thread

end of thread, other threads:[~2017-01-22 19:44 UTC | newest]

Thread overview: 2+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2017-01-22 19:44 [committed] Allow omp {declare {simd,target},simd} in PURE/ELEMENTAL (PR fortran/79154) Jakub Jelinek
2017-01-22 20:21 ` Paul Richard Thomas

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).