openmp.c (match_oacc_clause_gang): Rename to ...

	gcc/fortran/
	* openmp.c (match_oacc_clause_gang): Rename to ...
	(match_oacc_clause_gwv): this.  Add support for OpenACC worker and
	vector clauses.
	(gfc_match_omp_clauses): Use match_oacc_clause_gwv for
	OMP_CLAUSE_{GANG,WORKER,VECTOR}.  Propagate any MATCH_ERRORs for
	invalid OMP_CLAUSE_{ASYNC,WAIT,GANG,WORKER,VECTOR} clauses.
	(gfc_match_oacc_wait): Propagate MATCH_ERROR for invalid
	oacc_expr_lists.  Adjust the first and needs_space arguments to
	gfc_match_omp_clauses.

	gcc/testsuite/
	* gfortran.dg/goacc/asyncwait-2.f95: Updated expected diagnostics.
	* gfortran.dg/goacc/asyncwait-3.f95: Likewise.
	* gfortran.dg/goacc/asyncwait-4.f95: Add test coverage.

From-SVN: r237854

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 68e1f34edb54d4bf0ef2c87a2b7479a5a50bcfaf..8c91f183a324cb78e3b007c436be4d0ed4a1dd84 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,15 @@
+2016-06-29  Cesar Philippidis  <cesar@codesourcery.com>
+
+       * openmp.c (match_oacc_clause_gang): Rename to ...
+       (match_oacc_clause_gwv): this.  Add support for OpenACC worker and
+       vector clauses.
+       (gfc_match_omp_clauses): Use match_oacc_clause_gwv for
+       OMP_CLAUSE_{GANG,WORKER,VECTOR}.  Propagate any MATCH_ERRORs for
+       invalid OMP_CLAUSE_{ASYNC,WAIT,GANG,WORKER,VECTOR} clauses.
+       (gfc_match_oacc_wait): Propagate MATCH_ERROR for invalid
+       oacc_expr_lists.  Adjust the first and needs_space arguments to
+       gfc_match_omp_clauses.
+
 2016-06-29  Richard Biener  <rguenther@suse.de>
 
        PR middle-end/71002

diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index f5148667f5ccacc3a6c9793d23c5d048e7cabeae..865e0d9d5f063a2f0e5dff9d2b19ac0e46810607 100644 (file)
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -396,43 +396,67 @@ cleanup:
 }
 
 static match
-match_oacc_clause_gang (gfc_omp_clauses *cp)
+match_oacc_clause_gwv (gfc_omp_clauses *cp, unsigned gwv)
 {
   match ret = MATCH_YES;
 
   if (gfc_match (" ( ") != MATCH_YES)
     return MATCH_NO;
 
-  /* The gang clause accepts two optional arguments, num and static.
-     The num argument may either be explicit (num: <val>) or
-     implicit without (<val> without num:).  */
-
-  while (ret == MATCH_YES)
+  if (gwv == GOMP_DIM_GANG)
     {
-      if (gfc_match (" static :") == MATCH_YES)
+        /* The gang clause accepts two optional arguments, num and static.
+        The num argument may either be explicit (num: <val>) or
+        implicit without (<val> without num:).  */
+
+      while (ret == MATCH_YES)
        {
-         if (cp->gang_static)
-           return MATCH_ERROR;
+         if (gfc_match (" static :") == MATCH_YES)
+           {
+             if (cp->gang_static)
+               return MATCH_ERROR;
+             else
+               cp->gang_static = true;
+             if (gfc_match_char ('*') == MATCH_YES)
+               cp->gang_static_expr = NULL;
+             else if (gfc_match (" %e ", &cp->gang_static_expr) != MATCH_YES)
+               return MATCH_ERROR;
+           }
          else
-           cp->gang_static = true;
-         if (gfc_match_char ('*') == MATCH_YES)
-           cp->gang_static_expr = NULL;
-         else if (gfc_match (" %e ", &cp->gang_static_expr) != MATCH_YES)
-           return MATCH_ERROR;
-       }
-      else
-       {
-         /* This is optional.  */
-         if (cp->gang_num_expr || gfc_match (" num :") == MATCH_ERROR)
-           return MATCH_ERROR;
-         else if (gfc_match (" %e ", &cp->gang_num_expr) != MATCH_YES)
-           return MATCH_ERROR;
+           {
+             if (cp->gang_num_expr)
+               return MATCH_ERROR;
+
+             /* The 'num' argument is optional.  */
+             gfc_match (" num :");
+
+             if (gfc_match (" %e ", &cp->gang_num_expr) != MATCH_YES)
+               return MATCH_ERROR;
+           }
+
+         ret = gfc_match (" , ");
        }
+    }
+  else if (gwv == GOMP_DIM_WORKER)
+    {
+      /* The 'num' argument is optional.  */
+      gfc_match (" num :");
+
+      if (gfc_match (" %e ", &cp->worker_expr) != MATCH_YES)
+       return MATCH_ERROR;
+    }
+  else if (gwv == GOMP_DIM_VECTOR)
+    {
+      /* The 'length' argument is optional.  */
+      gfc_match (" length :");
 
-      ret = gfc_match (" , ");
+      if (gfc_match (" %e ", &cp->vector_expr) != MATCH_YES)
+       return MATCH_ERROR;
     }
+  else
+    gfc_fatal_error ("Unexpected OpenACC parallelism.");
 
-  return gfc_match (" ) ");
+  return gfc_match (" )");
 }
 
 static match
