Skip to content

R
riscv-gcc-1
Commit 386fe51c by Jakub Jelinek Committed by Jakub Jelinek
Options

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
parent 0f314c78
Showing with 153 additions and 19 deletions
gcc/fortran/ChangeLog
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
......
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 ();
......
gcc/testsuite/ChangeLog
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.
......
gcc/testsuite/gfortran.dg/gomp/pr79154-1.f90 0 → 100644
! 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 0 → 100644
! 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
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment