I've applied this patch to gomp-4_0-branch which backports the recent
error handling changes I made to the fortran FE. The discussion for the
original patch for trunk can be found in this thread
<https://gcc.gnu.org/ml/gcc-patches/2016-06/msg00474.html>.
2016-07-01 Cesar Philippidis <ce...@codesourcery.com>
Back port from trunk
2016-06-29 Cesar Philippidis <ce...@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 cc4583d..8071da0 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -397,43 +397,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
@@ -683,14 +707,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;
}
@@ -944,9 +974,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;
}
@@ -1383,10 +1417,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;
}
@@ -1402,7 +1439,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)
@@ -1410,10 +1454,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;
}
@@ -1758,15 +1805,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, 0, 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, 0, 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..fe4e4ee 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