@@ -677,14 +701,20 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask,
              && gfc_match ("async") == MATCH_YES)
            {
              c->async = true;
-             needs_space = false;
-             if (gfc_match (" ( %e )", &c->async_expr) != MATCH_YES)
+             match m = gfc_match (" ( %e )", &c->async_expr);
+             if (m == MATCH_ERROR)
+               {
+                 gfc_current_locus = old_loc;
+                 break;
+               }
+             else if (m == MATCH_NO)
                {
                  c->async_expr
                    = gfc_get_constant_expr (BT_INTEGER,
                                             gfc_default_integer_kind,
                                             &gfc_current_locus);
                  mpz_set_si (c->async_expr->value.integer, GOMP_ASYNC_NOVAL);
+                 needs_space = true;
                }
              continue;
            }
@@ -877,9 +907,13 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask,
              && gfc_match ("gang") == MATCH_YES)
            {
              c->gang = true;
-             if (match_oacc_clause_gang(c) == MATCH_YES)
-               needs_space = false;
-             else
+             match m = match_oacc_clause_gwv (c, GOMP_DIM_GANG);
+             if (m == MATCH_ERROR)
+               {
+                 gfc_current_locus = old_loc;
+                 break;
+               }
+             else if (m == MATCH_NO)
                needs_space = true;
              continue;
            }
@@ -1309,10 +1343,13 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask,
              && gfc_match ("vector") == MATCH_YES)
            {
              c->vector = true;
-             if (gfc_match (" ( length : %e )", &c->vector_expr) == MATCH_YES
-                 || gfc_match (" ( %e )", &c->vector_expr) == MATCH_YES)
-               needs_space = false;
-             else
+             match m = match_oacc_clause_gwv (c, GOMP_DIM_VECTOR);
+             if (m == MATCH_ERROR)
+               {
+                 gfc_current_locus = old_loc;
+                 break;
+               }
+             if (m == MATCH_NO)
                needs_space = true;
              continue;
            }
@@ -1328,7 +1365,14 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask,
              && gfc_match ("wait") == MATCH_YES)
            {
              c->wait = true;
-             match_oacc_expr_list (" (", &c->wait_list, false);
+             match m = match_oacc_expr_list (" (", &c->wait_list, false);
+             if (m == MATCH_ERROR)
+               {
+                 gfc_current_locus = old_loc;
+                 break;
+               }
+             else if (m == MATCH_NO)
+               needs_space = true;
              continue;
            }
          if ((mask & OMP_CLAUSE_WORKER)
@@ -1336,10 +1380,13 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask,
              && gfc_match ("worker") == MATCH_YES)
            {
              c->worker = true;
-             if (gfc_match (" ( num : %e )", &c->worker_expr) == MATCH_YES
-                 || gfc_match (" ( %e )", &c->worker_expr) == MATCH_YES)
-               needs_space = false;
-             else
+             match m = match_oacc_clause_gwv (c, GOMP_DIM_WORKER);
+             if (m == MATCH_ERROR)
+               {
+                 gfc_current_locus = old_loc;
+                 break;
+               }
+             else if (m == MATCH_NO)
                needs_space = true;
              continue;
            }
