Skip to content

R
riscv-gcc-1
Commit 27f67461 by Cesar Philippidis Committed by Cesar Philippidis
Options

openmp.c (match_oacc_clause_gang): Rename to ... 

	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.

From-SVN: r237854
parent b1206d29
Showing with 146 additions and 62 deletions
gcc/fortran/ChangeLog
2016-06-29 Cesar Philippidis <cesar@codesourcery.com>
* 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.
2016-06-29 Richard Biener <rguenther@suse.de> 2016-06-29 Richard Biener <rguenther@suse.de>
PR middle-end/71002 PR middle-end/71002
......
gcc/fortran/openmp.c
...@@ -396,43 +396,67 @@ cleanup: ...@@ -396,43 +396,67 @@ cleanup:
} }
static match static match
match_oacc_clause_gang (gfc_omp_clauses *cp) match_oacc_clause_gwv (gfc_omp_clauses *cp, unsigned gwv)
{ {
match ret = MATCH_YES; match ret = MATCH_YES;
if (gfc_match (" ( ") != MATCH_YES) if (gfc_match (" ( ") != MATCH_YES)
return MATCH_NO; return MATCH_NO;
/* The gang clause accepts two optional arguments, num and static. if (gwv == GOMP_DIM_GANG)
The num argument may either be explicit (num: <val>) or
implicit without (<val> without num:). */
while (ret == MATCH_YES)
{ {
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) if (gfc_match (" static :") == MATCH_YES)
return MATCH_ERROR; {
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 else
cp->gang_static = true; {
if (gfc_match_char ('*') == MATCH_YES) if (cp->gang_num_expr)
cp->gang_static_expr = NULL; return MATCH_ERROR;
else if (gfc_match (" %e ", &cp->gang_static_expr) != MATCH_YES)
return MATCH_ERROR; /* The 'num' argument is optional. */
} gfc_match (" num :");
else
{ if (gfc_match (" %e ", &cp->gang_num_expr) != MATCH_YES)
/* This is optional. */ return MATCH_ERROR;
if (cp->gang_num_expr || gfc_match (" num :") == MATCH_ERROR) }
return MATCH_ERROR;
else if (gfc_match (" %e ", &cp->gang_num_expr) != MATCH_YES) ret = gfc_match (" , ");
return MATCH_ERROR;
} }
}
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 static match
...@@ -677,14 +701,20 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask, ...@@ -677,14 +701,20 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask,
&& gfc_match ("async") == MATCH_YES) && gfc_match ("async") == MATCH_YES)
{ {
c->async = true; c->async = true;
needs_space = false; match m = gfc_match (" ( %e )", &c->async_expr);
if (gfc_match (" ( %e )", &c->async_expr) != MATCH_YES) if (m == MATCH_ERROR)
{
gfc_current_locus = old_loc;
break;
}
else if (m == MATCH_NO)
{ {
c->async_expr c->async_expr
= gfc_get_constant_expr (BT_INTEGER, = gfc_get_constant_expr (BT_INTEGER,
gfc_default_integer_kind, gfc_default_integer_kind,
&gfc_current_locus); &gfc_current_locus);
mpz_set_si (c->async_expr->value.integer, GOMP_ASYNC_NOVAL); mpz_set_si (c->async_expr->value.integer, GOMP_ASYNC_NOVAL);
needs_space = true;
} }
continue; continue;
} }
...@@ -877,9 +907,13 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask, ...@@ -877,9 +907,13 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask,
&& gfc_match ("gang") == MATCH_YES) && gfc_match ("gang") == MATCH_YES)
{ {
c->gang = true; c->gang = true;
if (match_oacc_clause_gang(c) == MATCH_YES) match m = match_oacc_clause_gwv (c, GOMP_DIM_GANG);
needs_space = false; if (m == MATCH_ERROR)
else {
gfc_current_locus = old_loc;
break;
}
else if (m == MATCH_NO)
needs_space = true; needs_space = true;
continue; continue;
} }
...@@ -1309,10 +1343,13 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask, ...@@ -1309,10 +1343,13 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask,
&& gfc_match ("vector") == MATCH_YES) && gfc_match ("vector") == MATCH_YES)
{ {
c->vector = true; c->vector = true;
if (gfc_match (" ( length : %e )", &c->vector_expr) == MATCH_YES match m = match_oacc_clause_gwv (c, GOMP_DIM_VECTOR);
|| gfc_match (" ( %e )", &c->vector_expr) == MATCH_YES) if (m == MATCH_ERROR)
needs_space = false; {
else gfc_current_locus = old_loc;
break;
}
if (m == MATCH_NO)
needs_space = true; needs_space = true;
continue; continue;
} }
...@@ -1328,7 +1365,14 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask, ...@@ -1328,7 +1365,14 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask,
&& gfc_match ("wait") == MATCH_YES) && gfc_match ("wait") == MATCH_YES)
{ {
c->wait = true; 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; continue;
} }
if ((mask & OMP_CLAUSE_WORKER) if ((mask & OMP_CLAUSE_WORKER)
...@@ -1336,10 +1380,13 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask, ...@@ -1336,10 +1380,13 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask,
&& gfc_match ("worker") == MATCH_YES) && gfc_match ("worker") == MATCH_YES)
{ {
c->worker = true; c->worker = true;
if (gfc_match (" ( num : %e )", &c->worker_expr) == MATCH_YES match m = match_oacc_clause_gwv (c, GOMP_DIM_WORKER);
|| gfc_match (" ( %e )", &c->worker_expr) == MATCH_YES) if (m == MATCH_ERROR)
needs_space = false; {
else gfc_current_locus = old_loc;
break;
}
else if (m == MATCH_NO)
needs_space = true; needs_space = true;
continue; continue;
} }
...@@ -1595,15 +1642,18 @@ gfc_match_oacc_wait (void) ...@@ -1595,15 +1642,18 @@ gfc_match_oacc_wait (void)
{ {
gfc_omp_clauses *c = gfc_get_omp_clauses (); gfc_omp_clauses *c = gfc_get_omp_clauses ();
gfc_expr_list *wait_list = NULL, *el; gfc_expr_list *wait_list = NULL, *el;
bool space = true;
match m;
match_oacc_expr_list (" (", &wait_list, true); m = match_oacc_expr_list (" (", &wait_list, true);
gfc_match_omp_clauses (&c, OACC_WAIT_CLAUSES, false, false, true); if (m == MATCH_ERROR)
return m;
else if (m == MATCH_YES)
space = false;
if (gfc_match_omp_eos () != MATCH_YES) if (gfc_match_omp_clauses (&c, OACC_WAIT_CLAUSES, space, space, true)
{ == MATCH_ERROR)
gfc_error ("Unexpected junk in !$ACC WAIT at %C"); return MATCH_ERROR;
return MATCH_ERROR;
}
if (wait_list) if (wait_list)
for (el = wait_list; el; el = el->next) for (el = wait_list; el; el = el->next)
......
gcc/testsuite/ChangeLog
2016-06-29 Cesar Philippidis <cesar@codesourcery.com>
* 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.
2016-06-29 Richard Biener <rguenther@suse.de> 2016-06-29 Richard Biener <rguenther@suse.de>
PR middle-end/15256 PR middle-end/15256
......
gcc/testsuite/gfortran.dg/goacc/asyncwait-2.f95
...@@ -83,6 +83,18 @@ program asyncwait ...@@ -83,6 +83,18 @@ program asyncwait
end do end do
!$acc end parallel ! { dg-error "Unexpected \\\!\\\$ACC END PARALLEL" } !$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 !$acc parallel copyin (a(1:N)) copy (b(1:N)) wait
do i = 1, N do i = 1, N
b(i) = a(i) b(i) = a(i)
......
gcc/testsuite/gfortran.dg/goacc/asyncwait-3.f95
...@@ -11,17 +11,17 @@ program asyncwait ...@@ -11,17 +11,17 @@ program asyncwait
a(:) = 3.0 a(:) = 3.0
b(:) = 0.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" } !$acc wait (1, *) ! { dg-error "Invalid argument to \\\$\\\!ACC WAIT" }
...@@ -33,9 +33,9 @@ program asyncwait ...@@ -33,9 +33,9 @@ program asyncwait
!$acc wait (1.0) ! { dg-error "WAIT clause at \\\(1\\\) requires a scalar INTEGER expression" } !$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) !$acc wait (1)
end program asyncwait end program asyncwait
gcc/testsuite/gfortran.dg/goacc/asyncwait-4.f95
...@@ -11,21 +11,21 @@ program asyncwait ...@@ -11,21 +11,21 @@ program asyncwait
a(:) = 3.0 a(:) = 3.0
b(:) = 0.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" } !$acc wait async (a) ! { dg-error "ASYNC clause at \\\(1\\\) requires a scalar INTEGER expression" }
...@@ -33,5 +33,9 @@ program asyncwait ...@@ -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.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 end program asyncwait
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment