Another of those changes where fixing testcases starts to take
longer than actually implementing it. OpenMP added at some point the
support for an optional comma between directive name and the
first clause:
#pragma omp parallel, firstprivate(x)
looks odd - but it makes more sense for attributes, which I think
was the reason for it:
[[omp::directive(parallel, firstprivate(x))]];
which I think was the reason for adding it. OpenMP 5.2 was
hugely reorganized, esp. moving to JSON generation of files
and trying to make things more generic - as part of this,
the following is now applicable to all languages:
directive-specifier [[,] clause[ [,] clause] ... ]
including Fortran. Hence, this patch now adds support for it.
Being there, I tried to check some more cases of code like
directive-specifier(arg)clause without separating space
I think I fixed a case on the way, but I am not sure. In any case,
I hope I caught all cases for the extra comma (and not required space)
- and, surely, the new testcase helped to find a few I thought I
had fixed but missed a case (like one of the spaces in " , " was not
handled).
I intent to commit it later today, unless there are comments.
Tobias
PS: While being there, I noticed that for C/C++ but not for Fortran
we missed to implement the 'hint' clause support for CRITICAL - a 4.5
feature. (It is supported for 'atomic' and it is actually passed on to
the ME and only ignored there.) - That's something still to add.
OpenMP/Fortran: Permit comma between directive and clause
This was added in OpenMP 5.2 when the syntax between Fortran and
C/C++ was aligned a bit more. In C/C++ it was added presumably
to have a nicer attribute syntax.
gcc/fortran/ChangeLog:
* openmp.cc (gfc_match_omp_clauses): Rename argument 'first'
to first_no_comma for clarity.
(match_omp, gfc_match_omp_allocate, gfc_match_omp_assume,
gfc_match_omp_assumes, gfc_match_omp_critical,
gfc_match_omp_depobj, gfc_match_omp_flush,
gfc_match_omp_declare_simd, gfc_match_omp_declare_mapper,
gfc_match_omp_declare_reduction, gfc_match_omp_declare_target,
gfc_match_omp_thread_group_private, gfc_match_omp_requires,
gfc_match_omp_scan, gfc_match_omp_atomic,
gfc_match_omp_cancel_kind, gfc_match_omp_end_nowait,
gfc_match_omp_end_single): Permit comma between directive name
and clause name.
libgomp/ChangeLog:
* libgomp.texi (OpenMP 5.2 Impl. Status): Mark comma between
directive name and first clause as implemented in Fortran.
gcc/testsuite/ChangeLog:
* gfortran.dg/gomp/directive-comma-clause.f90: New test.
gcc/fortran/openmp.cc | 50 +++---
.../gfortran.dg/gomp/directive-comma-clause.f90 | 170 +++++++++++++++++++++
libgomp/libgomp.texi | 2 +-
3 files changed, 198 insertions(+), 24 deletions(-)
diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc
index 6737e1e3796..d49fa79b3b4 100644
--- a/gcc/fortran/openmp.cc
+++ b/gcc/fortran/openmp.cc
@@ -2586,7 +2586,7 @@ gfc_find_omp_udm (gfc_namespace *ns, const char *mapper_id, gfc_typespec *ts)
static match
gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
- bool first = true, bool needs_space = true,
+ bool first_no_comma = true, bool needs_space = true,
bool openacc = false, bool openmp_target = false,
gfc_omp_map_op default_map_op = OMP_MAP_TOFROM)
{
@@ -2606,11 +2606,11 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
while (1)
{
match m = MATCH_NO;
- if ((first || (m = gfc_match_char (',')) != MATCH_YES)
+ if ((first_no_comma || (m = gfc_match_char (',')) != MATCH_YES)
&& (needs_space && gfc_match_space () != MATCH_YES))
break;
needs_space = false;
- first = false;
+ first_no_comma = false;
gfc_gobble_whitespace ();
bool end_colon;
gfc_omp_namelist **head;
@@ -5776,7 +5776,7 @@ static match
match_omp (gfc_exec_op op, const omp_mask mask)
{
gfc_omp_clauses *c;
- if (gfc_match_omp_clauses (&c, mask, true, true, false,
+ if (gfc_match_omp_clauses (&c, mask, false, true, false,
op == EXEC_OMP_TARGET) != MATCH_YES)
return MATCH_ERROR;
new_st.op = op;
@@ -5801,7 +5801,6 @@ match
gfc_match_omp_allocate (void)
{
match m;
- bool first = true;
gfc_omp_namelist *vars = NULL;
gfc_expr *align = NULL;
gfc_expr *allocator = NULL;
@@ -5818,9 +5817,7 @@ gfc_match_omp_allocate (void)
gfc_gobble_whitespace ();
if (gfc_match_omp_eos () == MATCH_YES)
break;
- if (!first)
- gfc_match (", ");
- first = false;
+ gfc_match (", "); /* optionally */
if ((m = gfc_match_dupl_check (!align, "align", true, &align))
!= MATCH_NO)
{
@@ -5896,7 +5893,7 @@ gfc_match_omp_assume (void)
{
gfc_omp_clauses *c;
locus loc = gfc_current_locus;
- if ((gfc_match_omp_clauses (&c, omp_mask (OMP_CLAUSE_ASSUMPTIONS))
+ if ((gfc_match_omp_clauses (&c, omp_mask (OMP_CLAUSE_ASSUMPTIONS), false)
!= MATCH_YES)
|| (omp_verify_merge_absent_contains (ST_OMP_ASSUME, c->assume, NULL,
&loc) != MATCH_YES))
@@ -5921,7 +5918,7 @@ gfc_match_omp_assumes (void)
"subprogram or module");
return MATCH_ERROR;
}
- if ((gfc_match_omp_clauses (&c, omp_mask (OMP_CLAUSE_ASSUMPTIONS))
+ if ((gfc_match_omp_clauses (&c, omp_mask (OMP_CLAUSE_ASSUMPTIONS), false)
!= MATCH_YES)
|| (omp_verify_merge_absent_contains (ST_OMP_ASSUMES, c->assume,
gfc_current_ns->omp_assumes, &loc)
@@ -5965,8 +5962,8 @@ gfc_match_omp_critical (void)
if (gfc_match (" ( %n )", n) != MATCH_YES)
n[0] = '\0';
- if (gfc_match_omp_clauses (&c, omp_mask (OMP_CLAUSE_HINT),
- /* first = */ n[0] == '\0') != MATCH_YES)
+ if (gfc_match_omp_clauses (&c, omp_mask (OMP_CLAUSE_HINT), false,
+ /* needs_space = */ n[0] == '\0') != MATCH_YES)
return MATCH_ERROR;
new_st.op = EXEC_OMP_CRITICAL;
@@ -6011,6 +6008,7 @@ gfc_match_omp_depobj (void)
gfc_error ("Expected %<( depobj )%> at %C");
return MATCH_ERROR;
}
+ gfc_match (", "); /* optionally */
if (gfc_match ("update ( ") == MATCH_YES)
{
c = gfc_get_omp_clauses ();
@@ -6046,7 +6044,7 @@ gfc_match_omp_depobj (void)
gfc_free_expr (destroyobj);
}
}
- else if (gfc_match_omp_clauses (&c, omp_mask (OMP_CLAUSE_DEPEND), true, false)
+ else if (gfc_match_omp_clauses (&c, omp_mask (OMP_CLAUSE_DEPEND), false, false)
!= MATCH_YES)
goto error;
@@ -6249,6 +6247,7 @@ gfc_match_omp_flush (void)
enum gfc_omp_memorder mo = OMP_MEMORDER_UNSET;
if (gfc_match_omp_eos () == MATCH_NO && gfc_peek_ascii_char () != '(')
{
+ gfc_match (", "); /* optionally */
if (gfc_match ("seq_cst") == MATCH_YES)
mo = OMP_MEMORDER_SEQ_CST;
else if (gfc_match ("acq_rel") == MATCH_YES)
@@ -6308,7 +6307,7 @@ gfc_match_omp_declare_simd (void)
case MATCH_ERROR: return MATCH_ERROR;
}
- if (gfc_match_omp_clauses (&c, OMP_DECLARE_SIMD_CLAUSES, true,
+ if (gfc_match_omp_clauses (&c, OMP_DECLARE_SIMD_CLAUSES, false,
needs_space) != MATCH_YES)
return MATCH_ERROR;
@@ -6450,7 +6449,7 @@ gfc_match_omp_declare_mapper (void)
gfc_omp_clauses *clauses = NULL;
- m = gfc_match_omp_clauses (&clauses, omp_mask (OMP_CLAUSE_MAP), true, true,
+ m = gfc_match_omp_clauses (&clauses, omp_mask (OMP_CLAUSE_MAP), false, false,
false, false, OMP_MAP_UNSET);
if (m != MATCH_YES)
goto failure;
@@ -6844,7 +6843,7 @@ gfc_match_omp_declare_reduction (void)
gfc_free_omp_udr (omp_udr);
return MATCH_ERROR;
}
-
+ gfc_match_char (','); /* optionally */
if (gfc_match (" initializer ( ") == MATCH_YES)
{
gfc_current_ns = combiner_ns->parent;
@@ -6973,7 +6972,8 @@ gfc_match_omp_declare_target (void)
goto cleanup;
}
}
- else if (gfc_match_omp_clauses (&c, OMP_DECLARE_TARGET_CLAUSES) != MATCH_YES)
+ else if (gfc_match_omp_clauses (&c, OMP_DECLARE_TARGET_CLAUSES, false)
+ != MATCH_YES)
return MATCH_ERROR;
gfc_buffer_error (false);
@@ -8116,7 +8116,7 @@ gfc_match_omp_thread_group_private (bool is_groupprivate)
if (is_groupprivate)
{
gfc_omp_clauses *c;
- m = gfc_match_omp_clauses (&c, omp_mask (OMP_CLAUSE_DEVICE_TYPE));
+ m = gfc_match_omp_clauses (&c, omp_mask (OMP_CLAUSE_DEVICE_TYPE), false, false);
if (m == MATCH_ERROR)
return MATCH_ERROR;
@@ -8459,7 +8459,7 @@ gfc_match_omp_requires (void)
{
old_loc = gfc_current_locus;
gfc_omp_requires_kind requires_clause;
- if ((first || gfc_match_char (',') != MATCH_YES)
+ if (gfc_match_char (',') != MATCH_YES
&& (first && gfc_match_space () != MATCH_YES))
goto error;
first = false;
@@ -8573,6 +8573,7 @@ gfc_match_omp_scan (void)
bool incl;
gfc_omp_clauses *c = gfc_get_omp_clauses ();
gfc_gobble_whitespace ();
+ gfc_match (", "); /* optionally */
if ((incl = (gfc_match ("inclusive") == MATCH_YES))
|| gfc_match ("exclusive") == MATCH_YES)
{
@@ -8959,7 +8960,7 @@ gfc_match_omp_atomic (void)
gfc_omp_clauses *c;
locus loc = gfc_current_locus;
- if (gfc_match_omp_clauses (&c, OMP_ATOMIC_CLAUSES, true, true) != MATCH_YES)
+ if (gfc_match_omp_clauses (&c, OMP_ATOMIC_CLAUSES, false, true) != MATCH_YES)
return MATCH_ERROR;
if (c->atomic_op == GFC_OMP_ATOMIC_UNSET)
@@ -9118,7 +9119,8 @@ gfc_match_omp_taskgroup (void)
static enum gfc_omp_cancel_kind
gfc_match_omp_cancel_kind (void)
{
- if (gfc_match_space () != MATCH_YES)
+ if (gfc_match (" , ") != MATCH_YES
+ && gfc_match_space () != MATCH_YES)
return OMP_CANCEL_UNKNOWN;
if (gfc_match ("parallel") == MATCH_YES)
return OMP_CANCEL_PARALLEL;
@@ -9177,7 +9179,8 @@ match
gfc_match_omp_end_nowait (void)
{
bool nowait = false;
- if (gfc_match ("% nowait") == MATCH_YES)
+ if (gfc_match ("% nowait ") == MATCH_YES
+ || gfc_match (" , nowait ") == MATCH_YES)
nowait = true;
if (gfc_match_omp_eos () != MATCH_YES)
{
@@ -9198,7 +9201,8 @@ gfc_match_omp_end_single (void)
{
gfc_omp_clauses *c;
if (gfc_match_omp_clauses (&c, omp_mask (OMP_CLAUSE_COPYPRIVATE)
- | OMP_CLAUSE_NOWAIT) != MATCH_YES)
+ | OMP_CLAUSE_NOWAIT, false)
+ != MATCH_YES)
return MATCH_ERROR;
new_st.op = EXEC_OMP_END_SINGLE;
new_st.ext.omp_clauses = c;
diff --git a/gcc/testsuite/gfortran.dg/gomp/directive-comma-clause.f90 b/gcc/testsuite/gfortran.dg/gomp/directive-comma-clause.f90
new file mode 100644
index 00000000000..6ca8438a45e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/directive-comma-clause.f90
@@ -0,0 +1,170 @@
+! Check for comma between directive and first clause
+! Additionally, check that no space is requires between directive(...)
+! and the first clause
+
+module m
+ use iso_c_binding, only: c_size_t
+ implicit none
+
+ ! from omp_lib:
+ integer, parameter :: omp_depend_kind = 2*c_size_t
+
+ !$omp requires,dynamic_allocators
+ !$omp requires , reverse_offload
+
+ !$omp assumes,contains(parallel)
+ !$omp assumes , holds(1 > 0)
+ type t
+ integer :: x
+ end type
+ !$omp declare mapper(t :: v)map(v%x)
+ !$omp declare mapper(other : t :: v),map(v%x)
+ !$omp declare mapper(other2 : t :: v) , map(v%x)
+ !$omp declare_mapper(other3 : t :: v)map(v%x)
+ !$omp declare_mapper(other4 : t :: v),map(v%x)
+ !$omp declare_mapper(other5 : t :: v) , map(v%x)
+
+ !$omp declare reduction(one1 : t : omp_out%x = omp_out%x + omp_in%x)initializer(omp_priv%x = 0)
+ !$omp declare reduction(one2 : t : omp_out%x = omp_out%x + omp_in%x),initializer(omp_priv%x = 0)
+ !$omp declare reduction(one3 : t : omp_out%x = omp_out%x + omp_in%x) , initializer(omp_priv%x = 0)
+ !$omp declare_reduction(one4 : t : omp_out%x = omp_out%x + omp_in%x)initializer(omp_priv%x = 0)
+ !$omp declare_reduction(one5 : t : omp_out%x = omp_out%x + omp_in%x),initializer(omp_priv%x = 0)
+ !$omp declare_reduction(one6 : t : omp_out%x = omp_out%x + omp_in%x) , initializer(omp_priv%x = 0)
+
+interface
+ integer function bar1 (x, y, z)
+ integer, value :: x, y, z
+ !$omp declare simd linear (x : val, step (1))linear (y : step (2))
+ end
+ integer function bar2 (x, y, z)
+ integer, value :: x, y, z
+ !$omp declare simd linear (x : val, step (1)),linear (y : step (2))
+ end
+ integer function bar3 (x, y, z)
+ integer, value :: x, y, z
+ !$omp declare simd linear (x : val, step (1)) , linear (y : step (2))
+ end
+ integer function bar4 (x, y, z)
+ integer, value :: x, y, z
+ !$omp declare_simd linear (x : val, step (1))linear (y : step (2))
+ end
+ integer function bar5 (x, y, z)
+ integer, value :: x, y, z
+ !$omp declare_simd linear (x : val, step (1)),linear (y : step (2))
+ end
+ integer function bar6 (x, y, z)
+ integer, value :: x, y, z
+ !$omp declare_simd linear (x : val, step (1)) , linear (y : step (2))
+ end
+end interface
+
+ integer :: a1,a2,a3,a4
+ !$omp declare target,enter(a1)
+ !$omp declare target , enter (a2)
+ !$omp declare_target,enter(a3)
+ !$omp declare_target , enter( a4 )
+
+contains
+ subroutine sub1; end subroutine
+ subroutine sub2; end subroutine
+ subroutine sub3; end subroutine
+ subroutine sub4; end subroutine
+ subroutine sub5; end subroutine
+ subroutine sub6; end subroutine
+ subroutine sub
+ !$omp declare variant(sub1)match(construct={parallel})
+ !$omp declare variant(sub2),match(construct={target})
+ !$omp declare variant(sub3) , match(construct={teams})
+ !$omp declare_variant(sub4)match(construct={target,teams})
+ !$omp declare_variant(sub5),match(user={condition(huge(a2) > 0)})
+ !$omp declare_variant(sub6) , match(user={condition(kind(a1) < 0)})
+
+ !$omp assume,holds(a1 > 0)
+ !$omp assume , holds(a2 < 0)
+ !$omp end assume
+ !$omp end assume
+
+ !$omp begin metadirective,when(user={condition(a3 > 0)}: parallel)
+ a1 = 0
+ !$omp end metadirective
+ !$omp begin metadirective , when(user={condition(a4 > 0)}: parallel)
+ a2 = 0
+ !$omp end metadirective
+
+ !$omp error,at(execution),message("Hello")
+ !$omp error , at(execution) , message("world")
+
+ !$omp metadirective,when(user={condition(a1 /= a2)}: flush)
+ !$omp metadirective , when(user={condition(a2 /= a3)}: taskwait)
+ end subroutine
+
+ subroutine othersub
+ integer :: i, j
+
+ !$omp simd,private(j)
+ do i = 1,1; j = i; end do
+ !$omp simd , private(j)
+ do i = 1,1; j = i; end do
+
+ !$omp do,private(j)
+ do i = 1,1; j = i; end do
+ !$omp do, private(j)
+ do i = 1,1; j = i; end do
+
+ !$omp do simd,private(j)
+ do i = 1,1; j = i; end do
+ !$omp do simd , private(j)
+ do i = 1,1; j = i; end do
+
+ !$omp target parallel,firstprivate(j)
+ !$omp cancellation point,parallel
+ !$omp cancel,parallel
+ !$omp end target parallel,nowait
+
+ !$omp target parallel , firstprivate(j)
+ !$omp cancellation point , parallel
+ !$omp cancel , parallel
+ !$omp end target parallel , nowait
+
+ !$omp parallel , firstprivate(j)
+ !$omp cancellation_point , parallel
+ !$omp cancel,parallel
+ !$omp end parallel
+
+ !$omp parallel , firstprivate(j)
+ !$omp cancellation point , parallel
+ !$omp cancel , parallel
+ !$omp end parallel
+
+ !$omp atomic,update
+ a1 = a1 + 1
+ !$omp end atomic
+ !$omp atomic , read
+ j = a1
+ !$omp end atomic
+
+ !$omp single,nowait
+ !$omp end single
+ !$omp single , nowait
+ !$omp end single
+ !$omp single
+
+ !$omp end single,nowait
+ !$omp single
+ !$omp end single , nowait
+ end
+
+ subroutine foo
+ integer, save :: i, j, k
+ !$omp groupprivate(k)device_type(nohost)
+ !$omp groupprivate(i),device_type(nohost)
+ !$omp groupprivate(j) , device_type(nohost)
+ end
+
+ subroutine bar
+ integer(omp_depend_kind) :: obj
+ !$omp depobj(obj),depend(in: a1)
+ !$omp depobj(obj)destroy
+ !$omp depobj(obj) , destroy
+ end
+end module m
diff --git a/libgomp/libgomp.texi b/libgomp/libgomp.texi
index b3700d7f142..4a106983308 100644
--- a/libgomp/libgomp.texi
+++ b/libgomp/libgomp.texi
@@ -442,7 +442,7 @@ to address of matching mapped list item per 5.1, Sect. 2.21.7.2 @tab N @tab
@multitable @columnfractions .60 .10 .25
@headitem Description @tab Status @tab Comments
-@item For Fortran, optional comma between directive and clause @tab N @tab
+@item For Fortran, optional comma between directive and clause @tab Y @tab
@item Conforming device numbers and @code{omp_initial_device} and
@code{omp_invalid_device} enum/PARAMETER @tab Y @tab
@item Initial value of @var{default-device-var} ICV with
