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.
@@ -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)
@@ -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)
@@ -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
@@ -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