On 06/27/2016 12:23 PM, Jakub Jelinek wrote:
> On Mon, Jun 27, 2016 at 11:36:26AM -0700, Cesar Philippidis wrote:
>> @@ -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))
>
> Why?
> The main loop is while (1) which has break; as the last statement.
> Instead of setting seen_error, just set
> gfc_current_locus = old_loc;
> if you have already matched successfully something, and then break;
> as you already do.
I made that change.
>> @@ -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,
>
> So, tile without ()s is also a valid clause in OpenACC?
> If yes, what do you set in c structure for the existence of the clause?
> If it is not valid, then the above change looks wrong.
No. The tile clause always was a () argument. So I should have used
gfc_match_omp_variable_list ("tile (", &c->tile_list) instead. This
patch fixes that.
>> @@ -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);
>
> Formatting, space before (.
Fixed.
>> @@ -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;
>
> Again, IMHO not needed, if you restore the old_loc into gfc_current_loc,
> then gfc_match_omp_eos () will surely fail.
Fixed.
Is this ok for trunk and gcc6?
Cesar
2016-06-27 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 f514866..a691af9 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;
+
+ 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;
- 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 +700,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 +906,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;
}
@@ -1275,8 +1308,8 @@ 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)
+ && match_oacc_expr_list ("tile (", &c->tile_list, true)
+ == MATCH_YES)
continue;
if ((mask & OMP_CLAUSE_TO)
&& gfc_match_omp_variable_list ("to (",
@@ -1309,10 +1342,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 +1364,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 +1379,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 +1641,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
