From 3dfeb19cd21916a90c95a67881742b6312e6140d Mon Sep 17 00:00:00 2001 From: jakub Date: Sun, 22 Jan 2017 19:36:57 +0000 Subject: [PATCH] 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. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@244763 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 9 ++++ gcc/fortran/parse.c | 81 +++++++++++++++++++++------- gcc/testsuite/ChangeLog | 6 +++ gcc/testsuite/gfortran.dg/gomp/pr79154-1.f90 | 32 +++++++++++ gcc/testsuite/gfortran.dg/gomp/pr79154-2.f90 | 44 +++++++++++++++ 5 files changed, 153 insertions(+), 19 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/gomp/pr79154-1.f90 create mode 100644 gcc/testsuite/gfortran.dg/gomp/pr79154-2.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index a8c1f44da2b..b3b883fdf43 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,12 @@ +2017-01-22 Jakub Jelinek + + 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 * gfc-internals.texi (Symbol Versioning): Change references diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index 0cd1d482099..c9f8da46ed3 100644 --- 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 @@ -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 (); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 1b6a2957ef4..d758476b53c 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2017-01-22 Jakub Jelinek + + PR fortran/79154 + * gfortran.dg/gomp/pr79154-1.f90: New test. + * gfortran.dg/gomp/pr79154-2.f90: New test. + 2017-01-22 Andreas Schwab * 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 index 00000000000..6c86dedfacc --- /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 index 00000000000..67344f0c028 --- /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 -- 2.11.4.GIT