re PR fortran/71704 (ICE with -fopenmp and some omp constructs)

	PR fortran/71704
	* parse.c (matchs, matcho): Move right before decode_omp_directive.
	If spec_only, only gfc_match the keyword and if successful, goto
	do_spec_only.
	(matchds, matchdo): Define.
	(decode_omp_directive): Add spec_only local var and set it.
	Use matchds or matchdo macros instead of matchs or matcho
	for declare target, declare simd, declare reduction and threadprivate
	directives.  Return ST_GET_FCN_CHARACTERISTICS if a non-declarative
	directive could be matched.
	(next_statement): For ST_GET_FCN_CHARACTERISTICS restore
	gfc_current_locus from old_locus even if there is no label.

	* gfortran.dg/gomp/pr71704.f90: New test.

From-SVN: r237888

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index ea16f8587a82cdf5bcbb52ef9afca3b796b99ed5..e399d35912611ccc50739d231aaccce2c29bd498 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,5 +1,18 @@
 2016-06-30  Jakub Jelinek  <jakub@redhat.com>
 
+       PR fortran/71704
+       * parse.c (matchs, matcho): Move right before decode_omp_directive.
+       If spec_only, only gfc_match the keyword and if successful, goto
+       do_spec_only.
+       (matchds, matchdo): Define.
+       (decode_omp_directive): Add spec_only local var and set it.
+       Use matchds or matchdo macros instead of matchs or matcho
+       for declare target, declare simd, declare reduction and threadprivate
+       directives.  Return ST_GET_FCN_CHARACTERISTICS if a non-declarative
+       directive could be matched.
+       (next_statement): For ST_GET_FCN_CHARACTERISTICS restore
+       gfc_current_locus from old_locus even if there is no label.
+
        PR fortran/71705
        * trans-openmp.c (gfc_trans_omp_clauses): Set TREE_ADDRESSABLE on
        decls in to/from clauses.

diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index 1081b2e605e35ff064ad1150cc021439b7646afd..d795225b7117e99960518b8bc307739d01bf21a1 100644 (file)
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -589,28 +589,6 @@ decode_statement (void)
   return ST_NONE;
 }
 
-/* Like match, but set a flag simd_matched if keyword matched.  */
-#define matchs(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)                                                \
-       ;                                                       \
-      else if (match_word (keyword, subr, &old_locus)          \
-              == MATCH_YES)                                    \
-       return st;                                              \
-      else                                                     \
-       undo_new_statement ();                                  \
-    } while (0);
-
 static gfc_statement
 decode_oacc_directive (void)
 {
@@ -702,12 +680,63 @@ decode_oacc_directive (void)
   return ST_NONE;
 }
 
+/* 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 ();
 
@@ -722,6 +751,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;
@@ -750,12 +783,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);
@@ -875,8 +908,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);
@@ -899,6 +932,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
@@ -1319,10 +1359,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/ChangeLog b/gcc/testsuite/ChangeLog
index e9c6f19712a75d59a552692b88d76f65263f8223..1f181dcc41491e78be76221572c6863c6e1d4c5e 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,5 +1,8 @@
 2016-06-30  Jakub Jelinek  <jakub@redhat.com>
 
+       PR fortran/71704
+       * gfortran.dg/gomp/pr71704.f90: New test.
+
        PR fortran/71705
        * gfortran.dg/gomp/pr71705.f90: New test.
 

diff --git a/gcc/testsuite/gfortran.dg/gomp/pr71704.f90 b/gcc/testsuite/gfortran.dg/gomp/pr71704.f90
new file mode 100644 (file)
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