Re: OpenACC wait clause

[Cesar Philippidis <cesar@codesourcery.com>]

[-- Attachment #1: Type: text/plain, Size: 2788 bytes --]

On 06/24/2016 08:53 AM, Jakub Jelinek wrote:
> On Fri, Jun 24, 2016 at 08:42:49AM -0700, Cesar Philippidis wrote:
>>>> @@ -1328,7 +1328,8 @@ 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);
>>>> +	      if (match_oacc_expr_list (" (", &c->wait_list, false) == MATCH_NO)
>>>> +		needs_space = true;
>>>>  	      continue;
>>>>  	    }
>>>>  	  if ((mask & OMP_CLAUSE_WORKER)
>>>
>>> I think it is still problematic.  Most of the parsing fortran FE errors are deferred,
>>> meaning that if you don't reject the whole gfc_match_omp_clauses, then no
>>> diagnostics is actually emitted.
>>
>> What exactly is the problem here? Do you want more precise errors or do
>> you want to keep the errors generic and deferred?
> 
> The problem is that if you ignore MATCH_ERROR and don't reject the stmt,
> then invalid source will be accepted, which is not acceptable.
> 
> I admit the Fortran OpenMP/OpenACC error recovery and diagnostics is not
> very good, but it generally follows the model done elsewhere in the Fortran
> FE.  So, I think before changing anything substantial first the bugs in
> there (where MATCH_ERROR is ignored) should be fixed (something that can be
> also backported), and only afterwards we should be discussing some plan to
> improve the infrastructure (like for clauses if there are any non-fatal
> errors in the parsing emit the diagnostics immediately, don't add the
> clauses to the FE IL and don't reject the whole stmt).

That's reasonable. I wasn't considering the gcc6 backport.

Improving the infrastructure is definitely a good ideal. I'll need to
clear that out with Thomas though. As a heads up, we've been getting a
lot of customer feedback to make the compiler emit more performance
diagnostics in general. Basically, they want to know what type of
parallelization the compiler detected and applied (e.g., which loops are
independent and were vectorized/partitioned across gang, workers and
vectors), along with missed optimizations.

With that aside, this patch should correct the issues you pointed out.
gfc_match_omp_clauses now uses a common function to parse the gang,
worker and vector clauses. Also, this patch takes extra care with
MATCH_ERRORs when parsing the wait and async clauses and the wait
directive. One oddity I noticed is how the fortran FE accepts directives
with clauses specified like this

  !$omp parallel if(.true.)private(x)

Shouldn't there be some sort of separator between if and private? I know
that it's easy to distinguish the clauses because of the parenthesis,
but it still looks weird.

With that oddity aside, is this patch OK for trunk and gcc6?

Cesar

[-- Attachment #2: fortran-parser-errors-20160627.diff --]
[-- Type: text/x-patch, Size: 13030 bytes --]

2016-06-27  Cesar Philippidis  <cesar@codesourcery.com>

	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.

diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index f514866..fa6587e 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -396,43 +396,66 @@ 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;
+	    {
+	      /* 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;
+	    }
+
+	  ret = gfc_match (" , ");
 	}
+    }
+  else if (gwv == GOMP_DIM_WORKER)
+    {
+      /* The 'num' arugment is optional.  */
+      if (gfc_match (" num :") == MATCH_ERROR)
+	return MATCH_ERROR;
 
-      ret = gfc_match (" , ");
+      if (gfc_match (" %e ", &cp->worker_expr) != MATCH_YES)
+	return MATCH_ERROR;
     }
+  else if (gwv == GOMP_DIM_VECTOR)
+    {
+      /* The 'length' arugment is optional.  */
+      if (gfc_match (" length :") == MATCH_ERROR)
+	return MATCH_ERROR;
 
-  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
@@ -630,9 +653,10 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask,
 {
   gfc_omp_clauses *c = gfc_get_omp_clauses ();
   locus old_loc;
+  bool seen_error = false;
 
   *cp = NULL;
-  while (1)
+  while (!seen_error)
     {
       if ((first || gfc_match_char (',') != MATCH_YES)
 	  && (needs_space && gfc_match_space () != MATCH_YES))
@@ -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)
+		{
+		  seen_error = true;
+		  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)
+		{
+		  seen_error = true;
+		  break;
+		}
+	      else if (m == MATCH_NO)
 		needs_space = true;
 	      continue;
 	    }
@@ -1275,9 +1309,16 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask,
 	    continue;
 	  if ((mask & OMP_CLAUSE_TILE)
 	      && !c->tile_list
-	      && match_oacc_expr_list ("tile (", &c->tile_list,
-				       true) == MATCH_YES)
-	    continue;
+	      && gfc_match ("tile") == MATCH_YES)
+	    {
+	      if (match_oacc_expr_list (" (", &c->tile_list, true) != MATCH_YES)
+		{
+		  seen_error = true;
+		  break;
+		}
+	      needs_space = true;
+	      continue;
+	    }
 	  if ((mask & OMP_CLAUSE_TO)
 	      && gfc_match_omp_variable_list ("to (",
 					      &c->lists[OMP_LIST_TO], false,
@@ -1309,10 +1350,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)
+		{
+		  seen_error = true;
+		  break;
+		}
+	      if (m == MATCH_NO)
 		needs_space = true;
 	      continue;
 	    }
@@ -1328,7 +1372,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)
+		{
+		  seen_error = true;
+		  break;
+		}
+	      else if (m == MATCH_NO)
+		needs_space = true;
 	      continue;
 	    }
 	  if ((mask & OMP_CLAUSE_WORKER)
@@ -1336,10 +1387,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)
+		{
+		  seen_error = true;
+		  break;
+		}
+	      else if (m == MATCH_NO)
 		needs_space = true;
 	      continue;
 	    }
@@ -1348,7 +1402,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask,
       break;
     }
 
-  if (gfc_match_omp_eos () != MATCH_YES)
+  if (seen_error || gfc_match_omp_eos () != MATCH_YES)
     {
       gfc_free_omp_clauses (c);
       return MATCH_ERROR;
@@ -1595,15 +1649,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/gfortran.dg/goacc/asyncwait-2.f95 b/gcc/testsuite/gfortran.dg/goacc/asyncwait-2.f95
index db0ce1f..7b2ae07 100644
--- 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 32c11de..ed72a9b 100644
--- 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 cd64ef3..df31154 100644
--- 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