gcc-6.2.0gcc-6.2.0

1 files changed, 104 insertions, 49 deletions

diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 0dd1a92137..de9a4ad47a 100644
--- 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 :");
 
-      ret = gfc_match (" , ");
+      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 :");
 
-  return gfc_match (" ) ");
+      if (gfc_match (" %e ", &cp->vector_expr) != MATCH_YES)
+	return MATCH_ERROR;
+    }
+  else
+    gfc_fatal_error ("Unexpected OpenACC parallelism.");
+
+  return gfc_match (" )");
 }
 
 static match
@@ -640,17 +664,25 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask,
       needs_space = false;
       first = false;
       gfc_gobble_whitespace ();
+      old_loc = gfc_current_locus;
       if ((mask & OMP_CLAUSE_ASYNC) && !c->async)
 	if (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);
+		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;
 	  }
@@ -658,9 +690,13 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask,
 	if (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;
 	  }
@@ -668,10 +704,13 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask,
 	if (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;
 	  }
@@ -683,10 +722,13 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask,
 	if (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;
 	  }
@@ -883,10 +925,16 @@ 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;
 	}
-      old_loc = gfc_current_locus;
       if ((mask & OMP_CLAUSE_REDUCTION)
 	  && gfc_match ("reduction ( ") == MATCH_YES)
 	{
@@ -1582,15 +1630,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)
@@ -1623,6 +1674,10 @@ match
 gfc_match_oacc_cache (void)
 {
   gfc_omp_clauses *c = gfc_get_omp_clauses ();
+  /* The OpenACC cache directive explicitly only allows "array elements or
+     subarrays", which we're currently not checking here.  Either check this
+     after the call of gfc_match_omp_variable_list, or add something like a
+     only_sections variant next to its allow_sections parameter.  */
   match m = gfc_match_omp_variable_list (" (",
 					 &c->lists[OMP_LIST_CACHE], true,
 					 NULL, NULL, true);