@@ -1134,6 +1134,14 @@ enum gfc_omp_map_op
OMP_MAP_ALWAYS_TOFROM
};
+enum gfc_omp_linear_op
+{
+ OMP_LINEAR_DEFAULT,
+ OMP_LINEAR_REF,
+ OMP_LINEAR_VAL,
+ OMP_LINEAR_UVAL
+};
+
/* For use in OpenMP clauses in case we need extra information
(aligned clause alignment, linear clause step, etc.). */
@@ -1146,6 +1154,7 @@ 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;
} u;
struct gfc_omp_namelist_udr *udr;
struct gfc_omp_namelist *next;
@@ -1092,13 +1092,50 @@ gfc_match_omp_clauses (gfc_omp_clauses *
end_colon = false;
head = NULL;
if ((mask & OMP_CLAUSE_LINEAR)
- && gfc_match_omp_variable_list ("linear (",
- &c->lists[OMP_LIST_LINEAR],
- false, &end_colon,
- &head) == MATCH_YES)
+ && gfc_match ("linear (") == MATCH_YES)
{
+ gfc_omp_linear_op linear_op = OMP_LINEAR_DEFAULT;
gfc_expr *step = NULL;
+ if (gfc_match_omp_variable_list (" ref (",
+ &c->lists[OMP_LIST_LINEAR],
+ false, NULL, &head)
+ == MATCH_YES)
+ linear_op = OMP_LINEAR_REF;
+ else if (gfc_match_omp_variable_list (" val (",
+ &c->lists[OMP_LIST_LINEAR],
+ false, NULL, &head)
+ == MATCH_YES)
+ linear_op = OMP_LINEAR_VAL;
+ else if (gfc_match_omp_variable_list (" uval (",
+ &c->lists[OMP_LIST_LINEAR],
+ false, NULL, &head)
+ == MATCH_YES)
+ linear_op = OMP_LINEAR_UVAL;
+ else if (gfc_match_omp_variable_list ("",
+ &c->lists[OMP_LIST_LINEAR],
+ false, &end_colon, &head)
+ == MATCH_YES)
+ linear_op = OMP_LINEAR_DEFAULT;
+ else
+ {
+ gfc_free_omp_namelist (*head);
+ gfc_current_locus = old_loc;
+ *head = NULL;
+ break;
+ }
+ if (linear_op != OMP_LINEAR_DEFAULT)
+ {
+ if (gfc_match (" :") == MATCH_YES)
+ end_colon = true;
+ else if (gfc_match (" )") != MATCH_YES)
+ {
+ gfc_free_omp_namelist (*head);
+ gfc_current_locus = old_loc;
+ *head = NULL;
+ break;
+ }
+ }
if (end_colon && gfc_match (" %e )", &step) != MATCH_YES)
{
gfc_free_omp_namelist (*head);
@@ -1114,6 +1151,9 @@ gfc_match_omp_clauses (gfc_omp_clauses *
mpz_set_si (step->value.integer, 1);
}
(*head)->expr = step;
+ if (linear_op != OMP_LINEAR_DEFAULT)
+ for (gfc_omp_namelist *n = *head; n; n = n->next)
+ n->u.linear_op = linear_op;
continue;
}
if ((mask & OMP_CLAUSE_LINK)
@@ -3641,6 +3681,7 @@ resolve_omp_clauses (gfc_code *code, gfc
int list;
int ifc;
bool if_without_mod = false;
+ gfc_omp_linear_op linear_op = OMP_LINEAR_DEFAULT;
static const char *clause_names[]
= { "PRIVATE", "FIRSTPRIVATE", "LASTPRIVATE", "COPYPRIVATE", "SHARED",
"COPYIN", "UNIFORM", "ALIGNED", "LINEAR", "DEPEND", "MAP",
@@ -4225,12 +4266,26 @@ resolve_omp_clauses (gfc_code *code, gfc
}
break;
case OMP_LIST_LINEAR:
- if (n->sym->ts.type != BT_INTEGER)
+ if (code
+ && 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;
+ }
+ 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 (!code && !n->sym->attr.value)
- gfc_error ("LINEAR dummy argument %qs must have VALUE "
- "attribute at %L", n->sym->name, &n->where);
+ 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
+ ? "REF" : "UVAL", &n->where);
else if (n->expr)
{
gfc_expr *expr = n->expr;
@@ -4241,9 +4296,25 @@ resolve_omp_clauses (gfc_code *code, gfc
"a scalar integer linear-step expression",
n->sym->name, &n->where);
else if (!code && expr->expr_type != EXPR_CONSTANT)
- gfc_error ("%qs in LINEAR clause at %L requires "
- "a constant integer linear-step expression",
- n->sym->name, &n->where);
+ {
+ if (expr->expr_type == EXPR_VARIABLE
+ && expr->symtree->n.sym->attr.dummy
+ && expr->symtree->n.sym->ns == ns)
+ {
+ gfc_omp_namelist *n2;
+ for (n2 = omp_clauses->lists[OMP_LIST_UNIFORM];
+ n2; n2 = n2->next)
+ if (n2->sym == expr->symtree->n.sym)
+ break;
+ if (n2)
+ break;
+ }
+ gfc_error ("%qs in LINEAR clause at %L requires "
+ "a constant integer linear-step "
+ "expression or dummy argument "
+ "specified in UNIFORM clause",
+ n->sym->name, &n->where);
+ }
}
break;
/* Workaround for PR middle-end/26316, nothing really needs
@@ -1061,7 +1061,17 @@ show_omp_namelist (int list_type, gfc_om
case OMP_MAP_TOFROM: fputs ("tofrom:", dumpfile); break;
default: break;
}
+ else if (list_type == OMP_LIST_LINEAR)
+ switch (n->u.linear_op)
+ {
+ case OMP_LINEAR_REF: fputs ("ref(", dumpfile); break;
+ case OMP_LINEAR_VAL: fputs ("val(", dumpfile); break;
+ case OMP_LINEAR_UVAL: fputs ("uval(", dumpfile); break;
+ default: break;
+ }
fprintf (dumpfile, "%s", n->sym->name);
+ if (list_type == OMP_LIST_LINEAR && n->u.linear_op != OMP_LINEAR_DEFAULT)
+ fputc (')', dumpfile);
if (n->expr)
{
fputc (':', dumpfile);
@@ -1828,7 +1828,7 @@ gfc_trans_omp_clauses (stmtblock_t *bloc
{
tree alignment_var;
- if (block == NULL)
+ if (declare_simd)
alignment_var = gfc_conv_constant_to_tree (n->expr);
else
{
@@ -1848,6 +1848,7 @@ gfc_trans_omp_clauses (stmtblock_t *bloc
{
gfc_expr *last_step_expr = NULL;
tree last_step = NULL_TREE;
+ bool last_step_parm = false;
for (; n != NULL; n = n->next)
{
@@ -1855,6 +1856,7 @@ gfc_trans_omp_clauses (stmtblock_t *bloc
{
last_step_expr = n->expr;
last_step = NULL_TREE;
+ last_step_parm = false;
}
if (n->sym->attr.referenced || declare_simd)
{
@@ -1864,12 +1866,28 @@ gfc_trans_omp_clauses (stmtblock_t *bloc
tree node = build_omp_clause (input_location,
OMP_CLAUSE_LINEAR);
OMP_CLAUSE_DECL (node) = t;
+ omp_clause_linear_kind kind;
+ switch (n->u.linear_op)
+ {
+ case OMP_LINEAR_DEFAULT:
+ kind = OMP_CLAUSE_LINEAR_DEFAULT;
+ break;
+ case OMP_LINEAR_REF:
+ kind = OMP_CLAUSE_LINEAR_REF;
+ break;
+ case OMP_LINEAR_VAL:
+ kind = OMP_CLAUSE_LINEAR_VAL;
+ break;
+ case OMP_LINEAR_UVAL:
+ kind = OMP_CLAUSE_LINEAR_UVAL;
+ break;
+ default:
+ gcc_unreachable ();
+ }
+ OMP_CLAUSE_LINEAR_KIND (node) = kind;
if (last_step_expr && last_step == NULL_TREE)
{
- if (block == NULL)
- last_step
- = gfc_conv_constant_to_tree (last_step_expr);
- else
+ if (!declare_simd)
{
gfc_init_se (&se, NULL);
gfc_conv_expr (&se, last_step_expr);
@@ -1877,10 +1895,27 @@ gfc_trans_omp_clauses (stmtblock_t *bloc
last_step = gfc_evaluate_now (se.expr, block);
gfc_add_block_to_block (block, &se.post);
}
+ else if (last_step_expr->expr_type == EXPR_VARIABLE)
+ {
+ gfc_symbol *s = last_step_expr->symtree->n.sym;
+ last_step = gfc_trans_omp_variable (s, true);
+ last_step_parm = true;
+ }
+ else
+ last_step
+ = gfc_conv_constant_to_tree (last_step_expr);
+ }
+ if (last_step_parm)
+ {
+ OMP_CLAUSE_LINEAR_VARIABLE_STRIDE (node) = 1;
+ OMP_CLAUSE_LINEAR_STEP (node) = last_step;
+ }
+ else
+ {
+ tree type = gfc_typenode_for_spec (&n->sym->ts);
+ OMP_CLAUSE_LINEAR_STEP (node)
+ = fold_convert (type, last_step);
}
- OMP_CLAUSE_LINEAR_STEP (node)
- = fold_convert (gfc_typenode_for_spec (&n->sym->ts),
- last_step);
if (n->sym->attr.dimension || n->sym->attr.allocatable)
OMP_CLAUSE_LINEAR_ARRAY (node) = 1;
omp_clauses = gfc_trans_add_clause (node, omp_clauses);
@@ -0,0 +1,14 @@
+! { dg-do compile }
+
+function f1 (a, b, c, d, e, f)
+ integer, value :: a, b, c
+ integer :: d, e, f, f1
+!$omp declare simd (f1) uniform(b) linear(c, d) linear(uval(e)) linear(ref(f))
+ a = a + 1
+ b = b + 1
+ c = c + 1
+ d = d + 1
+ e = e + 1
+ f = f + 1
+ f1 = a + b + c + d + e + f
+end function f1
@@ -0,0 +1,58 @@
+subroutine foo (x, y)
+ integer :: i, x, y
+ common /i/ i
+ interface
+ function bar (x, y)
+ integer :: x, y, bar
+ !$omp declare simd (bar) linear (ref (x) : 1) linear (uval (y))
+ end function bar
+ end interface
+ !$omp simd linear (x : y + 1)
+ do i = 1, 10
+ x = x + y + 1
+ end do
+ !$omp simd linear (val (x) : y + 1) ! { dg-error "LINEAR clause modifier used on DO or SIMD construct" }
+ do i = 1, 10
+ x = x + y + 1
+ end do
+ !$omp simd linear (ref (x) : y + 1) ! { dg-error "LINEAR clause modifier used on DO or SIMD construct" }
+ do i = 1, 10
+ x = x + y + 1
+ end do
+ !$omp simd linear (uval (x) : y + 1) ! { dg-error "LINEAR clause modifier used on DO or SIMD construct" }
+ do i = 1, 10
+ x = x + y + 1
+ end do
+ !$omp do linear (x : y + 1)
+ do i = 1, 10
+ x = x + y + 1
+ end do
+ !$omp do linear (val (x) : y + 1) ! { dg-error "LINEAR clause modifier used on DO or SIMD construct" }
+ do i = 1, 10
+ x = x + y + 1
+ end do
+ !$omp do linear (ref (x) : y + 1) ! { dg-error "LINEAR clause modifier used on DO or SIMD construct" }
+ do i = 1, 10
+ x = x + y + 1
+ end do
+ !$omp do linear (uval (x) : y + 1) ! { dg-error "LINEAR clause modifier used on DO or SIMD construct" }
+ do i = 1, 10
+ x = x + y + 1
+ end do
+ !$omp do simd linear (x : y + 1)
+ do i = 1, 10
+ x = x + y + 1
+ end do
+ !$omp do simd linear (val (x) : y + 1) ! { dg-error "LINEAR clause modifier used on DO or SIMD construct" }
+ do i = 1, 10
+ x = x + y + 1
+ end do
+ !$omp do simd linear (ref (x) : y + 1) ! { dg-error "LINEAR clause modifier used on DO or SIMD construct" }
+ do i = 1, 10
+ x = x + y + 1
+ end do
+ !$omp do simd linear (uval (x) : y + 1) ! { dg-error "LINEAR clause modifier used on DO or SIMD construct" }
+ do i = 1, 10
+ x = x + y + 1
+ end do
+end