@@ -1595,15 +1642,18 @@ gfc_match_oacc_wait (void)
 {
   gfc_omp_clauses *c = gfc_get_omp_clauses ();
   gfc_expr_list *wait_list = NULL, *el;
+  bool space = true;
+  match m;
 
-  match_oacc_expr_list (" (", &wait_list, true);
-  gfc_match_omp_clauses (&c, OACC_WAIT_CLAUSES, false, false, true);
+  m = match_oacc_expr_list (" (", &wait_list, true);
+  if (m == MATCH_ERROR)
+    return m;
+  else if (m == MATCH_YES)
+    space = false;
 
-  if (gfc_match_omp_eos () != MATCH_YES)
-    {
-      gfc_error ("Unexpected junk in !$ACC WAIT at %C");
-      return MATCH_ERROR;
-    }
+  if (gfc_match_omp_clauses (&c, OACC_WAIT_CLAUSES, space, space, true)
+      == MATCH_ERROR)
+    return MATCH_ERROR;
 
   if (wait_list)
     for (el = wait_list; el; el = el->next)

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 0c931e03822fe43f915b886bc95fbb0fb10f6d26..36610f20092cf5164e3d5f98f989837401fc3a08 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2016-06-29  Cesar Philippidis  <cesar@codesourcery.com>
+
+       * gfortran.dg/goacc/asyncwait-2.f95: Updated expected diagnostics.
+       * gfortran.dg/goacc/asyncwait-3.f95: Likewise.
+       * gfortran.dg/goacc/asyncwait-4.f95: Add test coverage.
+
 2016-06-29  Richard Biener  <rguenther@suse.de>
 
        PR middle-end/15256

diff --git a/gcc/testsuite/gfortran.dg/goacc/asyncwait-2.f95 b/gcc/testsuite/gfortran.dg/goacc/asyncwait-2.f95
index db0ce1f912a555a4b18d4290438189f4bba36e3d..fe4e4eeed2c65c10fd0eaf7dc4d7eb6df5bac545 100644 (file)
--- a/gcc/testsuite/gfortran.dg/goacc/asyncwait-2.f95
+++ b/gcc/testsuite/gfortran.dg/goacc/asyncwait-2.f95
@@ -83,6 +83,18 @@ program asyncwait
   end do
   !$acc end parallel ! { dg-error "Unexpected \\\!\\\$ACC END PARALLEL" }
 
+  !$acc parallel copyin (a(1:N)) copy (b(1:N)) waitasync ! { dg-error "Unclassifiable OpenACC directive" }
+  do i = 1, N
+     b(i) = a(i)
+  end do
+  !$acc end parallel ! { dg-error "Unexpected \\\!\\\$ACC END PARALLEL" }
+
+  !$acc parallel copyin (a(1:N)) copy (b(1:N)) asyncwait ! { dg-error "Unclassifiable OpenACC directive" }
+  do i = 1, N
+     b(i) = a(i)
+  end do
+  !$acc end parallel ! { dg-error "Unexpected \\\!\\\$ACC END PARALLEL" }
+
   !$acc parallel copyin (a(1:N)) copy (b(1:N)) wait
   do i = 1, N
      b(i) = a(i)

diff --git a/gcc/testsuite/gfortran.dg/goacc/asyncwait-3.f95 b/gcc/testsuite/gfortran.dg/goacc/asyncwait-3.f95
index 32c11def6f76f0c047cc5e8b94475a6a7cf675e5..ed72a9ba28a5653e7a2c592b98a77db650d57775 100644 (file)
--- a/gcc/testsuite/gfortran.dg/goacc/asyncwait-3.f95
+++ b/gcc/testsuite/gfortran.dg/goacc/asyncwait-3.f95
@@ -11,17 +11,17 @@ program asyncwait
   a(:) = 3.0
   b(:) = 0.0
 
-  !$acc wait (1 2) ! { dg-error "Unexpected junk in \\\!\\\$ACC WAIT at" }
+  !$acc wait (1 2) ! { dg-error "Syntax error in OpenACC expression list at" }
 
-  !$acc wait (1,) ! { dg-error "Unexpected junk in \\\!\\\$ACC WAIT at" }
+  !$acc wait (1,) ! { dg-error "Syntax error in OpenACC expression list at" }
 
-  !$acc wait (,1) ! { dg-error "Unexpected junk in \\\!\\\$ACC WAIT at" }
+  !$acc wait (,1) ! { dg-error "Syntax error in OpenACC expression list at" }
 
-  !$acc wait (1, 2, ) ! { dg-error "Unexpected junk in \\\!\\\$ACC WAIT at" }
+  !$acc wait (1, 2, ) ! { dg-error "Syntax error in OpenACC expression list at" }
 
-  !$acc wait (1, 2, ,) ! { dg-error "Unexpected junk in \\\!\\\$ACC WAIT at" }
+  !$acc wait (1, 2, ,) ! { dg-error "Syntax error in OpenACC expression list at" }
 
-  !$acc wait (1 ! { dg-error "Unexpected junk in \\\!\\\$ACC WAIT at" }
+  !$acc wait (1 ! { dg-error "Syntax error in OpenACC expression list at" }
 
   !$acc wait (1, *) ! { dg-error "Invalid argument to \\\$\\\!ACC WAIT" }
 
@@ -33,9 +33,9 @@ program asyncwait
 
   !$acc wait (1.0) ! { dg-error "WAIT clause at \\\(1\\\) requires a scalar INTEGER expression" }
 
-  !$acc wait 1 ! { dg-error "Unexpected junk in \\\!\\\$ACC WAIT at" }
+  !$acc wait 1 ! { dg-error "Unclassifiable OpenACC directive" }
 
-  !$acc wait N ! { dg-error "Unexpected junk in \\\!\\\$ACC WAIT at" }
+  !$acc wait N ! { dg-error "Unclassifiable OpenACC directive" }
 
   !$acc wait (1)
 end program asyncwait

diff --git a/gcc/testsuite/gfortran.dg/goacc/asyncwait-4.f95 b/gcc/testsuite/gfortran.dg/goacc/asyncwait-4.f95
index cd64ef3d387c157aadc8c60e2bf051bd19a3469d..df311545c52f7137741c62152a7b2dddb38cce65 100644 (file)
--- a/gcc/testsuite/gfortran.dg/goacc/asyncwait-4.f95
+++ b/gcc/testsuite/gfortran.dg/goacc/asyncwait-4.f95
@@ -11,21 +11,21 @@ program asyncwait
   a(:) = 3.0
   b(:) = 0.0
 
-  !$acc wait async (1 2) ! { dg-error "Unexpected junk in \\\!\\\$ACC WAIT at" }
+  !$acc wait async (1 2) ! { dg-error "Unclassifiable OpenACC directive" }
 
-  !$acc wait async (1,) ! { dg-error "Unexpected junk in \\\!\\\$ACC WAIT at" }
+  !$acc wait async (1,) ! { dg-error "Unclassifiable OpenACC directive" }
 
-  !$acc wait async (,1) ! { dg-error "Unexpected junk in \\\!\\\$ACC WAIT at" }
+  !$acc wait async (,1) ! { dg-error "Invalid character in name" }
 
-  !$acc wait async (1, 2, ) ! { dg-error "Unexpected junk in \\\!\\\$ACC WAIT at" }
+  !$acc wait async (1, 2, ) ! { dg-error "Unclassifiable OpenACC directive" }
 
-  !$acc wait async (1, 2, ,) ! { dg-error "Unexpected junk in \\\!\\\$ACC WAIT at" }
+  !$acc wait async (1, 2, ,) ! { dg-error "Unclassifiable OpenACC directive" }
 
-  !$acc wait async (1 ! { dg-error "Unexpected junk in \\\!\\\$ACC WAIT at" }
+  !$acc wait async (1 ! { dg-error "Unclassifiable OpenACC directive" }
 
-  !$acc wait async (1, *) ! { dg-error "Unexpected junk in \\\!\\\$ACC WAIT at" }
+  !$acc wait async (1, *) ! { dg-error "Unclassifiable OpenACC directive" }
 
-  !$acc wait async (1, a) ! { dg-error "Unexpected junk in \\\!\\\$ACC WAIT at" }
+  !$acc wait async (1, a) ! { dg-error "Unclassifiable OpenACC directive" }
 
   !$acc wait async (a) ! { dg-error "ASYNC clause at \\\(1\\\) requires a scalar INTEGER expression" }
 
@@ -33,5 +33,9 @@ program asyncwait
 
   !$acc wait async (1.0) ! { dg-error "ASYNC clause at \\\(1\\\) requires a scalar INTEGER expression" }
 
-  !$acc wait async 1 ! { dg-error "Unexpected junk in \\\!\\\$ACC WAIT at" }
+  !$acc wait async 1 ! { dg-error "Unclassifiable OpenACC directive" }
+
+  !$acc waitasync ! { dg-error "Unclassifiable OpenACC directive" }
+
+  !$acc wait,async ! { dg-error "Unclassifiable OpenACC directive" }
 end program asyncwait