OpenMP/Fortran: Add support for OpenMP 5.2 linear clause syntax

Fortran part to C/C++
commit r13-1002-g03b71406323ddc065b1d7837d8b43b17e4b048b5

gcc/fortran/ChangeLog:

	* gfortran.h (gfc_omp_namelist): Update by creating 'linear' struct,
	move 'linear_op' as 'op' to id and add 'old_modifier' to it.
	* dump-parse-tree.cc (show_omp_namelist): Update accordingly.
	* module.cc (mio_omp_declare_simd): Likewise.
	* trans-openmp.cc (gfc_trans_omp_clauses): Likewise.
	* openmp.cc (resolve_omp_clauses): Likewise; accept new-style
	'val' modifier with do/simd.
	(gfc_match_omp_clauses): Handle OpenMP 5.2 linear clause syntax.

libgomp/ChangeLog:

	* libgomp.texi (OpenMP 5.2): Mark linear-clause change as 'Y'.

gcc/testsuite/ChangeLog:

	* c-c++-common/gomp/linear-4.c: New test.
	* gfortran.dg/gomp/linear-2.f90: New test.
	* gfortran.dg/gomp/linear-3.f90: New test.
	* gfortran.dg/gomp/linear-4.f90: New test.
	* gfortran.dg/gomp/linear-5.f90: New test.
	* gfortran.dg/gomp/linear-6.f90: New test.
	* gfortran.dg/gomp/linear-7.f90: New test.
	* gfortran.dg/gomp/linear-8.f90: New test.

Co-authored-by: Jakub Jelinek <jakub@redhat.com>
This commit is contained in:
Tobias Burnus 2022-07-04 21:50:23 +02:00
parent ce8dbe7d83
commit c3297044f0
14 changed files with 613 additions and 30 deletions

View file

@ -1421,8 +1421,8 @@ show_omp_namelist (int list_type, gfc_omp_namelist *n)
case OMP_MAP_RELEASE: fputs ("release:", dumpfile); break;
default: break;
}
else if (list_type == OMP_LIST_LINEAR)
switch (n->u.linear_op)
else if (list_type == OMP_LIST_LINEAR && n->u.linear.old_modifier)
switch (n->u.linear.op)
{
case OMP_LINEAR_REF: fputs ("ref(", dumpfile); break;
case OMP_LINEAR_VAL: fputs ("val(", dumpfile); break;
@ -1430,7 +1430,7 @@ show_omp_namelist (int list_type, gfc_omp_namelist *n)
default: break;
}
fprintf (dumpfile, "%s", n->sym ? n->sym->name : "omp_all_memory");
if (list_type == OMP_LIST_LINEAR && n->u.linear_op != OMP_LINEAR_DEFAULT)
if (list_type == OMP_LIST_LINEAR && n->u.linear.op != OMP_LINEAR_DEFAULT)
fputc (')', dumpfile);
if (n->expr)
{

View file

@ -1345,7 +1345,11 @@ typedef struct gfc_omp_namelist
gfc_omp_reduction_op reduction_op;
gfc_omp_depend_op depend_op;
gfc_omp_map_op map_op;
gfc_omp_linear_op linear_op;
struct
{
ENUM_BITFIELD (gfc_omp_linear_op) op:4;
bool old_modifier;
} linear;
struct gfc_common_head *common;
bool lastprivate_conditional;
} u;

View file

@ -4383,10 +4383,10 @@ mio_omp_declare_simd (gfc_namespace *ns, gfc_omp_declare_simd **odsp)
}
for (n = ods->clauses->lists[OMP_LIST_LINEAR]; n; n = n->next)
{
if (n->u.linear_op == OMP_LINEAR_DEFAULT)
if (n->u.linear.op == OMP_LINEAR_DEFAULT)
mio_name (4, omp_declare_simd_clauses);
else
mio_name (32 + n->u.linear_op, omp_declare_simd_clauses);
mio_name (32 + n->u.linear.op, omp_declare_simd_clauses);
mio_symbol_ref (&n->sym);
mio_expr (&n->expr);
}
@ -4438,7 +4438,7 @@ mio_omp_declare_simd (gfc_namespace *ns, gfc_omp_declare_simd **odsp)
case 34:
case 35:
*ptrs[1] = n = gfc_get_omp_namelist ();
n->u.linear_op = (enum gfc_omp_linear_op) (t - 32);
n->u.linear.op = (enum gfc_omp_linear_op) (t - 32);
t = 4;
goto finish_namelist;
}

View file

@ -2324,6 +2324,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
if ((mask & OMP_CLAUSE_LINEAR)
&& gfc_match ("linear (") == MATCH_YES)
{
bool old_linear_modifier = false;
gfc_omp_linear_op linear_op = OMP_LINEAR_DEFAULT;
gfc_expr *step = NULL;
@ -2331,17 +2332,26 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
&c->lists[OMP_LIST_LINEAR],
false, NULL, &head)
== MATCH_YES)
linear_op = OMP_LINEAR_REF;
{
linear_op = OMP_LINEAR_REF;
old_linear_modifier = true;
}
else if (gfc_match_omp_variable_list (" val (",
&c->lists[OMP_LIST_LINEAR],
false, NULL, &head)
== MATCH_YES)
linear_op = OMP_LINEAR_VAL;
{
linear_op = OMP_LINEAR_VAL;
old_linear_modifier = true;
}
else if (gfc_match_omp_variable_list (" uval (",
&c->lists[OMP_LIST_LINEAR],
false, NULL, &head)
== MATCH_YES)
linear_op = OMP_LINEAR_UVAL;
{
linear_op = OMP_LINEAR_UVAL;
old_linear_modifier = true;
}
else if (gfc_match_omp_variable_list ("",
&c->lists[OMP_LIST_LINEAR],
false, &end_colon, &head)
@ -2364,14 +2374,114 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
break;
}
}
if (end_colon && gfc_match (" %e )", &step) != MATCH_YES)
gfc_gobble_whitespace ();
if (old_linear_modifier && end_colon)
{
gfc_free_omp_namelist (*head, false);
gfc_current_locus = old_loc;
*head = NULL;
break;
if (gfc_match (" %e )", &step) != MATCH_YES)
{
gfc_free_omp_namelist (*head, false);
gfc_current_locus = old_loc;
*head = NULL;
goto error;
}
}
else if (!end_colon)
else if (end_colon)
{
bool has_error = false;
bool has_modifiers = false;
bool has_step = false;
bool duplicate_step = false;
bool duplicate_mod = false;
while (true)
{
old_loc = gfc_current_locus;
bool close_paren = gfc_match ("val )") == MATCH_YES;
if (close_paren || gfc_match ("val , ") == MATCH_YES)
{
if (linear_op != OMP_LINEAR_DEFAULT)
{
duplicate_mod = true;
break;
}
linear_op = OMP_LINEAR_VAL;
has_modifiers = true;
if (close_paren)
break;
continue;
}
close_paren = gfc_match ("uval )") == MATCH_YES;
if (close_paren || gfc_match ("uval , ") == MATCH_YES)
{
if (linear_op != OMP_LINEAR_DEFAULT)
{
duplicate_mod = true;
break;
}
linear_op = OMP_LINEAR_UVAL;
has_modifiers = true;
if (close_paren)
break;
continue;
}
close_paren = gfc_match ("ref )") == MATCH_YES;
if (close_paren || gfc_match ("ref , ") == MATCH_YES)
{
if (linear_op != OMP_LINEAR_DEFAULT)
{
duplicate_mod = true;
break;
}
linear_op = OMP_LINEAR_REF;
has_modifiers = true;
if (close_paren)
break;
continue;
}
close_paren = (gfc_match ("step ( %e ) )", &step)
== MATCH_YES);
if (close_paren
|| gfc_match ("step ( %e ) , ", &step) == MATCH_YES)
{
if (has_step)
{
duplicate_step = true;
break;
}
has_modifiers = has_step = true;
if (close_paren)
break;
continue;
}
if (!has_modifiers
&& gfc_match ("%e )", &step) == MATCH_YES)
{
if ((step->expr_type == EXPR_FUNCTION
|| step->expr_type == EXPR_VARIABLE)
&& strcmp (step->symtree->name, "step") == 0)
{
gfc_current_locus = old_loc;
gfc_match ("step (");
has_error = true;
}
break;
}
has_error = true;
break;
}
if (duplicate_mod || duplicate_step)
{
gfc_error ("Multiple %qs modifiers specified at %C",
duplicate_mod ? "linear" : "step");
has_error = true;
}
if (has_error)
{
gfc_free_omp_namelist (*head, false);
*head = NULL;
goto error;
}
}
else
{
step = gfc_get_constant_expr (BT_INTEGER,
gfc_default_integer_kind,
@ -2379,9 +2489,12 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
mpz_set_si (step->value.integer, 1);
}
(*head)->expr = step;
if (linear_op != OMP_LINEAR_DEFAULT)
if (linear_op != OMP_LINEAR_DEFAULT || old_linear_modifier)
for (gfc_omp_namelist *n = *head; n; n = n->next)
n->u.linear_op = linear_op;
{
n->u.linear.op = linear_op;
n->u.linear.old_modifier = old_linear_modifier;
}
continue;
}
if ((mask & OMP_CLAUSE_LINK)
@ -7439,28 +7552,38 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
break;
case OMP_LIST_LINEAR:
if (code
&& n->u.linear_op != OMP_LINEAR_DEFAULT
&& n->u.linear_op != linear_op)
&& n->u.linear.op != OMP_LINEAR_DEFAULT
&& n->u.linear.op != linear_op)
{
gfc_error ("LINEAR clause modifier used on DO or SIMD"
" construct at %L", &n->where);
linear_op = n->u.linear_op;
if (n->u.linear.old_modifier)
{
gfc_error ("LINEAR clause modifier used on DO or "
"SIMD construct at %L", &n->where);
linear_op = n->u.linear.op;
}
else if (n->u.linear.op != OMP_LINEAR_VAL)
{
gfc_error ("LINEAR clause modifier other than VAL "
"used on DO or SIMD construct at %L",
&n->where);
linear_op = n->u.linear.op;
}
}
else if (omp_clauses->orderedc)
gfc_error ("LINEAR clause specified together with "
"ORDERED clause with argument at %L",
&n->where);
else if (n->u.linear_op != OMP_LINEAR_REF
else if (n->u.linear.op != OMP_LINEAR_REF
&& n->sym->ts.type != BT_INTEGER)
gfc_error ("LINEAR variable %qs must be INTEGER "
"at %L", n->sym->name, &n->where);
else if ((n->u.linear_op == OMP_LINEAR_REF
|| n->u.linear_op == OMP_LINEAR_UVAL)
else if ((n->u.linear.op == OMP_LINEAR_REF
|| n->u.linear.op == OMP_LINEAR_UVAL)
&& n->sym->attr.value)
gfc_error ("LINEAR dummy argument %qs with VALUE "
"attribute with %s modifier at %L",
n->sym->name,
n->u.linear_op == OMP_LINEAR_REF
n->u.linear.op == OMP_LINEAR_REF
? "REF" : "UVAL", &n->where);
else if (n->expr)
{

View file

@ -2751,7 +2751,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
OMP_CLAUSE_LINEAR);
OMP_CLAUSE_DECL (node) = t;
omp_clause_linear_kind kind;
switch (n->u.linear_op)
switch (n->u.linear.op)
{
case OMP_LINEAR_DEFAULT:
kind = OMP_CLAUSE_LINEAR_DEFAULT;
@ -2769,7 +2769,8 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
gcc_unreachable ();
}
OMP_CLAUSE_LINEAR_KIND (node) = kind;
OMP_CLAUSE_LINEAR_OLD_LINEAR_MODIFIER (node) = 1;
OMP_CLAUSE_LINEAR_OLD_LINEAR_MODIFIER (node)
= n->u.linear.old_modifier;
if (last_step_expr && last_step == NULL_TREE)
{
if (!declare_simd)

View file

@ -0,0 +1,34 @@
/* { dg-do compile } */
/* { dg-options "-fopenmp" } */
int step (int x, int y, int z) { return x + y + z; }
int
foo (int x)
{
int i;
#pragma omp parallel for linear (x : step (step (1, 2, 3)))
for (i = 0; i < 64; i++)
x += 6;
return x;
}
int
bar (int x)
{
int i;
#pragma omp parallel for linear (x : step (1, 2, 3)) /* { dg-error "expected" } */
for (i = 0; i < 64; i++)
x += 6;
return x;
}
int
bar2 (int x)
{
int i;
#pragma omp parallel for linear (x : step (1, 2, 3) * 1)
for (i = 0; i < 64; i++)
x += 6;
return x;
}

View file

@ -0,0 +1,112 @@
! { dg-do compile }
! { dg-options "-fopenmp -fdump-tree-original" }
module m
implicit none (type, external)
integer i
interface
integer function bar (x, y, z)
integer, value :: x, y, z
!$omp declare simd linear (x : val, step (1)) linear (y : step (2))
end
integer function baz (x, y, z)
integer, value :: x, y, z
!$omp declare simd linear (x : step (1), val)
end
integer function qux (x, val)
integer, value :: x, val
!$omp declare simd linear (val (x) : val) uniform (val)
end
integer function corge (x, val)
integer, value :: x, val
!$omp declare simd linear (x : val, step (val)) uniform (val)
end
integer function grault (x)
integer, value :: x
!$omp declare simd linear (x : val)
end
integer function step (x)
integer, value :: x
end
end interface
contains
subroutine foo (x,y)
integer :: x, y
integer :: val
val = 1
!$omp simd linear (i: step (3))
do i = 0, 32, 3
end do
!$omp simd linear (i: val, step (3))
do i = 0, 32, 3
end do
!$omp simd linear (x: step (y + 1))
do i = 0, 9
x = x + y + 1
end do
!$omp simd linear (x: step (y + 1), val)
do i = 0, 9
x = x + y + 1
end do
!$omp parallel do linear (x: step (y + 1))
do i = 0, 9
x = x + y + 1
end do
!$omp parallel do linear (x: val, step (y + 1))
do i = 0, 9
x = x + y + 1
end do
!$omp parallel do simd linear (i: step (3))
do i = 0, 32, 3
end do
!$omp parallel do simd linear (i: step (3), val)
do i = 0, 32, 3
end do
!$omp parallel do simd linear (x: step (y + 1))
do i = 0, 9
x = x + y + 1
end do
!$omp parallel do simd linear (x: val, step (y + 1))
do i = 0, 9
x = x + y + 1
end do
!$omp parallel do simd linear (i: val + 0)
do i = 0, 9
end do
!$omp parallel do simd linear (i: step (1) * 1)
do i = 0, 9
end do
end
end module
! { dg-final { scan-tree-dump-times "#pragma omp parallel" 8 "original" } }
! { dg-final { scan-tree-dump-times "#pragma omp for nowait" 6 "original" } }
! { dg-final { scan-tree-dump-times "#pragma omp for linear\\(x:D\\.\[0-9\]+\\) nowait" 1 "original" } }
! { dg-final { scan-tree-dump-times "#pragma omp for linear\\(x:val,step\\(D\\.\[0-9\]+\\)\\) nowait" 1 "original" } }
! { dg-final { scan-tree-dump-times "#pragma omp simd linear\\(count\\.\[0-9\]:1\\) linear\\(i:3\\)" 2 "original" } }
! { dg-final { scan-tree-dump-times "#pragma omp simd linear\\(count\\.\[0-9\]:1\\) linear\\(i:val,step\\(3\\)\\)" 2 "original" } }
! { dg-final { scan-tree-dump-times "#pragma omp simd linear\\(i:1\\) linear\\(x:D\\.\[0-9\]+\\)" 2 "original" } }
! { dg-final { scan-tree-dump-times "#pragma omp simd linear\\(i:1\\) linear\\(x:val,step\\(D\\.\[0-9\]+\\)\\)" 2 "original" } }
! { dg-final { scan-tree-dump-times "#pragma omp simd linear\\(i:D\\.\[0-9\]+\\)" 2 "original" } }

View file

@ -0,0 +1,39 @@
! { dg-do compile }
! { dg-options "-fopenmp" }
module m2
implicit none (type, external)
integer :: val
contains
integer function step (x)
integer, value :: x
end
subroutine foo(x)
integer, value :: x
!$omp declare simd linear (val (x) : step (1)) ! { dg-error "requires a constant integer linear-step expression or dummy argument" }
end
end module m2
module m
implicit none (type, external)
integer :: val
contains
integer function step (x)
integer, value :: x
!$omp declare simd linear (val (x) : step (1)) ! { dg-error "Failed to match clause" }
end
integer function bar (x, y, z)
integer, value :: x, y, z
!$omp declare simd linear (val (x) : val) ! { dg-error "requires a constant integer linear-step expression or dummy argument" }
end
integer function baz (x, y, z)
integer, value :: x, y, z
end
end module m

View file

@ -0,0 +1,102 @@
! { dg-do compile }
! { dg-options "-fopenmp" }
module m
implicit none
integer :: i
interface
integer function bar (x, y, z)
integer :: x, y
integer, value :: z
!$omp declare simd linear (x : ref, step (1)) linear (y : step (2), uval)
end
integer function baz (x, y, z)
integer :: x
integer, value :: y, z
!$omp declare simd linear (x : step (1), uval)
end
integer function qux (x, ref)
integer :: x
integer, value :: ref
!$omp declare simd linear (ref (x) : ref) uniform (ref)
end
integer function corge (x, ref)
integer :: x
integer, value :: ref
!$omp declare simd linear (x : ref, step (ref)) uniform (ref)
end
integer function grault (x)
integer :: x
!$omp declare simd linear (x : ref)
end
integer function waldo (x)
integer :: x
!$omp declare simd linear (x : uval)
end
end interface
contains
integer function step (x)
integer, value :: x
step = x
end
subroutine foo (x, y)
integer :: x, y
!$omp simd linear (x: step (y + 1))
do i = 0, 9
x = x + y + 1
end do
!$omp simd linear (x: val, step (y + 1))
do i = 0, 9
x = x + y + 1
end do
!$omp parallel do linear (x: step (y + 1))
do i = 0, 9
x = x + y + 1
end do
!$omp parallel do linear (x: step (y + 1), val)
do i = 0, 9
x = x + y + 1
end do
!$omp parallel do simd linear (x: step (y + 1))
do i = 0, 9
x = x + y + 1
end do
!$omp parallel do simd linear (x: val, step (y + 1))
do i = 0, 9
x = x + y + 1
end do
!$omp parallel do simd linear (x: step (1) + 0)
do i = 0, 9
x = x + step (1) + 0
end do
block
integer, parameter :: ref = 1, uval = 2
!$omp parallel do simd linear (x: ref + 0)
do i = 0, 9
x = x + ref + 0
end do
!$omp parallel do simd linear (x: uval * 1)
do i = 0, 9
x = x + uval
end do
end block
end
end

View file

@ -0,0 +1,43 @@
! { dg-do compile }
! { dg-options "-fopenmp" }
module m
implicit none
integer :: i
contains
subroutine foo (x, y)
integer :: x, y
!$omp simd linear (x: step (y + 1), ref) ! { dg-error "LINEAR clause modifier other than VAL used on DO or SIMD construct" }
do i = 0, 10
x = x + y + 1
end do
!$omp simd linear (x: uval, step (y + 1)) ! { dg-error "LINEAR clause modifier other than VAL used on DO or SIMD construct" }
do i = 0, 10
x = x + y + 1
end do
!$omp parallel do linear (x: ref, step (y + 1)) ! { dg-error "LINEAR clause modifier other than VAL used on DO or SIMD construct" }
do i = 0, 10
x = x + y + 1
end do
!$omp parallel do linear (x: step (y + 1), uval) ! { dg-error "LINEAR clause modifier other than VAL used on DO or SIMD construct" }
do i = 0, 10
x = x + y + 1
end do
!$omp parallel do simd linear (x: step (y + 1), ref) ! { dg-error "LINEAR clause modifier other than VAL used on DO or SIMD construct" }
do i = 0, 10
x = x + y + 1
end do
!$omp parallel do simd linear (x: uval, step (y + 1)) ! { dg-error "LINEAR clause modifier other than VAL used on DO or SIMD construct" }
do i = 0, 10
x = x + y + 1
end do
end
end

View file

@ -0,0 +1,54 @@
! { dg-do compile }
! { dg-options "-fopenmp" }
module m
implicit none
integer, parameter :: val = 1
integer, parameter :: ref = 2
integer, parameter :: uval = 3
interface
integer function foo (x, y, z)
import
implicit none
integer, value :: x
integer :: y, z
!$omp declare simd linear (val (x) : step (1)) linear (ref (y) : step (2)) linear (uval (z) : step (3))
! STEP is a function - thus:
! { dg-error "'x' in LINEAR clause at .1. requires a constant integer linear-step expression or dummy argument specified in UNIFORM clause" "" { target *-*-* } .-3 }
! { dg-error "'y' in LINEAR clause at .1. requires a constant integer linear-step expression or dummy argument specified in UNIFORM clause" "" { target *-*-* } .-4 }
! { dg-error "'z' in LINEAR clause at .1. requires a constant integer linear-step expression or dummy argument specified in UNIFORM clause" "" { target *-*-* } .-5 }
end
integer function bar (x, y, z)
import
implicit none
integer, value :: x
integer :: y, z
!$omp declare simd linear (val (x) : val) linear (ref (y) : ref) linear (uval (z) : uval)
end
integer function baz (x, y, z)
import
implicit none
integer, value :: x
integer :: y, z
!$omp declare simd linear (val (x) : ref) linear (ref (y) : uval) linear (uval (z) : val)
end
integer function qux (x, y, z)
import
implicit none
integer, value :: x
integer :: y, z
!$omp declare simd linear (val (x) : uval) linear (ref (y) : val) linear (uval (z) : ref)
end
end interface
contains
integer function step (x)
integer, value :: x
step = x
end
end module

View file

@ -0,0 +1,27 @@
! { dg-do compile }
! { dg-options "-fopenmp" }
module m
implicit none (type, external)
integer i
interface
integer function s1 (x, y, z)
integer, value :: x, y, z
!$omp declare simd linear (x : val, step (1), val) ! { dg-error "Multiple 'linear' modifiers specified" }
end
integer function s2 (x, y, z)
integer, value :: x, y, z
!$omp declare simd linear (x : val, step (1), step(2)) ! { dg-error "Multiple 'step' modifiers specified" }
end
integer function s3 (x, y, z)
integer, value :: x, y, z
!$omp declare simd linear (x : val, ref, step(2)) ! { dg-error "Multiple 'linear' modifiers specified" }
end
end interface
end module

View file

@ -0,0 +1,44 @@
! { dg-do compile }
! { dg-options "-fopenmp" }
module m
implicit none (type, external)
interface
integer function step (x, y, z)
integer :: x, y, z
end function step
end interface
contains
integer function foo (x)
integer, value :: x
integer :: i
!$omp parallel do linear (x : step (step (1, 2, 3)))
do i = 0, 63
x = x + 6
end do
foo = x
end
integer function bar (x)
integer, value :: x
integer :: i
!$omp parallel do linear (x : step (1, 2, 3)) ! { dg-error "40: Invalid character in name" }
do i = 0, 63
x = x + 6
end do
bar = x
end
integer function bar2 (x)
integer, value :: x
integer :: i
!$omp parallel do linear (x : step (1, 2, 3) * 1)
do i = 0, 63
x = x + 6
end do
bar2 = x
end
end module

View file

@ -363,7 +363,7 @@ to address of matching mapped list item per 5.1, Sect. 2.21.7.2 @tab N @tab
@item Clauses on @code{end} directive can be on directive @tab N @tab
@item Deprecation of no-argument @code{destroy} clause on @code{depobj}
@tab N @tab
@item @code{linear} clause syntax changes and @code{step} modifier @tab P @tab only C/C++
@item @code{linear} clause syntax changes and @code{step} modifier @tab Y @tab
@item Deprecation of minus operator for reductions @tab N @tab
@item Deprecation of separating @code{map} modifiers without comma @tab N @tab
@item @code{declare mapper} with iterator and @code{present} modifiers