This patch contains both Jakub's OpenMP and my OpenACC fixes for
PR71704. For reference, the discussion for the original patches can be
found here <https://gcc.gnu.org/ml/gcc-patches/2016-06/msg02084.html>.
I'll apply this patch to gomp-4_0-branch shortly.
Cesar
2016-07-12 Cesar Philippidis <ce...@codesourcery.com>
Backport from trunk:
2016-07-08 Cesar Philippidis <ce...@codesourcery.com>
gcc/fortran/
* parse.c (matcha): Define.
(decode_oacc_directive): Add spec_only local var and set it. Use
matcha to parse acc directives except for routine and declare. Return
ST_GET_FCN_CHARACTERISTICS if a non-declarative directive could be
matched.
gcc/testsuite/
* gfortran.dg/goacc/pr71704.f90: New test.
2016-06-01 Jakub Jelinek <ja...@redhat.com>
gcc/fortran/
* parse.c (case_decl): Move ST_OMP_* to ...
(case_omp_decl): ... here, new macro.
(verify_st_order): For case_omp_decl, complain about
p->state >= ORDER_EXEC, but don't change p->state otherwise.
gcc/testsuite
* gfortran.dg/gomp/order-1.f90: New test.
* gfortran.dg/gomp/order-2.f90: New test.
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index 7bce47f..ccc5d6c 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -585,21 +585,12 @@ decode_statement (void)
return ST_NONE;
}
-/* Like match, but set a flag simd_matched if keyword matched. */
-#define matchs(keyword, subr, st) \
+/* Like match and if spec_only, goto do_spec_only without actually
+ matching. */
+#define matcha(keyword, subr, st) \
do { \
- if (match_word_omp_simd (keyword, subr, &old_locus, \
- &simd_matched) == MATCH_YES) \
- return st; \
- else \
- undo_new_statement (); \
- } while (0);
-
-/* Like match, but don't match anything if not -fopenmp. */
-#define matcho(keyword, subr, st) \
- do { \
- if (!flag_openmp) \
- ; \
+ if (spec_only && gfc_match (keyword) == MATCH_YES) \
+ goto do_spec_only; \
else if (match_word (keyword, subr, &old_locus) \
== MATCH_YES) \
return st; \
@@ -612,6 +603,7 @@ decode_oacc_directive (void)
{
locus old_locus;
char c;
+ bool spec_only = false;
gfc_enforce_clean_symbol_state ();
@@ -626,6 +618,10 @@ decode_oacc_directive (void)
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;
@@ -639,49 +635,52 @@ decode_oacc_directive (void)
switch (c)
{
case 'a':
- match ("atomic", gfc_match_oacc_atomic, ST_OACC_ATOMIC);
+ matcha ("atomic", gfc_match_oacc_atomic, ST_OACC_ATOMIC);
break;
case 'c':
- match ("cache", gfc_match_oacc_cache, ST_OACC_CACHE);
+ matcha ("cache", gfc_match_oacc_cache, ST_OACC_CACHE);
break;
case 'd':
- match ("data", gfc_match_oacc_data, ST_OACC_DATA);
+ matcha ("data", gfc_match_oacc_data, ST_OACC_DATA);
match ("declare", gfc_match_oacc_declare, ST_OACC_DECLARE);
break;
case 'e':
- match ("end atomic", gfc_match_omp_eos, ST_OACC_END_ATOMIC);
- match ("end data", gfc_match_omp_eos, ST_OACC_END_DATA);
- match ("end host_data", gfc_match_omp_eos, ST_OACC_END_HOST_DATA);
- match ("end kernels loop", gfc_match_omp_eos, ST_OACC_END_KERNELS_LOOP);
- match ("end kernels", gfc_match_omp_eos, ST_OACC_END_KERNELS);
- match ("end loop", gfc_match_omp_eos, ST_OACC_END_LOOP);
- match ("end parallel loop", gfc_match_omp_eos, ST_OACC_END_PARALLEL_LOOP);
- match ("end parallel", gfc_match_omp_eos, ST_OACC_END_PARALLEL);
- match ("enter data", gfc_match_oacc_enter_data, ST_OACC_ENTER_DATA);
- match ("exit data", gfc_match_oacc_exit_data, ST_OACC_EXIT_DATA);
+ matcha ("end atomic", gfc_match_omp_eos, ST_OACC_END_ATOMIC);
+ matcha ("end data", gfc_match_omp_eos, ST_OACC_END_DATA);
+ matcha ("end host_data", gfc_match_omp_eos, ST_OACC_END_HOST_DATA);
+ matcha ("end kernels loop", gfc_match_omp_eos, ST_OACC_END_KERNELS_LOOP);
+ matcha ("end kernels", gfc_match_omp_eos, ST_OACC_END_KERNELS);
+ matcha ("end loop", gfc_match_omp_eos, ST_OACC_END_LOOP);
+ matcha ("end parallel loop", gfc_match_omp_eos,
+ ST_OACC_END_PARALLEL_LOOP);
+ matcha ("end parallel", gfc_match_omp_eos, ST_OACC_END_PARALLEL);
+ matcha ("enter data", gfc_match_oacc_enter_data, ST_OACC_ENTER_DATA);
+ matcha ("exit data", gfc_match_oacc_exit_data, ST_OACC_EXIT_DATA);
break;
case 'h':
- match ("host_data", gfc_match_oacc_host_data, ST_OACC_HOST_DATA);
+ matcha ("host_data", gfc_match_oacc_host_data, ST_OACC_HOST_DATA);
break;
case 'p':
- match ("parallel loop", gfc_match_oacc_parallel_loop, ST_OACC_PARALLEL_LOOP);
- match ("parallel", gfc_match_oacc_parallel, ST_OACC_PARALLEL);
+ matcha ("parallel loop", gfc_match_oacc_parallel_loop,
+ ST_OACC_PARALLEL_LOOP);
+ matcha ("parallel", gfc_match_oacc_parallel, ST_OACC_PARALLEL);
break;
case 'k':
- match ("kernels loop", gfc_match_oacc_kernels_loop, ST_OACC_KERNELS_LOOP);
- match ("kernels", gfc_match_oacc_kernels, ST_OACC_KERNELS);
+ matcha ("kernels loop", gfc_match_oacc_kernels_loop,
+ ST_OACC_KERNELS_LOOP);
+ matcha ("kernels", gfc_match_oacc_kernels, ST_OACC_KERNELS);
break;
case 'l':
- match ("loop", gfc_match_oacc_loop, ST_OACC_LOOP);
+ matcha ("loop", gfc_match_oacc_loop, ST_OACC_LOOP);
break;
case 'r':
match ("routine", gfc_match_oacc_routine, ST_OACC_ROUTINE);
break;
case 'u':
- match ("update", gfc_match_oacc_update, ST_OACC_UPDATE);
+ matcha ("update", gfc_match_oacc_update, ST_OACC_UPDATE);
break;
case 'w':
- match ("wait", gfc_match_oacc_wait, ST_OACC_WAIT);
+ matcha ("wait", gfc_match_oacc_wait, ST_OACC_WAIT);
break;
}
@@ -696,14 +695,72 @@ decode_oacc_directive (void)
gfc_error_recovery ();
return ST_NONE;
+
+ do_spec_only:
+ reject_statement ();
+ gfc_clear_error ();
+ gfc_buffer_error (false);
+ gfc_current_locus = old_locus;
+ return ST_GET_FCN_CHARACTERISTICS;
}
+/* Like match, but set a flag simd_matched if keyword matched
+ and if spec_only, goto do_spec_only without actually matching. */
+#define matchs(keyword, subr, st) \
+ do { \
+ if (spec_only && gfc_match (keyword) == MATCH_YES) \
+ goto do_spec_only; \
+ if (match_word_omp_simd (keyword, subr, &old_locus, \
+ &simd_matched) == MATCH_YES) \
+ return st; \
+ else \
+ undo_new_statement (); \
+ } while (0);
+
+/* Like match, but don't match anything if not -fopenmp
+ and if spec_only, goto do_spec_only without actually matching. */
+#define matcho(keyword, subr, st) \
+ do { \
+ if (!flag_openmp) \
+ ; \
+ else if (spec_only && gfc_match (keyword) == MATCH_YES) \
+ goto do_spec_only; \
+ else if (match_word (keyword, subr, &old_locus) \
+ == MATCH_YES) \
+ return st; \
+ else \
+ undo_new_statement (); \
+ } while (0);
+
+/* Like match, but set a flag simd_matched if keyword matched. */
+#define matchds(keyword, subr, st) \
+ do { \
+ if (match_word_omp_simd (keyword, subr, &old_locus, \
+ &simd_matched) == MATCH_YES) \
+ return st; \
+ else \
+ undo_new_statement (); \
+ } while (0);
+
+/* Like match, but don't match anything if not -fopenmp. */
+#define matchdo(keyword, subr, st) \
+ do { \
+ if (!flag_openmp) \
+ ; \
+ else if (match_word (keyword, subr, &old_locus) \
+ == MATCH_YES) \
+ return st; \
+ else \
+ undo_new_statement (); \
+ } while (0);
+
static gfc_statement
decode_omp_directive (void)
{
locus old_locus;
char c;
bool simd_matched = false;
+ bool spec_only = false;
gfc_enforce_clean_symbol_state ();
@@ -718,6 +775,10 @@ decode_omp_directive (void)
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;
@@ -746,12 +807,12 @@ decode_omp_directive (void)
matcho ("critical", gfc_match_omp_critical, ST_OMP_CRITICAL);
break;
case 'd':
- matchs ("declare reduction", gfc_match_omp_declare_reduction,
- ST_OMP_DECLARE_REDUCTION);
- matchs ("declare simd", gfc_match_omp_declare_simd,
- ST_OMP_DECLARE_SIMD);
- matcho ("declare target", gfc_match_omp_declare_target,
- ST_OMP_DECLARE_TARGET);
+ 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);
@@ -871,8 +932,8 @@ decode_omp_directive (void)
matcho ("teams distribute", gfc_match_omp_teams_distribute,
ST_OMP_TEAMS_DISTRIBUTE);
matcho ("teams", gfc_match_omp_teams, ST_OMP_TEAMS);
- matcho ("threadprivate", gfc_match_omp_threadprivate,
- ST_OMP_THREADPRIVATE);
+ matchdo ("threadprivate", gfc_match_omp_threadprivate,
+ ST_OMP_THREADPRIVATE);
break;
case 'w':
matcho ("workshare", gfc_match_omp_workshare, ST_OMP_WORKSHARE);
@@ -895,6 +956,13 @@ decode_omp_directive (void)
gfc_error_recovery ();
return ST_NONE;
+
+ do_spec_only:
+ reject_statement ();
+ gfc_clear_error ();
+ gfc_buffer_error (false);
+ gfc_current_locus = old_locus;
+ return ST_GET_FCN_CHARACTERISTICS;
}
static gfc_statement
@@ -1315,10 +1383,13 @@ next_statement (void)
gfc_buffer_error (false);
- if (st == ST_GET_FCN_CHARACTERISTICS && gfc_statement_label != NULL)
+ if (st == ST_GET_FCN_CHARACTERISTICS)
{
- gfc_free_st_label (gfc_statement_label);
- gfc_statement_label = NULL;
+ if (gfc_statement_label != NULL)
+ {
+ gfc_free_st_label (gfc_statement_label);
+ gfc_statement_label = NULL;
+ }
gfc_current_locus = old_locus;
}
diff --git a/gcc/testsuite/gfortran.dg/goacc/pr71704.f90 b/gcc/testsuite/gfortran.dg/goacc/pr71704.f90
new file mode 100644
index 0000000..0235e85
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/pr71704.f90
@@ -0,0 +1,60 @@
+! PR fortran/71704
+! { dg-do compile }
+
+real function f1 ()
+!$acc routine (f1)
+ f1 = 1
+end
+
+real function f2 (a)
+ integer a
+ !$acc enter data copyin(a)
+ f2 = 1
+end
+
+real function f3 (a)
+ integer a
+!$acc enter data copyin(a)
+ f3 = 1
+end
+
+real function f4 ()
+!$acc wait
+ f4 = 1
+end
+
+real function f5 (a)
+ integer a
+!$acc update device(a)
+ f5 = 1
+end
+
+real function f6 ()
+!$acc parallel
+!$acc end parallel
+ f6 = 1
+end
+
+real function f7 ()
+!$acc kernels
+!$acc end kernels
+ f7 = 1
+end
+
+real function f8 ()
+!$acc data
+!$acc end data
+ f8 = 1
+end
+
+real function f9 ()
+!$acc host_data
+!$acc end host_data
+ f8 = 1
+end
+
+real function f10 (a)
+ integer a
+!$acc declare present (a)
+ f8 = 1
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/pr71704.f90 b/gcc/testsuite/gfortran.dg/gomp/pr71704.f90
new file mode 100644
index 0000000..5c1c003
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/pr71704.f90
@@ -0,0 +1,58 @@
+! PR fortran/71704
+! { dg-do compile }
+
+real function f0 ()
+!$omp declare simd (f0)
+ f0 = 1
+end
+
+real function f1 ()
+!$omp declare target (f1)
+ f1 = 1
+end
+
+real function f2 ()
+!$omp declare reduction (foo : integer : omp_out = omp_out + omp_in) &
+!$omp & initializer (omp_priv = 0)
+ f2 = 1
+end
+
+real function f3 ()
+ real, save :: t
+!$omp threadprivate (t)
+ f3 = 1
+end
+
+real function f4 ()
+!$omp taskwait
+ f4 = 1
+end
+
+real function f5 ()
+!$omp barrier
+ f5 = 1
+end
+
+real function f6 ()
+!$omp parallel
+!$omp end parallel
+ f6 = 1
+end
+
+real function f7 ()
+!$omp single
+!$omp end single
+ f7 = 1
+end
+
+real function f8 ()
+!$omp critical
+!$omp end critical
+ f8 = 1
+end
+
+real function f9 ()
+!$omp critical
+!$omp end critical
+ f9 = 1
+end
