parse.c (matcha): Define.

	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.

From-SVN: r238171

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index c9df4270bb3c3d6d6273b25638b9d7914e777b18..4faf79780abf33021568695903606d39a0c06af6 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,11 @@
+2016-07-08  Cesar Philippidis  <cesar@codesourcery.com>
+
+       * 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.
+
 2016-07-08  Martin Liska  <mliska@suse.cz>
 
        * invoke.texi (Wundefined-do-loop): Enhance documentation.

diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index d795225b7117e99960518b8bc307739d01bf21a1..0aa736c7089d6d6f6cacb70740dd349b4b8f4833 100644 (file)
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -589,11 +589,25 @@ decode_statement (void)
   return ST_NONE;
 }
 
+/* Like match and if spec_only, goto do_spec_only without actually
+   matching.  */
+#define matcha(keyword, subr, st)                              \
+    do {                                                       \
+      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);
+
 static gfc_statement
 decode_oacc_directive (void)
 {
   locus old_locus;
   char c;
+  bool spec_only = false;
 
   gfc_enforce_clean_symbol_state ();
 
@@ -608,6 +622,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;
@@ -621,49 +639,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;
     }
 
@@ -678,6 +699,13 @@ 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

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 4f107b1af518c3afef2e89f7dbfd5a2c6ca89343..5245fdd44dfa698b9be2d9289fe76ee019f878ad 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2016-07-08  Cesar Philippidis  <cesar@codesourcery.com>
+
+       * gfortran.dg/goacc/pr71704.f90: New test.
+
 2016-07-08  Bill Schmidt  <wschmidt@linux.vnet.ibm.com>
 
        PR target/71297

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