Add Fortran support for the 'scaled' modifier to simdlen:
!$omp (declare) simd … simdlen( [ scaled(type [, divisor] ) : ] length )
where 'type' is a numeric type and 'divisor' and 'length' are >= 1 and
known at compile time.
When doing this, I noticed that some of the >= 1 and >= 0 checks in
openmp.cc only checked for this for constants (with a warning) while
for non-constants, those just were accepted. I changed the function
to also have a hard error and requiring constant. Hence:
For, e.g., 'num_threads(n)' - n might be (still) a variable but if
it is constant, there is the >= 0 check. - This one is *unchanged* and
just shows a warning - but I think an error would also be fine and,
actually, make more sense.
However, for the following clauses, *now* a hard error is printed:
* SAFELEN (OpenMP) [fixed a test case]
* SIMDLEN's length expression (OpenMP)
* SIMDLEN >= SIMDLEN (new check, unrelated to that change, but for completeness)
* SIMDLEN's divisor expression (OpenMP; new modifier)
* PRIORITY (OpenMP, no idea why it needs to be constant, but it is;
fixed some testcases)
* SIZES (OpenMP, simplified check; BTW: OpenMP 6 permits it to be non-const)
* TILE (OpenACC, simplified check + changed warning to an error)
Additionally, I fixed a module handling error for 'simd' in 'declare variant'.
Any comments before I push this patch?
Tobias
OpenMP/Fortran: Handle simdlen's 'scaled' modifier; for > / >= checks, enforce const check [PR127723]
Follow up to commit r17-4947-gfbcafeec06a661 by adding support for Fortran.
Namely, the OpenMP simdlen clause to 'simd' and 'declare simd' gained the
'scaled' modifier that accepts a numeric type and an optional divisor
expression:
simdlen( [ scaled(type-name [, divisor_expr ] ) : ] length_expr)
where divisor_expr and length_expr must be >= 1 and constant.
In the module handling, there was a preexisting bug that for module-file
reading: mio_omp_declare_simd_clauses wrote the keyword "simdlen" to the
module file - but did not read it; its caller for 'declare simd' read it
but the caller for the 'declare variant' context selector didn't, leading
to a read error when 'simdlen' appeared in declare-variant 'match' clause.
As resolve_positive_int_expr/resolve_nonnegative_int_expr only warned
when the violated the condition - and didn't enforce the constantness,
a boolean argument was added such that either an error is printed when
not constant or violating the > / >= 0 condition - or non-constant values
are accepteded - with (only) a warning when constant and violating the
the > / >= 0 condition. (The later matches the current behavior.)
Hence, all callers had to be updated, which lead to testcase updates
as well (for OpenMP and OpenACC).
PR middle-end/127723
gcc/fortran/ChangeLog:
* gfortran.h (gfc_omp_clauses): Add simdlen_type and
simdlen_divisor.
* module.cc (mio_omp_declare_simd_clauses): Handle scaled;
consume "simdlen" token on reading.
(mio_omp_declare_simd): Remove the latter.
* openmp.cc (gfc_free_omp_clauses): Free simdlen_divisor.
(gfc_match_omp_clauses): Parse 'scaled' modifier to 'simdlen'.
(resolve_scalar_int_expr): Return boolean.
(resolve_positive_int_expr, resolve_nonnegative_int_expr):
Additional boolean WARN argument, if false, require constant
argument and fail with an error.
(resolve_oacc_loop_blocks): Update positive/nonnegative
const argument checking.
(resolve_omp_clauses): Likewise; handle simdlen_type/divisor.
gcc/testsuite/ChangeLog:
* gfortran.dg/gomp/clauses-1.f90: Fix testcase: priority must be
a constant expression.
* gfortran.dg/gomp/masked-1.f90: Likewise.
* gfortran.dg/gomp/target2.f90: Likewise.
* gfortran.dg/gomp/taskloop-1.f90: Likewise.
* gfortran.dg/gomp/taskloop-2.f90: Add diagnostic check for a
non-const priority.
* gfortran.dg/goacc/loop-2-kernels-tile.f95: Update dg-warn/error.
* gfortran.dg/goacc/loop-2-parallel-tile.f95: Likewise.
* gfortran.dg/goacc/loop-2-serial-tile.f95: Likewise.
* gfortran.dg/goacc/tile-1.f90: Likewise.
* gfortran.dg/gomp/atomic-18.f90: Likewise.
* gfortran.dg/gomp/atomic-2.f90: Likewise.
* gfortran.dg/gomp/pr67500.f90: Likewise.
* gfortran.dg/gomp/pr77516.f90: Likewise.
* gfortran.dg/gomp/tile-7.f90: Likewise.
* gfortran.dg/gomp/simdlen-scaled-1.f90: New test.
* gfortran.dg/gomp/simdlen-scaled-2.f90: New test.
* gfortran.dg/gomp/simdlen-scaled-3.f90: New test.
* gfortran.dg/gomp/simdlen-scaled-4.f90: New test.
* gfortran.dg/gomp/simdlen-scaled-5-1.f90: New test.
* gfortran.dg/gomp/simdlen-scaled-5-2.f90: New test.
libgomp/ChangeLog:
* testsuite/libgomp.fortran/nestedfn5.f90: Fix testcase: safelen
must be constant.
gcc/fortran/gfortran.h | 7 +
gcc/fortran/module.cc | 26 ++-
gcc/fortran/openmp.cc | 184 +++++++++++++++------
gcc/fortran/trans-openmp.cc | 44 ++---
.../gfortran.dg/goacc/loop-2-kernels-tile.f95 | 8 +-
.../gfortran.dg/goacc/loop-2-parallel-tile.f95 | 8 +-
.../gfortran.dg/goacc/loop-2-serial-tile.f95 | 8 +-
gcc/testsuite/gfortran.dg/goacc/tile-1.f90 | 28 ++--
gcc/testsuite/gfortran.dg/gomp/atomic-18.f90 | 3 +-
gcc/testsuite/gfortran.dg/gomp/atomic-2.f90 | 3 +-
gcc/testsuite/gfortran.dg/gomp/clauses-1.f90 | 15 +-
gcc/testsuite/gfortran.dg/gomp/masked-1.f90 | 5 +-
gcc/testsuite/gfortran.dg/gomp/pr67500.f90 | 8 +-
gcc/testsuite/gfortran.dg/gomp/pr77516.f90 | 2 +-
.../gfortran.dg/gomp/simdlen-scaled-1.f90 | 44 +++++
.../gfortran.dg/gomp/simdlen-scaled-2.f90 | 28 ++++
.../gfortran.dg/gomp/simdlen-scaled-3.f90 | 49 ++++++
.../gfortran.dg/gomp/simdlen-scaled-4.f90 | 75 +++++++++
.../gfortran.dg/gomp/simdlen-scaled-5-1.f90 | 75 +++++++++
.../gfortran.dg/gomp/simdlen-scaled-5-2.f90 | 40 +++++
gcc/testsuite/gfortran.dg/gomp/target2.f90 | 5 +-
gcc/testsuite/gfortran.dg/gomp/taskloop-1.f90 | 5 +-
gcc/testsuite/gfortran.dg/gomp/taskloop-2.f90 | 4 +
gcc/testsuite/gfortran.dg/gomp/tile-7.f90 | 2 +-
libgomp/testsuite/libgomp.fortran/nestedfn5.f90 | 6 +-
25 files changed, 560 insertions(+), 122 deletions(-)
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index a1badd0bde8..4e41133d5fc 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1716,6 +1716,13 @@ typedef struct gfc_omp_clauses
struct gfc_expr *chunk_size;
struct gfc_expr *safelen_expr;
struct gfc_expr *simdlen_expr;
+ struct
+ {
+ bt type;
+ int kind;
+ }
+ simdlen_type;
+ struct gfc_expr *simdlen_divisor;
struct gfc_expr_list *num_teams_list;
struct gfc_expr *device;
struct gfc_expr_list *thread_limit_list;
diff --git a/gcc/fortran/module.cc b/gcc/fortran/module.cc
index 798e7d9ca1d..ea86a091f69 100644
--- a/gcc/fortran/module.cc
+++ b/gcc/fortran/module.cc
@@ -4389,6 +4389,8 @@ static const mstring omp_declare_simd_clauses[] =
minit ("UNIFORM", 3),
minit ("LINEAR", 4),
minit ("ALIGNED", 5),
+ minit ("SIMDLEN_TYP", 6),
+ minit ("SIMDLEN_DIV", 7),
minit ("LINEAR_REF", 33),
minit ("LINEAR_VAL", 34),
minit ("LINEAR_UVAL", 35),
@@ -4435,12 +4437,26 @@ mio_omp_declare_simd_clauses (gfc_omp_clauses **clausesp)
mio_symbol_ref (&n->sym);
mio_expr (&n->expr);
}
+ if (clauses->simdlen_type.type != BT_UNKNOWN)
+ {
+ gfc_typespec ts = {};
+ ts.type = clauses->simdlen_type.type;
+ ts.kind = clauses->simdlen_type.kind;
+ mio_name (6, omp_declare_simd_clauses);
+ mio_typespec (&ts);
+ if (clauses->simdlen_divisor)
+ {
+ mio_name (7, omp_declare_simd_clauses);
+ mio_expr (&clauses->simdlen_divisor);
+ }
+ }
}
else
{
if (peek_atom () != ATOM_NAME)
return;
+ require_atom (ATOM_NAME);
gfc_omp_namelist **ptrs[3] = { NULL, NULL, NULL };
gfc_omp_clauses *clauses = *clausesp = gfc_get_omp_clauses ();
ptrs[0] = &clauses->lists[OMP_LIST_UNIFORM];
@@ -4468,6 +4484,15 @@ mio_omp_declare_simd_clauses (gfc_omp_clauses **clausesp)
if (t != 3)
mio_expr (&n->expr);
break;
+ case 6:
+ {
+ gfc_typespec ts;
+ mio_typespec (&ts);
+ clauses->simdlen_type.type = ts.type;
+ clauses->simdlen_type.kind = ts.kind;
+ break;
+ }
+ case 7: mio_expr (&clauses->simdlen_divisor); break;
case 33:
case 34:
case 35:
@@ -4517,7 +4542,6 @@ mio_omp_declare_simd (gfc_namespace *ns, gfc_omp_declare_simd **odsp)
return;
}
- require_atom (ATOM_NAME);
*odsp = ods = gfc_get_omp_declare_simd ();
ods->where = gfc_current_locus;
ods->proc_name = ns->proc_name;
diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc
index a2c825401e3..0ed83519a64 100644
--- a/gcc/fortran/openmp.cc
+++ b/gcc/fortran/openmp.cc
@@ -202,6 +202,7 @@ gfc_free_omp_clauses (gfc_omp_clauses *c)
gfc_free_expr (c->chunk_size);
gfc_free_expr (c->safelen_expr);
gfc_free_expr (c->simdlen_expr);
+ gfc_free_expr (c->simdlen_divisor);
gfc_free_expr (c->device);
gfc_free_expr (c->dyn_groupprivate);
gfc_free_expr (c->dist_chunk_size);
@@ -4833,11 +4834,55 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
true) == MATCH_YES)
continue;
if ((mask & OMP_CLAUSE_SIMDLEN)
- && (m = gfc_match_dupl_check (!c->simdlen_expr, "simdlen", true,
- &c->simdlen_expr)) != MATCH_NO)
+ && (m = gfc_match_dupl_check (!c->simdlen_expr, "simdlen",
+ true)) != MATCH_NO)
{
if (m == MATCH_ERROR)
goto error;
+ if (gfc_match ("scaled ( ") == MATCH_YES)
+ {
+ old_loc = gfc_current_locus;
+ gfc_typespec ts;
+ /* This does not match 'type(integer)'; should it? */
+ if (gfc_match_type_spec (&ts) != MATCH_YES
+ || (ts.type != BT_INTEGER && ts.type != BT_UNSIGNED
+ && ts.type != BT_REAL && ts.type != BT_COMPLEX))
+ {
+ gfc_error ("Expected numerical type name at %L",
+ &old_loc);
+ goto error;
+ }
+ c->simdlen_type.type = ts.type;
+ c->simdlen_type.kind = ts.kind;
+ if (gfc_match (" , ") == MATCH_YES)
+ {
+ if (gfc_match_expr (&c->simdlen_divisor) != MATCH_YES)
+ {
+ gfc_error ("Expected divisor expression at %C");
+ goto error;
+ }
+ }
+ if (gfc_match (" ) ") != MATCH_YES)
+ {
+ gfc_error ("Expected %<)%> at %C");
+ goto error;
+ }
+ if (gfc_match (" : ") != MATCH_YES)
+ {
+ gfc_error ("Expected %<:%> at %C");
+ goto error;
+ }
+ }
+ if (gfc_match_expr (&c->simdlen_expr) != MATCH_YES)
+ {
+ gfc_error ("Expected length expression at %C");
+ goto error;
+ }
+ if (gfc_match (" ) ") != MATCH_YES)
+ {
+ gfc_error ("Expected %<)%> at %C");
+ goto error;
+ }
continue;
}
if ((mask & OMP_CLAUSE_SIMD)
@@ -9423,38 +9468,64 @@ oacc_is_loop (gfc_code *code)
|| code->op == EXEC_OACC_LOOP;
}
-static void
+static bool
resolve_scalar_int_expr (gfc_expr *expr, const char *clause)
{
if (!gfc_resolve_expr (expr)
|| expr->ts.type != BT_INTEGER
|| expr->rank != 0)
- gfc_error ("%s clause at %L requires a scalar INTEGER expression",
- clause, &expr->where);
+ {
+ gfc_error ("%s clause at %L requires a scalar INTEGER expression",
+ clause, &expr->where);
+ return false;
+ }
+ return true;
}
+/* Require that EXPR is a scalar constant integer expression; it shall be a
+ positive number: If WARN is true, a warning is printed if constant and
+ not positive. If WARN is false, an error is printed if it is either not
+ constant or not positive. CLAUSE is used in the diagnostic output. */
+
static void
-resolve_positive_int_expr (gfc_expr *expr, const char *clause)
+resolve_positive_int_expr (gfc_expr *expr, const char *clause, bool warn)
{
- resolve_scalar_int_expr (expr, clause);
- if (expr->expr_type == EXPR_CONSTANT
- && expr->ts.type == BT_INTEGER
+ if (!resolve_scalar_int_expr (expr, clause))
+ return;
+ if (warn
+ && expr->expr_type == EXPR_CONSTANT
&& mpz_sgn (expr->value.integer) <= 0)
gfc_warning ((flag_openmp || flag_openmp_simd) ? OPT_Wopenmp : 0,
"INTEGER expression of %s clause at %L must be positive",
clause, &expr->where);
+ else if (!warn
+ && (expr->expr_type != EXPR_CONSTANT
+ || mpz_sgn (expr->value.integer) <= 0))
+ gfc_error ("INTEGER expression of %s clause at %L must be positive and "
+ "constant", clause, &expr->where);
}
+/* Require that EXPR is a scalar constant integer expression; it shall be a
+ nonnegative number: If WARN is true, a warning is printed if constant and
+ negative. If WARN is false, an error is printed if it is either not constant
+ or negative. CLAUSE is used in the diagnostic output. */
+
static void
-resolve_nonnegative_int_expr (gfc_expr *expr, const char *clause)
+resolve_nonnegative_int_expr (gfc_expr *expr, const char *clause, bool warn)
{
- resolve_scalar_int_expr (expr, clause);
- if (expr->expr_type == EXPR_CONSTANT
- && expr->ts.type == BT_INTEGER
+ if (!resolve_scalar_int_expr (expr, clause))
+ return;
+ if (warn
+ && expr->expr_type == EXPR_CONSTANT
&& mpz_sgn (expr->value.integer) < 0)
gfc_warning ((flag_openmp || flag_openmp_simd) ? OPT_Wopenmp : 0,
"INTEGER expression of %s clause at %L must be non-negative",
clause, &expr->where);
+ else if (!warn
+ && (expr->expr_type != EXPR_CONSTANT
+ || mpz_sgn (expr->value.integer) < 0))
+ gfc_error ("INTEGER expression of %s clause at %L must be non-negtive and "
+ "constant", clause, &expr->where);
}
/* Emits error when symbol is pointer, cray pointer or cray pointee
@@ -10868,11 +10939,11 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
}
for (el = omp_clauses->num_threads_list; el; el = el->next)
- resolve_positive_int_expr (el->expr, "NUM_THREADS");
+ resolve_positive_int_expr (el->expr, "NUM_THREADS", true);
if (omp_clauses->dyn_groupprivate)
resolve_nonnegative_int_expr (omp_clauses->dyn_groupprivate,
- "DYN_GROUPPRIVATE");
+ "DYN_GROUPPRIVATE", true);
if (omp_clauses->chunk_size)
{
gfc_expr *expr = omp_clauses->chunk_size;
@@ -11669,11 +11740,35 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
}
}
if (omp_clauses->safelen_expr)
- resolve_positive_int_expr (omp_clauses->safelen_expr, "SAFELEN");
+ resolve_positive_int_expr (omp_clauses->safelen_expr, "SAFELEN", false);
if (omp_clauses->simdlen_expr)
- resolve_positive_int_expr (omp_clauses->simdlen_expr, "SIMDLEN");
+ resolve_positive_int_expr (omp_clauses->simdlen_expr, "SIMDLEN", false);
+ if (omp_clauses->simdlen_divisor
+ && (!gfc_resolve_expr (omp_clauses->simdlen_divisor)
+ || omp_clauses->simdlen_divisor->ts.type != BT_INTEGER
+ || omp_clauses->simdlen_divisor->rank != 0
+ || omp_clauses->simdlen_divisor->expr_type != EXPR_CONSTANT
+ || mpz_sgn (omp_clauses->simdlen_divisor->value.integer) <= 0))
+ gfc_error ("Divisor expression at %L of the SCALED modifier to SIMDLEN must"
+ " be a positive scalar constant integer expression",
+ &omp_clauses->simdlen_divisor->where);
+ /* Check that safelen >= simdlen * scaled; however, scaled is
+ unknown, hence, assume scaled == 1 as conservative estimate.
+ we need to repeat some const check as the program still continues
+ after the error diagnostic above. */
+ if (omp_clauses->safelen_expr && omp_clauses->simdlen_expr
+
+ && omp_clauses->safelen_expr->expr_type == EXPR_CONSTANT
+ && omp_clauses->simdlen_expr->ts.type == BT_INTEGER
+ && omp_clauses->simdlen_expr->expr_type == EXPR_CONSTANT
+ && omp_clauses->simdlen_expr->ts.type == BT_INTEGER
+ && mpz_cmp (omp_clauses->safelen_expr->value.integer,
+ omp_clauses->simdlen_expr->value.integer) < 0)
+ gfc_error ("SIMDLEN at %L must be smaller or equal to SAFELEN at %L",
+ &omp_clauses->simdlen_expr->where,
+ &omp_clauses->safelen_expr->where);
for (el = omp_clauses->num_teams_list; el; el = el->next)
- resolve_positive_int_expr (el->expr, "NUM_TEAMS");
+ resolve_positive_int_expr (el->expr, "NUM_TEAMS", true);
if (omp_clauses->num_teams_list
&& omp_clauses->num_teams_list->next
&& !omp_clauses->num_teams_dims
@@ -11687,18 +11782,19 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
if (omp_clauses->device)
resolve_scalar_int_expr (omp_clauses->device, "DEVICE");
if (omp_clauses->filter)
- resolve_nonnegative_int_expr (omp_clauses->filter, "FILTER");
+ resolve_nonnegative_int_expr (omp_clauses->filter, "FILTER", true);
if (omp_clauses->hint)
{
- resolve_scalar_int_expr (omp_clauses->hint, "HINT");
- if (omp_clauses->hint->ts.type != BT_INTEGER
- || omp_clauses->hint->expr_type != EXPR_CONSTANT
- || mpz_sgn (omp_clauses->hint->value.integer) < 0)
+ if (!gfc_resolve_expr (omp_clauses->hint)
+ || omp_clauses->hint->rank != 0
+ || omp_clauses->hint->ts.type != BT_INTEGER
+ || omp_clauses->hint->expr_type != EXPR_CONSTANT
+ || mpz_sgn (omp_clauses->hint->value.integer) < 0)
gfc_error ("Value of HINT clause at %L shall be a valid "
"constant hint expression", &omp_clauses->hint->where);
}
if (omp_clauses->priority)
- resolve_nonnegative_int_expr (omp_clauses->priority, "PRIORITY");
+ resolve_nonnegative_int_expr (omp_clauses->priority, "PRIORITY", false);
if (omp_clauses->dist_chunk_size)
{
gfc_expr *expr = omp_clauses->dist_chunk_size;
@@ -11708,11 +11804,11 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
"a scalar INTEGER expression", &expr->where);
}
for (el = omp_clauses->thread_limit_list; el; el = el->next)
- resolve_positive_int_expr (el->expr, "THREAD_LIMIT");
+ resolve_positive_int_expr (el->expr, "THREAD_LIMIT", true);
if (omp_clauses->grainsize)
- resolve_positive_int_expr (omp_clauses->grainsize, "GRAINSIZE");
+ resolve_positive_int_expr (omp_clauses->grainsize, "GRAINSIZE", true);
if (omp_clauses->num_tasks)
- resolve_positive_int_expr (omp_clauses->num_tasks, "NUM_TASKS");
+ resolve_positive_int_expr (omp_clauses->num_tasks, "NUM_TASKS", true);
if (omp_clauses->grainsize && omp_clauses->num_tasks)
gfc_error ("%<GRAINSIZE%> clause at %L must not be used together with "
"%<NUM_TASKS%> clause", &omp_clauses->grainsize->where);
@@ -11734,20 +11830,21 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
gfc_error ("At least one of the clauses %<DEVICE_TYPE%> and %<DEVICE_NUM%> "
"should be present in %<SET%> directive at %L", &code->loc);
if (omp_clauses->num_gangs_expr)
- resolve_positive_int_expr (omp_clauses->num_gangs_expr, "NUM_GANGS");
+ resolve_positive_int_expr (omp_clauses->num_gangs_expr, "NUM_GANGS", true);
if (omp_clauses->num_workers_expr)
- resolve_positive_int_expr (omp_clauses->num_workers_expr, "NUM_WORKERS");
+ resolve_positive_int_expr (omp_clauses->num_workers_expr, "NUM_WORKERS",
+ true);
if (omp_clauses->vector_length_expr)
resolve_positive_int_expr (omp_clauses->vector_length_expr,
- "VECTOR_LENGTH");
+ "VECTOR_LENGTH", true);
if (omp_clauses->gang_num_expr)
- resolve_positive_int_expr (omp_clauses->gang_num_expr, "GANG");
+ resolve_positive_int_expr (omp_clauses->gang_num_expr, "GANG", true);
if (omp_clauses->gang_static_expr)
- resolve_positive_int_expr (omp_clauses->gang_static_expr, "GANG");
+ resolve_positive_int_expr (omp_clauses->gang_static_expr, "GANG", true);
if (omp_clauses->worker_expr)
- resolve_positive_int_expr (omp_clauses->worker_expr, "WORKER");
+ resolve_positive_int_expr (omp_clauses->worker_expr, "WORKER", true);
if (omp_clauses->vector_expr)
- resolve_positive_int_expr (omp_clauses->vector_expr, "VECTOR");
+ resolve_positive_int_expr (omp_clauses->vector_expr, "VECTOR", true);
for (el = omp_clauses->wait_list; el; el = el->next)
resolve_scalar_int_expr (el->expr, "WAIT");
if (omp_clauses->collapse && omp_clauses->tile_list)
@@ -11785,17 +11882,7 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
{
gfc_expr_list *el;
for (el = omp_clauses->sizes_list; el; el = el->next)
- {
- resolve_scalar_int_expr (el->expr, "SIZES");
- if (el->expr->expr_type != EXPR_CONSTANT)
- gfc_error ("SIZES requires constant expression at %L",
- &el->expr->where);
- else if (el->expr->expr_type == EXPR_CONSTANT
- && el->expr->ts.type == BT_INTEGER
- && mpz_sgn (el->expr->value.integer) <= 0)
- gfc_error ("INTEGER expression of %s clause at %L must be "
- "positive", "SIZES", &el->expr->where);
- }
+ resolve_positive_int_expr (el->expr, "SIZES", false);
}
if (!openacc && omp_clauses->detach)
@@ -14128,12 +14215,7 @@ resolve_oacc_loop_blocks (gfc_code *code)
mpz_set_si (el->expr->value.integer, 0);
}
else
- {
- resolve_positive_int_expr (el->expr, "TILE");
- if (el->expr->expr_type != EXPR_CONSTANT)
- gfc_error ("TILE requires constant expression at %L",
- &code->loc);
- }
+ resolve_positive_int_expr (el->expr, "TILE", false);
}
}
}
diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc
index 3e4375f6d60..b6a9373ab51 100644
--- a/gcc/fortran/trans-openmp.cc
+++ b/gcc/fortran/trans-openmp.cc
@@ -5985,27 +5985,27 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
if (clauses->simdlen_expr)
{
- if (declare_simd)
- {
- c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_SIMDLEN);
- OMP_CLAUSE_SIMDLEN_EXPR (c)
- = gfc_conv_constant_to_tree (clauses->simdlen_expr);
- omp_clauses = gfc_trans_add_clause (c, omp_clauses);
- }
- else
- {
- tree simdlen_var;
-
- gfc_init_se (&se, NULL);
- gfc_conv_expr (&se, clauses->simdlen_expr);
- gfc_add_block_to_block (block, &se.pre);
- simdlen_var = gfc_evaluate_now (se.expr, block);
- gfc_add_block_to_block (block, &se.post);
+ c = build_omp_clause (gfc_get_location (&clauses->simdlen_expr->where),
+ OMP_CLAUSE_SIMDLEN);
+ OMP_CLAUSE_SIMDLEN_EXPR (c)
+ = gfc_conv_constant_to_tree (clauses->simdlen_expr);
+ if (clauses->simdlen_type.type != BT_UNKNOWN)
+ {
+ gfc_typespec ts = {};
+ ts.type = clauses->simdlen_type.type;
+ ts.kind = clauses->simdlen_type.kind;
+ OMP_CLAUSE_SIMDLEN_TYPE (c)
+ = gfc_typenode_for_spec (&ts, 0);
+ }
+ if (clauses->simdlen_divisor)
+ OMP_CLAUSE_SIMDLEN_DIVISOR (c)
+ = gfc_conv_constant_to_tree (clauses->simdlen_divisor);
+ omp_clauses = gfc_trans_add_clause (c, omp_clauses);
- c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_SIMDLEN);
- OMP_CLAUSE_SIMDLEN_EXPR (c) = simdlen_var;
- omp_clauses = gfc_trans_add_clause (c, omp_clauses);
- }
+ if (declare_simd && OMP_CLAUSE_SIMDLEN_TYPE (c))
+ /* By contrast, for 'simd', the sorry is in the middle end. */
+ sorry_at (OMP_CLAUSE_LOCATION (c),
+ "%<simdlen%> clause with %<scaled%> modifier");
}
if (clauses->num_teams_list)
@@ -8706,6 +8706,10 @@ gfc_split_omp_clauses (gfc_code *code,
= code->ext.omp_clauses->safelen_expr;
clausesa[GFC_OMP_SPLIT_SIMD].simdlen_expr
= code->ext.omp_clauses->simdlen_expr;
+ clausesa[GFC_OMP_SPLIT_SIMD].simdlen_type
+ = code->ext.omp_clauses->simdlen_type;
+ clausesa[GFC_OMP_SPLIT_SIMD].simdlen_divisor
+ = code->ext.omp_clauses->simdlen_divisor;
clausesa[GFC_OMP_SPLIT_SIMD].lists[OMP_LIST_ALIGNED]
= code->ext.omp_clauses->lists[OMP_LIST_ALIGNED];
/* Duplicate collapse. */
diff --git a/gcc/testsuite/gfortran.dg/goacc/loop-2-kernels-tile.f95 b/gcc/testsuite/gfortran.dg/goacc/loop-2-kernels-tile.f95
index afc8a278cac..97ea857afa7 100644
--- a/gcc/testsuite/gfortran.dg/goacc/loop-2-kernels-tile.f95
+++ b/gcc/testsuite/gfortran.dg/goacc/loop-2-kernels-tile.f95
@@ -29,10 +29,10 @@ program test
DO j = 1,10
ENDDO
ENDDO
- !$acc loop tile(-1) ! { dg-warning "must be positive" }
+ !$acc loop tile(-1) ! { dg-error "INTEGER expression of TILE clause at .1. must be positive and constant" }
do i = 1,10
enddo
- !$acc loop tile(i) ! { dg-error "constant expression" }
+ !$acc loop tile(i) ! { dg-error "INTEGER expression of TILE clause at .1. must be positive and constant" }
do i = 1,10
enddo
!$acc loop tile(2, 2, 1) ! { dg-error "not enough DO loops for tiled" }
@@ -82,10 +82,10 @@ program test
DO j = 1,10
ENDDO
ENDDO
- !$acc kernels loop tile(-1) ! { dg-warning "must be positive" }
+ !$acc kernels loop tile(-1) ! { dg-error "INTEGER expression of TILE clause at .1. must be positive and constant" }
do i = 1,10
enddo
- !$acc kernels loop tile(i) ! { dg-error "constant expression" }
+ !$acc kernels loop tile(i) ! { dg-error "INTEGER expression of TILE clause at .1. must be positive and constant" }
do i = 1,10
enddo
!$acc kernels loop tile(2, 2, 1) ! { dg-error "not enough DO loops for tiled" }
diff --git a/gcc/testsuite/gfortran.dg/goacc/loop-2-parallel-tile.f95 b/gcc/testsuite/gfortran.dg/goacc/loop-2-parallel-tile.f95
index 4bfca748f75..5039c2e7940 100644
--- a/gcc/testsuite/gfortran.dg/goacc/loop-2-parallel-tile.f95
+++ b/gcc/testsuite/gfortran.dg/goacc/loop-2-parallel-tile.f95
@@ -20,10 +20,10 @@ program test
DO j = 1,10
ENDDO
ENDDO
- !$acc loop tile(-1) ! { dg-warning "must be positive" }
+ !$acc loop tile(-1) ! { dg-error "INTEGER expression of TILE clause at .1. must be positive and constant" }
do i = 1,10
enddo
- !$acc loop tile(i) ! { dg-error "constant expression" }
+ !$acc loop tile(i) ! { dg-error "INTEGER expression of TILE clause at .1. must be positive and constant" }
do i = 1,10
enddo
!$acc loop tile(2, 2, 1) ! { dg-error "not enough DO loops for tiled" }
@@ -73,10 +73,10 @@ program test
DO j = 1,10
ENDDO
ENDDO
- !$acc parallel loop tile(-1) ! { dg-warning "must be positive" }
+ !$acc parallel loop tile(-1) ! { dg-error "INTEGER expression of TILE clause at .1. must be positive and constant" }
do i = 1,10
enddo
- !$acc parallel loop tile(i) ! { dg-error "constant expression" }
+ !$acc parallel loop tile(i) ! { dg-error "INTEGER expression of TILE clause at .1. must be positive and constant" }
do i = 1,10
enddo
!$acc parallel loop tile(2, 2, 1) ! { dg-error "not enough DO loops for tiled" }
diff --git a/gcc/testsuite/gfortran.dg/goacc/loop-2-serial-tile.f95 b/gcc/testsuite/gfortran.dg/goacc/loop-2-serial-tile.f95
index 79d8d1b9d47..25f200881c7 100644
--- a/gcc/testsuite/gfortran.dg/goacc/loop-2-serial-tile.f95
+++ b/gcc/testsuite/gfortran.dg/goacc/loop-2-serial-tile.f95
@@ -20,10 +20,10 @@ program test
DO j = 1,10
ENDDO
ENDDO
- !$acc loop tile(-1) ! { dg-warning "must be positive" }
+ !$acc loop tile(-1) ! { dg-error "INTEGER expression of TILE clause at .1. must be positive and constant" }
do i = 1,10
enddo
- !$acc loop tile(i) ! { dg-error "constant expression" }
+ !$acc loop tile(i) ! { dg-error "INTEGER expression of TILE clause at .1. must be positive and constant" }
do i = 1,10
enddo
!$acc loop tile(2, 2, 1) ! { dg-error "not enough DO loops for tiled" }
@@ -73,10 +73,10 @@ program test
DO j = 1,10
ENDDO
ENDDO
- !$acc serial loop tile(-1) ! { dg-warning "must be positive" }
+ !$acc serial loop tile(-1) ! { dg-error "INTEGER expression of TILE clause at .1. must be positive and constant" }
do i = 1,10
enddo
- !$acc serial loop tile(i) ! { dg-error "constant expression" }
+ !$acc serial loop tile(i) ! { dg-error "INTEGER expression of TILE clause at .1. must be positive and constant" }
do i = 1,10
enddo
!$acc serial loop tile(2, 2, 1) ! { dg-error "not enough DO loops for tiled" }
diff --git a/gcc/testsuite/gfortran.dg/goacc/tile-1.f90 b/gcc/testsuite/gfortran.dg/goacc/tile-1.f90
index f609b127df9..316ccccbd6c 100644
--- a/gcc/testsuite/gfortran.dg/goacc/tile-1.f90
+++ b/gcc/testsuite/gfortran.dg/goacc/tile-1.f90
@@ -44,17 +44,17 @@ subroutine parloop
do i = 1, n
end do
- !$acc parallel loop tile(-3) ! { dg-warning "must be positive" }
+ !$acc parallel loop tile(-3) ! { dg-error "INTEGER expression of TILE clause at .1. must be positive and constant" }
do i = 1, n
end do
- !$acc parallel loop tile(10, -3) ! { dg-warning "must be positive" }
+ !$acc parallel loop tile(10, -3) ! { dg-error "INTEGER expression of TILE clause at .1. must be positive and constant" }
do i = 1, n
do j = 1, n
end do
end do
- !$acc parallel loop tile(-100, 10, 5) ! { dg-warning "must be positive" }
+ !$acc parallel loop tile(-100, 10, 5) ! { dg-error "INTEGER expression of TILE clause at .1. must be positive and constant" }
do i = 1, n
do j = 1, n
do k = 1, n
@@ -68,13 +68,13 @@ subroutine parloop
end do
end do
- !$acc parallel loop tile(1, a) ! { dg-error "constant expression" }
+ !$acc parallel loop tile(1, a) ! { dg-error "INTEGER expression of TILE clause at .1. must be positive and constant" }
do i = 1, n
do j = 1, n
end do
end do
- !$acc parallel loop tile(a, 1) ! { dg-error "constant expression" }
+ !$acc parallel loop tile(a, 1) ! { dg-error "INTEGER expression of TILE clause at .1. must be positive and constant" }
do i = 1, n
do j = 1, n
end do
@@ -114,11 +114,11 @@ subroutine par
end do
end do
- !$acc loop tile(-2) ! { dg-warning "must be positive" }
+ !$acc loop tile(-2) ! { dg-error "INTEGER expression of TILE clause at .1. must be positive and constant" }
do i = 1, n
end do
- !$acc loop tile(i) ! { dg-error "constant expression" }
+ !$acc loop tile(i) ! { dg-error "INTEGER expression of TILE clause at .1. must be positive and constant" }
do i = 1, n
end do
@@ -195,11 +195,11 @@ subroutine kern
end do
end do
- !$acc loop tile(-2) ! { dg-warning "must be positive" }
+ !$acc loop tile(-2) ! { dg-error "INTEGER expression of TILE clause at .1. must be positive and constant" }
do i = 1, n
end do
- !$acc loop tile(i) ! { dg-error "constant expression" }
+ !$acc loop tile(i) ! { dg-error "INTEGER expression of TILE clause at .1. must be positive and constant" }
do i = 1, n
end do
@@ -295,17 +295,17 @@ subroutine kernsloop
do i = 1, n
end do
- !$acc kernels loop tile(-3) ! { dg-warning "must be positive" }
+ !$acc kernels loop tile(-3) ! { dg-error "INTEGER expression of TILE clause at .1. must be positive and constant" }
do i = 1, n
end do
- !$acc kernels loop tile(10, -3) ! { dg-warning "must be positive" }
+ !$acc kernels loop tile(10, -3) ! { dg-error "INTEGER expression of TILE clause at .1. must be positive and constant" }
do i = 1, n
do j = 1, n
end do
end do
- !$acc kernels loop tile(-100, 10, 5) ! { dg-warning "must be positive" }
+ !$acc kernels loop tile(-100, 10, 5) ! { dg-error "INTEGER expression of TILE clause at .1. must be positive and constant" }
do i = 1, n
do j = 1, n
do k = 1, n
@@ -319,13 +319,13 @@ subroutine kernsloop
end do
end do
- !$acc kernels loop tile(1, a) ! { dg-error "constant expression" }
+ !$acc kernels loop tile(1, a) ! { dg-error "INTEGER expression of TILE clause at .1. must be positive and constant" }
do i = 1, n
do j = 1, n
end do
end do
- !$acc kernels loop tile(a, 1) ! { dg-error "constant expression" }
+ !$acc kernels loop tile(a, 1) ! { dg-error "INTEGER expression of TILE clause at .1. must be positive and constant" }
do i = 1, n
do j = 1, n
end do
diff --git a/gcc/testsuite/gfortran.dg/gomp/atomic-18.f90 b/gcc/testsuite/gfortran.dg/gomp/atomic-18.f90
index 6c8f44a1e9e..301c7d99524 100644
--- a/gcc/testsuite/gfortran.dg/gomp/atomic-18.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/atomic-18.f90
@@ -18,8 +18,7 @@ integer, value :: j
!$omp atomic hint(j + 2) ! { dg-error "Value of HINT clause at .1. shall be a valid constant hint expression" }
i = i + 1
!$omp atomic hint(f)
- ! { dg-error "HINT clause at .1. requires a scalar INTEGER expression" "" { target *-*-* } .-1 }
- ! { dg-error "Value of HINT clause at .1. shall be a valid constant hint expression" "" { target *-*-* } .-2 }
+ ! { dg-error "Value of HINT clause at .1. shall be a valid constant hint expression" "" { target *-*-* } .-1 }
i = i + 1
!$omp atomic foobar ! { dg-error "Failed to match clause" }
i = i + 1
diff --git a/gcc/testsuite/gfortran.dg/gomp/atomic-2.f90 b/gcc/testsuite/gfortran.dg/gomp/atomic-2.f90
index b6c1b6a519e..a77f407e84f 100644
--- a/gcc/testsuite/gfortran.dg/gomp/atomic-2.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/atomic-2.f90
@@ -4,8 +4,7 @@ subroutine bar
integer :: i, v
real :: f
!$omp atomic update acq_rel hint("abc")
- ! { dg-error "HINT clause at .1. requires a scalar INTEGER expression" "" { target *-*-* } .-1 }
- ! { dg-error "Value of HINT clause at .1. shall be a valid constant hint expression" "" { target *-*-* } .-2 }
+ ! { dg-error "Value of HINT clause at .1. shall be a valid constant hint expression" "" { target *-*-* } .-1 }
i = i + 1
!$omp end atomic
diff --git a/gcc/testsuite/gfortran.dg/gomp/clauses-1.f90 b/gcc/testsuite/gfortran.dg/gomp/clauses-1.f90
index 0c91ae5ff3e..2fdfe7da887 100644
--- a/gcc/testsuite/gfortran.dg/gomp/clauses-1.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/clauses-1.f90
@@ -26,12 +26,13 @@ module m
contains
-subroutine foo (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd, ntm)
+subroutine foo (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, q, dd, ntm)
!$omp declare target (foo)
- integer :: d, m, p, idp, s, nte, tl, nth, g, nta, pp, q, dd, ntm
+ integer :: d, m, p, idp, s, nte, tl, nth, g, nta, q, dd, ntm
logical :: i1, i2, i3, fi
pointer :: q
integer :: i
+ integer, parameter :: pp = 3
!$omp distribute parallel do &
!$omp& private (p) firstprivate (f) collapse(1) dist_schedule(static, 16) &
@@ -73,11 +74,12 @@ subroutine qux (p)
end do
end
-subroutine baz (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd, ntm)
- integer :: d, m, p, idp, s, nte, tl, nth, g, nta, pp, q, dd, ntm
+subroutine baz (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, q, dd, ntm)
+ integer :: d, m, p, idp, s, nte, tl, nth, g, nta, q, dd, ntm
logical :: i1, i2, i3, fi
pointer :: q
integer :: i
+ integer, parameter :: pp = 3
!$omp distribute parallel do &
!$omp& private (p) firstprivate (f) collapse(1) dist_schedule(static, 16) &
!$omp& if (parallel: i2) default(shared) shared(s) reduction(+:r) num_threads (nth) proc_bind(spread) &
@@ -132,11 +134,12 @@ subroutine baz (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
end do
end
-subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd, ntm)
- integer :: d, m, p, idp, s, nte, tl, nth, g, nta, pp, q, dd(0:5), ntm
+subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, q, dd, ntm)
+ integer :: d, m, p, idp, s, nte, tl, nth, g, nta, q, dd(0:5), ntm
logical :: i1, i2, i3, fi
pointer :: q
integer :: i
+ integer, parameter :: pp = 3
!$omp do simd &
!$omp& private (p) firstprivate (f) lastprivate (l) linear (ll:1) reduction(+:r) schedule(static, 4) collapse(1) &
diff --git a/gcc/testsuite/gfortran.dg/gomp/masked-1.f90 b/gcc/testsuite/gfortran.dg/gomp/masked-1.f90
index 2b2526ac712..1502e8724af 100644
--- a/gcc/testsuite/gfortran.dg/gomp/masked-1.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/masked-1.f90
@@ -42,13 +42,14 @@ subroutine foo (x, a)
!$omp end masked
end
-subroutine foobar (d, f, fi, p, s, g, i1, i2, l, ll, nth, ntm, pp, q, r, r2)
+subroutine foobar (d, f, fi, p, s, g, i1, i2, l, ll, nth, ntm, q, r, r2)
implicit none (type, external)
logical :: i1, i2, fi
- integer :: i, d, f, p, s, g, l, ll, nth, ntm, pp, q, r, r2
+ integer :: i, d, f, p, s, g, l, ll, nth, ntm, q, r, r2
allocatable :: q
integer, save :: t
!$omp threadprivate (t)
+ integer, parameter :: pp = 3
!$omp parallel masked &
!$omp& private (p) firstprivate (f) if (parallel: i2) default(shared) shared(s) reduction(+:r) &
diff --git a/gcc/testsuite/gfortran.dg/gomp/pr67500.f90 b/gcc/testsuite/gfortran.dg/gomp/pr67500.f90
index 1cecdc48578..f1526f0a903 100644
--- a/gcc/testsuite/gfortran.dg/gomp/pr67500.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/pr67500.f90
@@ -10,11 +10,11 @@ subroutine f2
end
subroutine f3 (i)
- !$omp declare simd simdlen(-2) ! { dg-warning "INTEGER expression of SIMDLEN clause at .1. must be positive" }
+ !$omp declare simd simdlen(-2) ! { dg-error "INTEGER expression of SIMDLEN clause at .1. must be positive and constant" }
end subroutine
subroutine f4
- !$omp declare simd simdlen(0) ! { dg-warning "INTEGER expression of SIMDLEN clause at .1. must be positive" }
+ !$omp declare simd simdlen(0) ! { dg-error "INTEGER expression of SIMDLEN clause at .1. must be positive and constant" }
end
subroutine foo(p, d, n)
@@ -31,11 +31,11 @@ subroutine foo(p, d, n)
do i = 1, 16
end do
- !$omp simd safelen(-2) ! { dg-warning "INTEGER expression of SAFELEN clause at .1. must be positive" }
+ !$omp simd safelen(-2) ! { dg-error "INTEGER expression of SAFELEN clause at .1. must be positive and constant" }
do i = 1, 16
end do
- !$omp simd safelen(0) ! { dg-warning "INTEGER expression of SAFELEN clause at .1. must be positive" }
+ !$omp simd safelen(0) ! { dg-error "INTEGER expression of SAFELEN clause at .1. must be positive and constant" }
do i = 1, 16
end do
diff --git a/gcc/testsuite/gfortran.dg/gomp/pr77516.f90 b/gcc/testsuite/gfortran.dg/gomp/pr77516.f90
index 9c0a95b9f79..0c3259797e0 100644
--- a/gcc/testsuite/gfortran.dg/gomp/pr77516.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/pr77516.f90
@@ -4,7 +4,7 @@
program pr77516
integer :: i, x
x = 0
-!$omp simd safelen(0) reduction(+:x) ! { dg-warning "must be positive" }
+!$omp simd safelen(0) reduction(+:x) ! { dg-error "INTEGER expression of SAFELEN clause at .1. must be positive and constant" }
do i = 1, 8
x = x + 1
end do
diff --git a/gcc/testsuite/gfortran.dg/gomp/simdlen-scaled-1.f90 b/gcc/testsuite/gfortran.dg/gomp/simdlen-scaled-1.f90
new file mode 100644
index 00000000000..b5dd987d11a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/simdlen-scaled-1.f90
@@ -0,0 +1,44 @@
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-gimple -w -funsigned" }
+
+! PR middle-end/127723
+
+module m
+ implicit none
+contains
+ subroutine g1(a)
+ integer :: a
+ !$omp declare simd simdlen(scaled(integer, 1): 1)
+! { dg-message "sorry, unimplemented: 'simdlen' clause with 'scaled' modifier" "" { target *-*-* } .-1 }
+ end
+
+ subroutine g1a(a)
+ integer :: a
+ !$omp declare simd simdlen(scaled(integer ( kind = 4 ), 4): 4)
+! { dg-message "sorry, unimplemented: 'simdlen' clause with 'scaled' modifier" "" { target *-*-* } .-1 }
+ end
+
+ subroutine g2(a)
+ integer :: a
+ !$omp declare simd simdlen(scaled(double precision, 2): 2)
+! { dg-message "sorry, unimplemented: 'simdlen' clause with 'scaled' modifier" "" { target *-*-* } .-1 }
+ end
+
+ subroutine g3(a)
+ integer :: a
+ !$omp declare simd simdlen(scaled(complex(8)): 4)
+! { dg-message "sorry, unimplemented: 'simdlen' clause with 'scaled' modifier" "" { target *-*-* } .-1 }
+ end
+
+ subroutine g4 (a)
+ integer :: a
+ !$omp declare simd simdlen(scaled(unsigned(2)): 4)
+! { dg-message "sorry, unimplemented: 'simdlen' clause with 'scaled' modifier" "" { target *-*-* } .-1 }
+ end
+end
+
+! { dg-final { scan-tree-dump "__attribute__\\(\\(omp declare simd \\(simdlen\\(scaled\\(integer\\(kind=4\\),1\\):1\\)\\)\\)\\)" "gimple" } }
+! { dg-final { scan-tree-dump "__attribute__\\(\\(omp declare simd \\(simdlen\\(scaled\\(integer\\(kind=4\\),4\\):4\\)\\)\\)\\)" "gimple" } }
+! { dg-final { scan-tree-dump "__attribute__\\(\\(omp declare simd \\(simdlen\\(scaled\\(real\\(kind=8\\),2\\):2\\)\\)\\)\\)" "gimple" } }
+! { dg-final { scan-tree-dump "__attribute__\\(\\(omp declare simd \\(simdlen\\(scaled\\(complex\\(kind=8\\)\\):4\\)\\)\\)\\)" "gimple" } }
+! { dg-final { scan-tree-dump "__attribute__\\(\\(omp declare simd \\(simdlen\\(scaled\\(unsigned\\(kind=2\\)\\):4\\)\\)\\)\\)" "gimple" } }
diff --git a/gcc/testsuite/gfortran.dg/gomp/simdlen-scaled-2.f90 b/gcc/testsuite/gfortran.dg/gomp/simdlen-scaled-2.f90
new file mode 100644
index 00000000000..4bcfff45472
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/simdlen-scaled-2.f90
@@ -0,0 +1,28 @@
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-original -w" }
+
+! PR middle-end/127723
+
+subroutine f(n, a, d)
+ integer :: i, n, a(*)
+ real :: d(*)
+
+ !$omp simd simdlen(scaled(integer,1): 1) ! { dg-message "sorry, unimplemented: 'simdlen' clause with 'scaled' modifier" }
+ do i = 1, 1
+ a(i) = a(i) + 5
+ end do
+
+ !$omp simd simdlen(scaled(integer(8)): 2) ! { dg-message "sorry, unimplemented: 'simdlen' clause with 'scaled' modifier" }
+ do i = 1, 1
+ a(i) = a(i) + 5
+ end do
+
+ !$omp simd simdlen(scaled(complex(4), 4): 8) ! { dg-message "sorry, unimplemented: 'simdlen' clause with 'scaled' modifier" }
+ do i = 1, 1
+ d(i) = 0.0
+ end do
+end
+
+! { dg-final { scan-tree-dump "#pragma omp simd linear\\(i:1\\) simdlen\\(scaled\\(integer\\(kind=4\\),1\\):1\\)" "original" } }
+! { dg-final { scan-tree-dump "#pragma omp simd linear\\(i:1\\) simdlen\\(scaled\\(integer\\(kind=8\\)\\):2\\)" "original" } }
+! { dg-final { scan-tree-dump "#pragma omp simd linear\\(i:1\\) simdlen\\(scaled\\(complex\\(kind=4\\),4\\):8\\)" "original" } }
diff --git a/gcc/testsuite/gfortran.dg/gomp/simdlen-scaled-3.f90 b/gcc/testsuite/gfortran.dg/gomp/simdlen-scaled-3.f90
new file mode 100644
index 00000000000..363376147d6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/simdlen-scaled-3.f90
@@ -0,0 +1,49 @@
+! { dg-do compile }
+
+! PR middle-end/127723
+
+module m
+ implicit none
+ type t
+ end type t
+contains
+subroutine f (n, a, d)
+ integer :: i, n, a(*)
+ real :: d(*)
+
+ !$omp simd simdlen(scaled(integer,1)) ! { dg-error "Expected '\\:' at .1." }
+ do i = 1, 1
+ a(i) = a(i) + 5
+ end do
+
+ !$omp simd simdlen(scaled(integer + 3): 2) ! { dg-error "Expected '\\)' at .1." }
+ do i = 1, 1
+ a(i) = a(i) + 5
+ end do
+
+ !$omp simd simdlen(scaled(4): 8) ! { dg-error "Expected numerical type name at .1." }
+ do i = 1, 1
+ d(i) = 0.0
+ end do
+
+ !$omp simd simdlen(scaled(type(t)): 8) ! { dg-error "Expected numerical type name at .1." }
+ do i = 1, 1
+ d(i) = 0.0
+ end do
+
+ !$omp simd simdlen(scaled(real, n): 8) ! { dg-error "Divisor expression at .1. of the SCALED modifier to SIMDLEN must be a positive scalar constant integer expression" }
+ do i = 1, 1
+ d(i) = 0.0
+ end do
+
+ !$omp simd simdlen(scaled(complex, 0): 8) ! { dg-error "Divisor expression at .1. of the SCALED modifier to SIMDLEN must be a positive scalar constant integer expression" }
+ do i = 1, 1
+ d(i) = 0.0
+ end do
+
+ !$omp simd simdlen(scaled(complex, 1, 0): 8) ! { dg-error "Expected '\\)' at .1." }
+ do i = 1, 1
+ d(i) = 0.0
+ end do
+end
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/simdlen-scaled-4.f90 b/gcc/testsuite/gfortran.dg/gomp/simdlen-scaled-4.f90
new file mode 100644
index 00000000000..55d4d7257f2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/simdlen-scaled-4.f90
@@ -0,0 +1,75 @@
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-gimple -w" }
+
+! PR middle-end/127723
+
+module m
+ implicit none
+ interface
+ subroutine fvarInt3(x); integer, value :: x; end
+ subroutine fvarInt2(x); integer, value :: x; end
+ subroutine fvarInt0(x); integer, value :: x; end
+ subroutine fvar0(x); integer, value :: x; end
+ end interface
+contains
+subroutine fbase (x)
+ integer, value :: x
+ !$omp declare_variant(fvarInt3) match(construct={parallel,simd(simdlen(scaled(integer,2): 8))})
+ !$omp declare_variant(fvarInt2) match(construct={simd(simdlen(scaled(integer,2): 8))})
+ !$omp declare_variant(fvarInt0) match(construct={simd(simdlen(scaled(integer): 8))})
+ !$omp declare_variant(fvar0) match(construct={simd(simdlen(4))})
+end
+end
+
+subroutine f()
+ use m
+ implicit none
+ integer :: i
+
+ !$omp simd simdlen(scaled(integer,2): 8)
+ do i = 1, 1
+ call fbase (1); ! -> fvarInt2
+ end do
+
+ !$omp parallel
+ block
+ !$omp simd simdlen(scaled(integer,2): 8)
+ do i = 1, 1
+ call fbase (11); ! -> fvarInt2
+ end do
+ end block
+
+
+ !$omp simd simdlen(scaled(integer): 8)
+ do i = 1, 1
+ call fbase (2); ! -> fvarInt0
+ end do
+
+ !$omp simd simdlen(4)
+ do i = 1, 1
+ call fbase (3); ! -> fvar0
+ end do
+
+ !$omp simd simdlen(8)
+ do i = 1, 1
+ call fbase (4); ! -> fbase
+ end do
+end subroutine
+
+! Once implemented remove ...
+! { dg-message "sorry, unimplemented: 'simdlen' clause with 'scaled' modifier" "" { target *-*-* } 17 }
+! { dg-message "sorry, unimplemented: 'simdlen' clause with 'scaled' modifier" "" { target *-*-* } 18 }
+! { dg-message "sorry, unimplemented: 'simdlen' clause with 'scaled' modifier" "" { target *-*-* } 19 }
+! { dg-message "sorry, unimplemented: 'simdlen' clause with 'scaled' modifier" "" { target *-*-* } 29 }
+! { dg-message "sorry, unimplemented: 'simdlen' clause with 'scaled' modifier" "" { target *-*-* } 36 }
+! { dg-message "sorry, unimplemented: 'simdlen' clause with 'scaled' modifier" "" { target *-*-* } 43 }
+
+! ... and the following XFAIL should work ... (it fails because the clause is removed)
+! { dg-final { scan-tree-dump-times "fvarint2 \\(1\\);" 1 "gimple" { xfail *-*-* } } }
+! { dg-final { scan-tree-dump-times "fvarint3 \\(11\\);" 1 "gimple" { xfail *-*-* } } }
+! { dg-final { scan-tree-dump-times "fvarint0 \\(2\\);" 1 "gimple" { xfail *-*-* } } }
+
+! { dg-final { scan-tree-dump-times "fvar0 \\(3\\);" 1 "gimple" } }
+! { dg-final { scan-tree-dump-times "fbase \\(4\\);" 1 "gimple" } }
+
+! { dg-final { scan-tree-dump "__attribute__\\(\\(omp declare variant base \\(fvar0 match construct = {simd \\(simdlen\\(4\\)\\)}\\), omp declare variant base \\(fvarint0 match construct = {simd \\(simdlen\\(scaled\\(integer\\(kind=4\\)\\):8\\)\\)}\\), omp declare variant base \\(fvarint2 match construct = {simd \\(simdlen\\(scaled\\(integer\\(kind=4\\),2\\):8\\)\\)}\\), omp declare variant base \\(fvarint3 match construct = {parallel, simd \\(simdlen\\(scaled\\(integer\\(kind=4\\),2\\):8\\)\\)}\\)\\)\\)" "gimple" } }
diff --git a/gcc/testsuite/gfortran.dg/gomp/simdlen-scaled-5-1.f90 b/gcc/testsuite/gfortran.dg/gomp/simdlen-scaled-5-1.f90
new file mode 100644
index 00000000000..55d4d7257f2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/simdlen-scaled-5-1.f90
@@ -0,0 +1,75 @@
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-gimple -w" }
+
+! PR middle-end/127723
+
+module m
+ implicit none
+ interface
+ subroutine fvarInt3(x); integer, value :: x; end
+ subroutine fvarInt2(x); integer, value :: x; end
+ subroutine fvarInt0(x); integer, value :: x; end
+ subroutine fvar0(x); integer, value :: x; end
+ end interface
+contains
+subroutine fbase (x)
+ integer, value :: x
+ !$omp declare_variant(fvarInt3) match(construct={parallel,simd(simdlen(scaled(integer,2): 8))})
+ !$omp declare_variant(fvarInt2) match(construct={simd(simdlen(scaled(integer,2): 8))})
+ !$omp declare_variant(fvarInt0) match(construct={simd(simdlen(scaled(integer): 8))})
+ !$omp declare_variant(fvar0) match(construct={simd(simdlen(4))})
+end
+end
+
+subroutine f()
+ use m
+ implicit none
+ integer :: i
+
+ !$omp simd simdlen(scaled(integer,2): 8)
+ do i = 1, 1
+ call fbase (1); ! -> fvarInt2
+ end do
+
+ !$omp parallel
+ block
+ !$omp simd simdlen(scaled(integer,2): 8)
+ do i = 1, 1
+ call fbase (11); ! -> fvarInt2
+ end do
+ end block
+
+
+ !$omp simd simdlen(scaled(integer): 8)
+ do i = 1, 1
+ call fbase (2); ! -> fvarInt0
+ end do
+
+ !$omp simd simdlen(4)
+ do i = 1, 1
+ call fbase (3); ! -> fvar0
+ end do
+
+ !$omp simd simdlen(8)
+ do i = 1, 1
+ call fbase (4); ! -> fbase
+ end do
+end subroutine
+
+! Once implemented remove ...
+! { dg-message "sorry, unimplemented: 'simdlen' clause with 'scaled' modifier" "" { target *-*-* } 17 }
+! { dg-message "sorry, unimplemented: 'simdlen' clause with 'scaled' modifier" "" { target *-*-* } 18 }
+! { dg-message "sorry, unimplemented: 'simdlen' clause with 'scaled' modifier" "" { target *-*-* } 19 }
+! { dg-message "sorry, unimplemented: 'simdlen' clause with 'scaled' modifier" "" { target *-*-* } 29 }
+! { dg-message "sorry, unimplemented: 'simdlen' clause with 'scaled' modifier" "" { target *-*-* } 36 }
+! { dg-message "sorry, unimplemented: 'simdlen' clause with 'scaled' modifier" "" { target *-*-* } 43 }
+
+! ... and the following XFAIL should work ... (it fails because the clause is removed)
+! { dg-final { scan-tree-dump-times "fvarint2 \\(1\\);" 1 "gimple" { xfail *-*-* } } }
+! { dg-final { scan-tree-dump-times "fvarint3 \\(11\\);" 1 "gimple" { xfail *-*-* } } }
+! { dg-final { scan-tree-dump-times "fvarint0 \\(2\\);" 1 "gimple" { xfail *-*-* } } }
+
+! { dg-final { scan-tree-dump-times "fvar0 \\(3\\);" 1 "gimple" } }
+! { dg-final { scan-tree-dump-times "fbase \\(4\\);" 1 "gimple" } }
+
+! { dg-final { scan-tree-dump "__attribute__\\(\\(omp declare variant base \\(fvar0 match construct = {simd \\(simdlen\\(4\\)\\)}\\), omp declare variant base \\(fvarint0 match construct = {simd \\(simdlen\\(scaled\\(integer\\(kind=4\\)\\):8\\)\\)}\\), omp declare variant base \\(fvarint2 match construct = {simd \\(simdlen\\(scaled\\(integer\\(kind=4\\),2\\):8\\)\\)}\\), omp declare variant base \\(fvarint3 match construct = {parallel, simd \\(simdlen\\(scaled\\(integer\\(kind=4\\),2\\):8\\)\\)}\\)\\)\\)" "gimple" } }
diff --git a/gcc/testsuite/gfortran.dg/gomp/simdlen-scaled-5-2.f90 b/gcc/testsuite/gfortran.dg/gomp/simdlen-scaled-5-2.f90
new file mode 100644
index 00000000000..a3e10882538
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/simdlen-scaled-5-2.f90
@@ -0,0 +1,40 @@
+! { dg-do compile { target skip-all-targets } }
+
+! Used via simdlen-scaled-5-1.f90
+
+! PR middle-end/127723
+
+subroutine f()
+ use m
+ implicit none
+ integer :: i
+
+ !$omp simd simdlen(scaled(integer,2): 8)
+ do i = 1, 1
+ call fbase (1); ! -> fvarInt2
+ end do
+
+ !$omp parallel
+ block
+ !$omp simd simdlen(scaled(integer,2): 8)
+ do i = 1, 1
+ call fbase (11); ! -> fvarInt2
+ end do
+ end block
+
+
+ !$omp simd simdlen(scaled(integer): 8)
+ do i = 1, 1
+ call fbase (2); ! -> fvarInt0
+ end do
+
+ !$omp simd simdlen(4)
+ do i = 1, 1
+ call fbase (3); ! -> fvar0
+ end do
+
+ !$omp simd simdlen(8)
+ do i = 1, 1
+ call fbase (4); ! -> fbase
+ end do
+end subroutine
diff --git a/gcc/testsuite/gfortran.dg/gomp/target2.f90 b/gcc/testsuite/gfortran.dg/gomp/target2.f90
index dfe0ec3aefa..1a4cc350cc5 100644
--- a/gcc/testsuite/gfortran.dg/gomp/target2.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/target2.f90
@@ -1,8 +1,9 @@
! { dg-do compile }
! { dg-additional-options "-ffree-line-length-160" }
-subroutine foo (n, s, t, u, v, w)
- integer :: n, i, s, t, u, v, w
+subroutine foo (n, t, u, v, w)
+ integer :: n, i, t, u, v, w
+ integer, parameter :: s = 4
common /bar/ i
!$omp simd safelen(s + 1)
do i = 1, n
diff --git a/gcc/testsuite/gfortran.dg/gomp/taskloop-1.f90 b/gcc/testsuite/gfortran.dg/gomp/taskloop-1.f90
index 46901712a24..e3fef34b219 100644
--- a/gcc/testsuite/gfortran.dg/gomp/taskloop-1.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/taskloop-1.f90
@@ -7,13 +7,14 @@ module m
!$omp declare target to(f, l, ll, r, r2)
end module m
-subroutine foo(fi, p, pp, g, s, nta, nth, ntm, i1, i2, i3, q)
+subroutine foo(fi, p, g, s, nta, nth, ntm, i1, i2, i3, q)
use m
implicit none
- integer, value :: p, pp, g, s, nta, nth, ntm
+ integer, value :: p, g, s, nta, nth, ntm
logical, value :: fi, i1, i2, i3
integer, pointer :: q(:)
integer :: i
+ integer, parameter :: pp = 3
!$omp taskgroup task_reduction(+:r2) !allocate (r2)
!$omp taskloop simd &
diff --git a/gcc/testsuite/gfortran.dg/gomp/taskloop-2.f90 b/gcc/testsuite/gfortran.dg/gomp/taskloop-2.f90
index 15ddea8e69d..6a81295d546 100644
--- a/gcc/testsuite/gfortran.dg/gomp/taskloop-2.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/taskloop-2.f90
@@ -41,6 +41,10 @@ end do
!$omp parallel master taskloop simd reduction(inscan, +: r) ! { dg-error "'inscan' REDUCTION clause on construct other than DO, SIMD, DO SIMD, PARALLEL DO, PARALLEL DO SIMD" }
do i = 1, 64 ! { dg-error "OMP SCAN between two structured block sequences" "" { target *-*-* } .-1 }
end do
+
+!$omp parallel master taskloop reduction(+: r) priority(r) ! { dg-error "INTEGER expression of PRIORITY clause at .1. must be non-negtive and constant" }
+do i = 1, 64
+end do
end
diff --git a/gcc/testsuite/gfortran.dg/gomp/tile-7.f90 b/gcc/testsuite/gfortran.dg/gomp/tile-7.f90
index 58559331c5f..2e35e891c57 100644
--- a/gcc/testsuite/gfortran.dg/gomp/tile-7.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/tile-7.f90
@@ -14,7 +14,7 @@ subroutine test
end do
!$omp end tile
- !$omp tile sizes(i) ! { dg-error "SIZES requires constant expression" }
+ !$omp tile sizes(i) ! { dg-error "INTEGER expression of SIZES clause at .1. must be positive and constant" }
do i = 1,100
call dummy(i)
end do
diff --git a/libgomp/testsuite/libgomp.fortran/nestedfn5.f90 b/libgomp/testsuite/libgomp.fortran/nestedfn5.f90
index 28c9b00da67..63210966a2f 100644
--- a/libgomp/testsuite/libgomp.fortran/nestedfn5.f90
+++ b/libgomp/testsuite/libgomp.fortran/nestedfn5.f90
@@ -11,7 +11,7 @@
end
subroutine bar (q)
use iso_c_binding, only: c_ptr, c_loc, c_int
- integer :: a, b, c, d(2:3,4:5), q(19:), h, k, m, n, o, p
+ integer :: a, b, c, d(2:3,4:5), q(19:), h, m, o, p
integer(c_int), target :: e(64)
type (c_ptr) :: f, g(64)
logical :: l
@@ -80,9 +80,10 @@ contains
c = 100
h = 8
m = 0
- n = 64
o = 16
if (l) stop 6
+ block
+ integer, parameter :: n = 64
!$omp target teams distribute parallel do simd if (.not.l) device(a) &
!$omp & num_teams(b) dist_schedule(static, c) num_threads (h) &
!$omp & reduction (+: m) safelen (n) schedule(static, o) &
@@ -91,6 +92,7 @@ contains
m = m + 1
end do
!$omp end target teams distribute parallel do simd
+ end block
if (m /= 64) stop 7
!$omp end target data
end subroutine foo
