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
This commit is contained in:
parent
0f314c78c2
commit
386fe51c2b
|
@ -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
|
||||
|
|
|
@ -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 ();
|
||||
|
|
|
@ -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.
|
||||
|
|
|
@ -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
|
|
@ -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
|
Loading…
Reference in New Issue